Libreria data.table:

Introducción

Librerias

Es importante cargar las siguientes librerias:

# Load pacman library
library(pacman)

# Use p_load to load all necessary libraries
p_load(data.table, tidyverse, readxl, writexl, kableExtra, knitr, rmarkdown, 
       RColorBrewer, tinytex, janitor, rsconnect, rlist, stringr, forcats, 
       ggthemes, lubridate, magrittr, nycflights13, openxlsx, DT, rvest, rio, 
       here, rmdformats, xml2, babynames)

Base de Datos

Xile	Yate	Vac
b	2	1
b	4	2
b	7	3
a	2	4
a	4	5
a	7	6
c	2	7
c	4	8
c	7	9

Comandos básicos

Operaciones Básicas de Filas

BD[3:2]               # Selecciona la tercera y la segunda fila
BD <- BD[order(Xile)] # Ordena la variable Xile en orden ascendente. 
BD[Yate>2 & Vac>5]    # Trabaja con dos variables 

BD["a", on="Xile"]    # selecciona las "a" de las columnas Xile. 
BD[Xile=="a"]         # Mismo resultado que arriba

Operaciones Básicas Columnas

Las dos opciones dan los mismos resultados:

BD[, list(Vac)]  # Selecciona la variable Vac

##    Vac
## 1:   1
## 2:   2
## 3:   3
## 4:   4
## 5:   5
## 6:   6
## 7:   7
## 8:   8
## 9:   9

BD[, .(Vac)]

##    Vac
## 1:   1
## 2:   2
## 3:   3
## 4:   4
## 5:   5
## 6:   6
## 7:   7
## 8:   8
## 9:   9

Suma todos los elementos de la variable Vac, el título de la nueva variable creada se denomina Suma

Tab <- BD[, .(Suma=sum(Vac))] # same, but column named "Suma"
head(Tab)

##    Suma
## 1:   45

Subconjunto de datos: Manipulación de la información - Filas y Columnas

BD[2:3, .(Total=sum(Vac))] # selecciona las filas 2 y 3, y procede a sumar la columna Vac

Group

Tab_2: Suma el contenido de la variable Vac, agrupándolo por la variable categórica Xile
Tab_3: Ordena la columna V1, en forma descendente (Mayor a Menor)
Tab_4: Número de fila en cada grupo (en este caso en la variable Xile).
Tab_5: Selecciona la primera fila de todas las columnas
Tab_6: Cuenta el número de filas y suma las columns Vac and yate, agrupandolo por Xile

Tab_2 <- BD[, sum(Vac), by=Xile]  
Tab_3 <- BD[, sum(Vac), by=Xile][order(-V1)]
Tab_4 <- BD[, .N, by=Xile] 
Tab_5 <- BD[, .SD[1]] 
Tab_6 <- BD[, c(.N, lapply(.SD, sum)), by=Xile]

GRP: Conteo

Agrega una columna de contador de grupo (en este caso por la variable Xile)

Tab_7 <- BD[, Grupo := .GRP, by=Xile]

Xile	Yate	Vac	Grupo
b	2	1	1
b	4	2	1
b	7	3	1
a	2	4	2
a	4	5	2
a	7	6	2
c	2	7	3
c	4	8	3
c	7	9	3

Conteo por elementos de cierto grupo

Agrega una columna de contador de grupo (en este caso por la variable Xile)

Tab_8 <- BD[ , Conteo := .N, by = list(Xile)]

Xile	Yate	Vac	Grupo	Conteo
b	2	1	1	3
b	4	2	1	3
b	7	3	1	3
a	2	4	2	3
a	4	5	2	3
a	7	6	2	3
c	2	7	3	3
c	4	8	3	3
c	7	9	3	3

La diferencia entre Tab_7 & Tab_8, es que está última tabla, se pide determinar, el número de elementos por cada grupo de la variable Xile. Mientras que en la tabla 7, se exhibe el número de elementos presentes por la variable Xile.

Todo junto

Obtiene la suma por cada grupo de la variable Xile , eliminando la letra “a” del cálculo
Da el mismo resultado de la tabla de arriba

BD[Xile!="a", sum(Vac), by=Xile]

##    Xile V1
## 1:    b  6
## 2:    c 24

BD[c("b","c"), sum(Vac), by=.EACHI, on="Xile"]

##    Xile V1
## 1:    b  6
## 2:    c 24

Seleccionar filas y columnas simultáneamente

En este ejercicio seleccionaremos simultáneamente filas como columnas

Seleccionar por posición de las columnas

Beer <- data.table(Foco = rep(1:3, each=4), Queso = rep(1:4, each=3),
                   Culebra = rep(1:2, 6), Mosca = rep(1:3, each=4))

Reeb <- Beer[7:9, c(2:4)]
Reeb

##    Queso Culebra Mosca
## 1:     3       1     2
## 2:     3       2     2
## 3:     3       1     3

Seleccionar nombre de las variables

nombre <- Beer[7:9, c('Queso', 'Culebra','Mosca')]
nombre

##    Queso Culebra Mosca
## 1:     3       1     2
## 2:     3       2     2
## 3:     3       1     3

setDT

Si queremos transformar de data.frame a data.table de manera directa aplicamos la opción setDT

AG <- dcast(melt(setDT(DF),id.vars='Year'), 
                 variable ~ Year, value.var = 'value')

variable	2022-01-01	2022-01-02	2022-01-03	2022-01-04	2022-01-05	2022-01-06	2022-01-07	2022-01-08	2022-01-09	2022-01-10
B	100	110	105	200	210	190	180	170	165	175
C	120	130	150	170	250	160	130	120	110	130

setnames: Cambiar nombre columnas

BD es el nombre de la base

Nombres <- setnames(BD, old = c("Xile", "Yate"), new = c("Terraza", "Yugoslavia"))

head(Nombres)

##    Terraza Yugoslavia Vac Grupo Conteo
## 1:       b          2   1     1      3
## 2:       b          4   2     1      3
## 3:       b          7   3     1      3
## 4:       a          2   4     2      3
## 5:       a          4   5     2      3
## 6:       a          7   6     2      3

Determinar filas repetidas

Base de Datos

DTA <- data.table(A = rep(1:3, each=4), B = rep(1:4, each=3),
                 C = rep(1:2, 6), key = "A,B")
head(DTA,12)

##     A B C
##  1: 1 1 1
##  2: 1 1 2
##  3: 1 1 1
##  4: 1 2 2
##  5: 2 2 1
##  6: 2 2 2
##  7: 2 3 1
##  8: 2 3 2
##  9: 3 3 1
## 10: 3 4 2
## 11: 3 4 1
## 12: 3 4 2

Filas únicas

Bajo este comando, se selecciona solo filas únicas.

DG <- unique(DTA)
head(DG,10)

##     A B C
##  1: 1 1 1
##  2: 1 1 2
##  3: 1 2 2
##  4: 2 2 1
##  5: 2 2 2
##  6: 2 3 1
##  7: 2 3 2
##  8: 3 3 1
##  9: 3 4 2
## 10: 3 4 1

Filas únicas, con respecto a una columna específica

Generamos una nueva base de datos, la cual contenga solo registros únicos, considerando la columna B

DF <- unique(DTA, by="B")
head(DF)

##    A B C
## 1: 1 1 1
## 2: 1 2 2
## 3: 2 3 1
## 4: 3 4 2

Fusionar tablas (data.table)

Base de Datos

(dt1 <- data.table(A = letters[1:10], X = 1:10, key = "A"))

##     A  X
##  1: a  1
##  2: b  2
##  3: c  3
##  4: d  4
##  5: e  5
##  6: f  6
##  7: g  7
##  8: h  8
##  9: i  9
## 10: j 10

(dt2 <- data.table(A = letters[5:14], Y = 1:10, key = "A"))

##     A  Y
##  1: e  1
##  2: f  2
##  3: g  3
##  4: h  4
##  5: i  5
##  6: j  6
##  7: k  7
##  8: l  8
##  9: m  9
## 10: n 10

d3: Ambas bases, poseen la columna A, sin embargo su contenido difiere, teniendo en común 6 letras. Al aplicar la opción merge, se crea la base d3, en la cual incorpora la columna X de la base dt1, la columna Y de la base dt2, pero manteniendo solo el contenido común de la variable A.
d4: Incorpora la información de las dos bases, manteniendo NA, aquella información que no presente.

d3 <- merge(dt1, dt2) 
d4 <- merge(dt1, dt2, all = TRUE)
head(d3)

##    A  X Y
## 1: e  5 1
## 2: f  6 2
## 3: g  7 3
## 4: h  8 4
## 5: i  9 5
## 6: j 10 6

head(d4,10)

##     A  X  Y
##  1: a  1 NA
##  2: b  2 NA
##  3: c  3 NA
##  4: d  4 NA
##  5: e  5  1
##  6: f  6  2
##  7: g  7  3
##  8: h  8  4
##  9: i  9  5
## 10: j 10  6

Aplicando by.x by.y

##     surname nationality retired
## 1:    Tukey         USA     yes
## 2: Venables   Australia      no
## 3:  Tierney         USA      no
## 4:   Ripley Reino Unido      no
## 5:   McNeil   Australia      no

##        name                         title other.author
## 1:    Tukey     Exploratory Data Analysis         <NA>
## 2: Venables Modern Applied Statistics ...       Ripley
## 3:  Tierney                     LISP-STAT         <NA>
## 4:   Ripley            Spatial Statistics         <NA>
## 5:   Ripley         Stochastic Simulation         <NA>
## 6:   McNeil     Interactive Data Analysis         <NA>

De forma predeterminada, los conjuntos de datos se fusionan en las columnas con los nombres que ambos tienen, pero by.x y by.y pueden proporcionar especificaciones separadas de las columnas.

AA <- merge(Autores, Libros, by.x="surname", by.y="name")

AA %>%
    kbl() %>%
    kable_classic_2(full_width = F) %>%
    row_spec(0, bold= T, align = "justify")

surname	nationality	retired	title	other.author
McNeil	Australia	no	Interactive Data Analysis	NA
Ripley	Reino Unido	no	Spatial Statistics	NA
Ripley	Reino Unido	no	Stochastic Simulation	NA
Tierney	USA	no	LISP-STAT	NA
Tukey	USA	yes	Exploratory Data Analysis	NA
Venables	Australia	no	Modern Applied Statistics …	Ripley

Reemplazar

Reemplazar NA por 0

TD = data.table(x=c(1,NaN,NA,3), y=c(NA_integer_, 1:3), z=c("a", NA_character_, "b", "c"))
head(TD)

##      x  y    z
## 1:   1 NA    a
## 2: NaN  1 <NA>
## 3:  NA  2    b
## 4:   3  3    c

TD[is.na(TD)] <- 0
head(TD)

##    x y z
## 1: 1 0 a
## 2: 0 1 0
## 3: 0 2 b
## 4: 3 3 c

Reemplazar el contenido de una variable

TD$z[TD$z=='a']<-"Alas"
head(TD)

##    x y    z
## 1: 1 0 Alas
## 2: 0 1    0
## 3: 0 2    b
## 4: 3 3    c

Ordenar conjunto de datos

Set = data.table(Aca=sample(3, 10, TRUE),
                 Bar=sample(letters[1:3], 10, TRUE), Cas=sample(10))
Set

##     Aca Bar Cas
##  1:   1   c   7
##  2:   1   b   2
##  3:   3   c   5
##  4:   2   a  10
##  5:   3   b   3
##  6:   3   b   9
##  7:   2   b   8
##  8:   3   a   4
##  9:   1   c   1
## 10:   1   b   6

La columna Aca la ordena de menor a mayor, mientras que la columna Bar, la ordena de forma descendente.

AD <- setorder(Set, Aca, -Bar)
head(AD,10)

##     Aca Bar Cas
##  1:   1   c   7
##  2:   1   c   1
##  3:   1   b   2
##  4:   1   b   6
##  5:   2   b   8
##  6:   2   a  10
##  7:   3   c   5
##  8:   3   b   3
##  9:   3   b   9
## 10:   3   a   4

Cálculos varios

x	v	y	a	b
b	1	1	1	9
b	1	3	2	8
b	1	6	3	7
a	2	1	4	6
a	2	3	5	5
a	1	6	6	4
c	1	1	7	3
c	2	3	8	2
c	2	6	9	1

Resumen

STT[.N]             # last row, only special symbol allowed in 'i'

##    x v y a b
## 1: c 2 6 9 1

STT[, .N]           # total number of rows in DT

## [1] 9

STT[, .N, by=x]     # number of rows in each group

##    x N
## 1: b 3
## 2: a 3
## 3: c 3

STT[, .SD[1], by=x] # first row of 'y','v', 'a', 'b' for each group in 'x'

##    x v y a b
## 1: b 1 1 1 9
## 2: a 2 1 4 6
## 3: c 1 1 7 3

STT[, c(.N, lapply(.SD, sum)), by=x] # get rows *and* sum columns 'v' and 'y' by group

##    x N v  y  a  b
## 1: b 3 3 10  6 24
## 2: a 3 5 10 15 15
## 3: c 3 5 10 24  6

Selecciona aquellas columnas que se encuetran entre x & y.

FG <- STT[, .SD, .SDcols=x:y]
head(FG,9)

##    x v y
## 1: b 1 1
## 2: b 1 3
## 3: b 1 6
## 4: a 2 1
## 5: a 2 3
## 6: a 1 6
## 7: c 1 1
## 8: c 2 3
## 9: c 2 6

De la base de datos STT, eliminar las variables x y a

EC <- STT[, !c("x", "a")]
head(EC,5)

##    v y b
## 1: 1 1 9
## 2: 1 3 8
## 3: 1 6 7
## 4: 2 1 6
## 5: 2 3 5

Promedio y número de observaciones: Simil a summarize tidyverse

Obtenemos el promedio y el número de observaciones de la variable b, agrupado por la variable x

prome <- STT[, .(Promedio = mean(b, na.rm=T), Total = .N), by = x]

x	Promedio	Total
b	8	3
a	5	3
c	2	3

Subconjunto de datos

De la base de datos Conj, se selecciona la variable Aro, y se elige a.

Conj <- data.table(Aro   =sample(c('a', 'b', 'c'), 20, replace=TRUE),
                   Bate  =sample(c('a', 'b', 'c'), 20, replace=TRUE),
                   Drink =sample(20), key=c('Aro', 'Bate'))

Sub <- subset(Conj, Aro == 'a')
head(Sub,8)

##    Aro Bate Drink
## 1:   a    a    16
## 2:   a    a    11
## 3:   a    b    19
## 4:   a    c     2
## 5:   a    c     1

Creamos la base de datos denominada filtrar, la cual selecciona de la variable Bate, la opción a, obtenemos el promedio de la variable numérica Drink, y la agrupamos por el contenido de la variable Aro.

filtrar <- Conj[Bate == 'a', mean(Drink, na.rm=T), by=Aro]

head(filtrar,5)

##    Aro   V1
## 1:   a 13.5
## 2:   b 13.0
## 3:   c 15.0

Crear nuevas variables en función de variables pre-existentes

Creamos la variable Potencia, la cual se deriva de la variable Drink, para ellos utilizamos :=. Asímismo, redondeamos la variable Drink, con dos decimales.

Mu <- Conj[ ,Potencia := round(Drink/3,2)]

head(Mu,5)

##    Aro Bate Drink Potencia
## 1:   a    a    16     5.33
## 2:   a    a    11     3.67
## 3:   a    b    19     6.33
## 4:   a    c     2     0.67
## 5:   a    c     1     0.33

Creación de variables: Caso II

Base original

Section	Grade	Student
Mate 1	78	Ignacio
Mate 2	93	Amaru
Inglés 3	56	Etsa

gradebook[,Estado := 'A'] 
gradebook[Grade < 60, Estado := 'C']
gradebook[Grade >= 61  & Grade <= 79, Estado := 'B']

Resultado

Section	Grade	Student	Estado
Mate 1	78	Ignacio	B
Mate 2	93	Amaru	A
Inglés 3	56	Etsa	C

Subasignar por referencia

Si la variable Pepe tiene valores menores a 0, reemplazar en la variable José por Na

huge = data.table(Pepe = -2:2, José = LETTERS[1:5])
huge

##    Pepe José
## 1:   -2    A
## 2:   -1    B
## 3:    0    C
## 4:    1    D
## 5:    2    E

grande <- huge[Pepe < 0, José := NA]

head(grande,5)

##    Pepe José
## 1:   -2 <NA>
## 2:   -1 <NA>
## 3:    0    C
## 4:    1    D
## 5:    2    E

Eliminar una columna

De la nueva base creada, grande, eliminaremos la columna José

grande <- grande[, José := NULL]

head(grande,5)

##    Pepe
## 1:   -2
## 2:   -1
## 3:    0
## 4:    1
## 5:    2

Cálculo Compuesto: dcast.data.table

dcast.data.table: Permite crear una tabla de forma más eficiente, la cual contiene los países y el destino (Laguna y Montaña), contabilizado por la función agregada, longitud (length), considerando el valor de la variable Estaciones.
Total: Crea una variable total, que suma desde la segunda columna 2 hasta el final de la base ncol (resumen)
resumen [,c(1,ncol(resumen),2:(ncol(resumen)-1)),with=FALSE]: Coloca la columna total, como segunda columna, despúes que la de los países.

load("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Estaciones.RData")

head(Estaciones, 14)

##       Paises      fecha Destino Estación
##  1:  Hungría 2019-08-04  Laguna   Verano
##  2: Alemania 2019-08-04  Laguna   Verano
##  3: Alemania 2019-08-04  Laguna   Verano
##  4: Alemania 2019-08-04  Laguna   Verano
##  5: Alemania 2019-08-04  Laguna   Verano
##  6: Alemania 2019-08-04  Laguna   Verano
##  7: Alemania 2019-08-04  Laguna   Verano
##  8: Alemania 2019-08-04  Laguna   Verano
##  9:   Cánada 2019-08-04  Laguna   Verano
## 10: Alemania 2019-08-04  Laguna   Verano
## 11: Alemania 2019-08-04  Laguna   Verano
## 12: Alemania 2019-08-04  Laguna   Verano
## 13: Alemania 2019-08-04  Laguna   Verano
## 14: Alemania 2019-08-04  Laguna   Verano

Resultado:

resumen <- dcast.data.table(Estaciones, Paises ~ Destino, fun.aggregate = length,
                            value.var = 'Estación') 
resumen <-  resumen[,total:=rowSums(resumen[,2:ncol(resumen)])]
resumen <-  resumen [,c(1,ncol(resumen),2:(ncol(resumen)-1)),with=FALSE]

**Resumén**
Paises	total	Laguna	Montaña
Alemania	313	137	176
Bolivia	32	0	32
Colombia	50	3	47
Cánada	77	12	65
Hungría	73	47	26

Cálculo Compuesto II: Aplicación conceptos básicos

series_id	year	period	value	footnote_codes
LAUCN010010000000003	1990	M01	6.5	S
LAUCN010010000000003	1990	M02	6.5	S
LAUCN010010000000003	1990	M03	5.7	S
LAUCN010010000000003	1990	M04	6.6	S
LAUCN010010000000003	1990	M05	6.0	S

Resultado:
Crea dos nuevas variables: flips, meas , categorizadas como factor, la cual se origina de la columna series_id, en este caso, selecciona de la mencionada variable desde el elemento 6 hasta el 10, mientras que de la segunda variable, elige desde la letra 19 a la 20.
Ahora en cambio, selecciona los elementos de la variable measure y los ubica como columnas, los cuales se denomina 03 y 04. En este ejercicio, solo juega con las variables year, period & fips, dejando de lado a las variables series_id, value & footnotes.
Cambia el nombre de las variables 03 y 04 por tasa y desempleo, para aquello se apoya en el comando colnames
Crear una nueva variable denominada change, la cual es igual a la variable tasa * 15, a su vez se la redondea por uno.

survey[, c("fips", "measure") := list(as.factor(substr(series_id, start = 6, stop = 10)),
                                     as.factor(substr(series_id, start = 19, stop = 20)))]

survey <- dcast(survey, year+period+fips~measure)

survey[, state := as.factor(substr(fips, start = 1, stop =2))]

colnames(survey)[4:5]<-c("tasa","desempleo") 

survey[, c("change")
           := list(round(15*tasa, 1))]

**Cálculo Compuesto II**
year	period	fips	tasa	desempleo	state	change
1990	M01	01001	6.5	NA	01	97.5
1990	M02	01001	6.5	NA	01	97.5
1990	M03	01001	5.7	NA	01	85.5
1990	M04	01001	6.6	NA	01	99.0
1990	M05	01001	6.0	NA	01	90.0
1990	M06	01001	7.1	NA	01	106.5
1990	M07	01001	6.0	NA	01	90.0
1990	M08	01001	6.7	NA	01	100.5

Continuando con el ejercicio anterior, invocamos a la siguiente base

levels(survey$state) <- codigo$abbr[match(levels(survey$state), codigo$codes)]

Resultado:

Reemplaza el valor de la variable state (01) de la base survey, por el contenido de la variable abbr de la base codetable.

Cambiar nombre de variables que comparten un patrón

DÍAS Azul	DÍAS Negro	DÍAS Plata
14	19	10
15	20	20
18	22	12

colnames(AIO) <- gsub("DÍAS", "Días", colnames(AIO))

Días Azul	Días Negro	Días Plata
14	19	10
15	20	20
18	22	12

Cálculo Compuesto II: Reemplazar contenido de una variable

**Cálculo Compuesto III match**
Exam	Gender	Exam Type	Points
Final	M	B	40
Final	F	B	32
Final	F	B	60
Final	M	B	64
Final	M	B	56
Final	M	B	28
Final	F	A	56
Final	M	B	60
Final	M	B	44
Final	F	A	44
Final	F	B	60
Final	F	B	72
Final	F	A	56
Final	F	B	56
Final	M	B	48

dataset_one <- data.table(Examm)

tabla <- dataset_one[,.(Total=.N, Promedio= round(mean(Points),2)),by=.(Gender,`Exam Type`)]
tabla <- dcast.data.table(tabla,Gender~ `Exam Type` ,value.var='Total')
tabla <- tabla %>%
         adorn_totals(c("row", "col"))

tabla[Gender == 'F', Gender := 'Femenino']
tabla[Gender == 'M', Gender := 'Masculino']

Resultado:

**Cálculo Compuesto II: Resultado**
Gender	A	B	Total
Femenino	643	675	1318
Masculino	428	413	841
Total	1071	1088	2159

Transponer variable:

Del ejercicio anterior vamos a transponer la matriz, para aquello, aplicaremos la siguiente rutina.

Eliminamos los totales

TT <- tabla[(1:2), c(1:3)]
TT <- dcast(melt(TT,id.vars='Gender'), 
                     variable ~ Gender, value.var = 'value')%>%adorn_totals(c("row", "col"))

Resultado

**Trasponer**
variable	Femenino	Masculino	Total
A	643	428	1071
B	675	413	1088
Total	1318	841	2159

Reemplazar contenido de una variable: II Opción

dataset_one$Gender <- c("M" = "Masculino", 
                        "F" = "Femenino")[dataset_one$Gender]

Resultado:

**Cálculo Compuesto III: Resultado**
Exam	Gender	Exam Type	Points
Final	Masculino	B	40
Final	Femenino	B	32
Final	Femenino	B	60
Final	Masculino	B	64
Final	Masculino	B	56

SD: Subset Data

Species	Sepal.Length	Sepal.Width	Petal.Length	Petal.Width
setosa	4.9	3.1	1.5	0.2
setosa	5.4	3.9	1.7	0.4
setosa	4.9	3.6	1.4	0.1
setosa	5.2	3.4	1.4	0.2
setosa	4.6	3.6	1.0	0.2
setosa	5.5	4.2	1.4	0.2
setosa	4.4	3.0	1.3	0.2
setosa	5.1	3.7	1.5	0.4
setosa	4.7	3.2	1.3	0.2
setosa	5.5	3.5	1.3	0.2
setosa	4.4	3.2	1.3	0.2
setosa	5.1	3.4	1.5	0.2
setosa	4.9	3.0	1.4	0.2
setosa	5.0	3.5	1.3	0.3
setosa	5.0	3.2	1.2	0.2
setosa	5.1	3.3	1.7	0.5
setosa	5.4	3.4	1.7	0.2
setosa	5.1	3.8	1.5	0.3
setosa	5.1	3.5	1.4	0.2
setosa	5.0	3.4	1.5	0.2
versicolor	6.9	3.1	4.9	1.5
versicolor	6.8	2.8	4.8	1.4
versicolor	4.9	2.4	3.3	1.0
versicolor	5.5	2.4	3.8	1.1
versicolor	5.7	2.8	4.1	1.3
versicolor	5.8	2.6	4.0	1.2
versicolor	5.0	2.0	3.5	1.0
versicolor	5.9	3.2	4.8	1.8
versicolor	6.5	2.8	4.6	1.5
versicolor	6.0	3.4	4.5	1.6
versicolor	6.6	2.9	4.6	1.3
versicolor	5.7	2.6	3.5	1.0
versicolor	5.1	2.5	3.0	1.1
versicolor	6.6	3.0	4.4	1.4
versicolor	5.2	2.7	3.9	1.4
versicolor	6.3	2.5	4.9	1.5
versicolor	6.1	2.8	4.7	1.2
versicolor	5.7	3.0	4.2	1.2
versicolor	5.5	2.5	4.0	1.3
versicolor	7.0	3.2	4.7	1.4
virginica	6.2	3.4	5.4	2.3
virginica	6.5	3.0	5.5	1.8
virginica	5.6	2.8	4.9	2.0
virginica	7.1	3.0	5.9	2.1
virginica	7.2	3.0	5.8	1.6
virginica	5.8	2.7	5.1	1.9
virginica	6.1	2.6	5.6	1.4
virginica	7.9	3.8	6.4	2.0
virginica	6.4	2.7	5.3	1.9
virginica	7.7	2.8	6.7	2.0
virginica	7.4	2.8	6.1	1.9
virginica	6.7	3.0	5.2	2.3
virginica	6.0	3.0	4.8	1.8
virginica	7.7	3.0	6.1	2.3
virginica	7.3	2.9	6.3	1.8
virginica	6.3	2.5	5.0	1.9
virginica	5.8	2.7	5.1	1.9
virginica	7.7	2.6	6.9	2.3
virginica	6.3	2.9	5.6	1.8
virginica	6.5	3.2	5.1	2.0

SD: Filtrar datos

Selecciona las cuatro primeras filas, agrupada por la variable Species

SD_one <- Datt[, .SD[1:4], by = Species]

Species	Sepal.Length	Sepal.Width	Petal.Length	Petal.Width
setosa	4.9	3.1	1.5	0.2
setosa	5.4	3.9	1.7	0.4
setosa	4.9	3.6	1.4	0.1
setosa	5.2	3.4	1.4	0.2
versicolor	6.9	3.1	4.9	1.5
versicolor	6.8	2.8	4.8	1.4
versicolor	4.9	2.4	3.3	1.0
versicolor	5.5	2.4	3.8	1.1
virginica	6.2	3.4	5.4	2.3
virginica	6.5	3.0	5.5	1.8
virginica	5.6	2.8	4.9	2.0
virginica	7.1	3.0	5.9	2.1

Selecciona las dos últimas observaciones, agrupadas por la variable species

SD_two <- Datt[, tail(.SD,2), by = Species]

Species	Sepal.Length	Sepal.Width	Petal.Length	Petal.Width
setosa	5.1	3.5	1.4	0.2
setosa	5.0	3.4	1.5	0.2
versicolor	5.5	2.5	4.0	1.3
versicolor	7.0	3.2	4.7	1.4
virginica	6.3	2.9	5.6	1.8
virginica	6.5	3.2	5.1	2.0

Obtenga la fila con la longitud máxima clasificada por la variable petal_length

SD_three <- Datt[, .SD[which.max(Petal.Length)], by = Species]

Species	Sepal.Length	Sepal.Width	Petal.Length	Petal.Width
setosa	5.4	3.9	1.7	0.4
versicolor	6.9	3.1	4.9	1.5
virginica	7.7	2.6	6.9	2.3

Ahora en cambio aplicaremos una pequeña función que nos permitirá seleccionar cada una de las especies que integra la columna species

La función nos indica, que se podrá seleccionar la k Species: En este caso concreto, se podrá elegir entre: setosa - versicolor - virginica.
Generamos una vector especies, que detallará los tres tipos de especies que contiene la base.

pick_especies <- function(b,k){
            b <- b[Species==k,] 
}

especies <-unique(sort(Datt$Species))

setosa     <- pick_especies(Datt,especies[1])
versicolor <- pick_especies(Datt,especies[2])
virginica  <- pick_especies(Datt,especies[3])

head(virginica, 6)

##      Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1: virginica          6.2         3.4          5.4         2.3
## 2: virginica          6.5         3.0          5.5         1.8
## 3: virginica          5.6         2.8          4.9         2.0
## 4: virginica          7.1         3.0          5.9         2.1
## 5: virginica          7.2         3.0          5.8         1.6
## 6: virginica          5.8         2.7          5.1         1.9

like Convenience function for calling grep.

Para filtrar columnas de acuerdo a un patrón específico aplicamos la opción %like%. Para ello, consideremos la siguiente base.

Nombre	Puntaje
Marcos	200
Julio	303
Marta	404
Mario	505
Anabel	212

En este sentido, elegimos aquellos nombres que empiezan con la palabra Mar

AA <- DTF[Nombre %like% "^Mar"]

Nombre	Puntaje
Marcos	200
Marta	404
Mario	505

SC: Subset Columns

SD_four <- Datt[, lapply(.SD, sum), .SDcols = Sepal.Length:Sepal.Width]

Sepal.Length	Sepal.Width
353.3	182.5

Diferenciar entre filas

variable	2025-01-31	2025-03-03	2025-03-31	2025-05-01	2025-05-31
BJ	110	105	200	210	190
JK	130	150	170	250	160

Para diferenciar entre filas aplicamos la siguiente rutina

AH2 <- AH1[, lapply(.SD, diff), .SDcols = `2025-01-31` : `2025-05-31`]

2025-01-31	2025-03-03	2025-03-31	2025-05-01	2025-05-31
20	45	-30	40	-30

Transformar columnas tipo character to factor

Datos_2A <- data.frame(Asia    = sample(letters, 25, TRUE), 
                       America = sample(letters, 25, TRUE),
                       Europa  = sample(letters, 25, TRUE),
                       Numeros = rnorm(25))
setDT(Datos_2A)
sapply(Datos_2A, class)

##        Asia     America      Europa     Numeros 
## "character" "character" "character"   "numeric"

Creamos el vector charact_cols, el cual contiene las variables categorizadas como character

charact_cols <- names(Datos_2A)[sapply(Datos_2A, is.character)]
print(charact_cols)

## [1] "Asia"    "America" "Europa"

Datos_2A[, (charact_cols) := lapply(.SD, as.factor), .SDcols = charact_cols]
sapply(Datos_2A, class)

##      Asia   America    Europa   Numeros 
##  "factor"  "factor"  "factor" "numeric"

Lista

En esta ocasión, calcularemos el valor mínimo, q25, promedio, q75 y máximo

Puente	Vela	Ozono	Hacha	Avión
Barco	1	15	1	9
Barco	1	30	2	8
Barco	1	60	3	7
Ala	2	15	4	6
Ala	2	30	5	5
Ala	1	60	6	4
Cañon	1	15	7	3
Cañon	2	30	8	2
Cañon	2	60	9	1

Resumen <- sta[, list(Mínimo  = min(Avión),
                                   Q25     = quantile(Avión, probs=c(0.25)),
                                   Promedio= mean(Avión),
                                   Q75     = quantile(Avión, probs=c(0.75)),
                                   Máximo  =max(Avión)),
   by=.(Puente)]

Resumen %>%
    kbl() %>%
    kable_classic_2(full_width = F) %>%
    row_spec(0, bold= T, align = "justify")

Puente	Mínimo	Q25	Promedio	Q75	Máximo
Barco	7	7.5	8	8.5	9
Ala	4	4.5	5	5.5	6
Cañon	1	1.5	2	2.5	3

Reshaping

Base de Datos

**Bonus**
Tiempo	FF	PP	JJ
2021-05-05	1.098325	-0.3826983	-2.748010
2021-05-06	1.395346	0.3944406	-2.380448

Wide to Long

wide <- melt(bonus, id.vars= 'Tiempo',variable.name = "Componentes", value.name = "Valores")

wide %>%
    kbl() %>%
    kable_classic_2(full_width = F) %>%
    row_spec(0, bold= T, align = "justify")

Tiempo	Componentes	Valores
2021-05-05	FF	1.0983251
2021-05-06	FF	1.3953459
2021-05-05	PP	-0.3826983
2021-05-06	PP	0.3944406
2021-05-05	JJ	-2.7480101
2021-05-06	JJ	-2.3804477

Long to Wide

long <- dcast(wide, 
            Tiempo ~ Componentes, 
            value.var = "Valores")

long %>%
    kbl() %>%
    kable_classic_2(full_width = F) %>%
    row_spec(0, bold= T, align = "justify")

Tiempo	FF	PP	JJ
2021-05-05	1.098325	-0.3826983	-2.748010
2021-05-06	1.395346	0.3944406	-2.380448

Doble dcast

Año	Zona	Espacios	Amigos
2018	Urbano	29	1418
2018	Rural	29	1112
2019	Urbano	29	1538
2019	Rural	28	1266

AA <- dcast.data.table(setDT(Morona_II), Año ~ Zona,
                       value.var = c("Espacios", "Amigos"))

setcolorder(AA, c("Año", "Espacios_Rural", "Amigos_Rural","Espacios_Urbano","Amigos_Urbano"))

Año	Espacios_Rural	Amigos_Rural	Espacios_Urbano	Amigos_Urbano
2018	29	1112	29	1418
2019	28	1266	29	1538

Combinación librerias tidyverse y data.table

Con este ejercicio, se combina las herramientas que nos provee las librerias tidyverse y data.table. El objetivo es emplear los pipes %>%, para generar la rutina en una sola línea.

Combi <- vuelos[carrier== 'UA']%>%
        .[,list('Promedio Distancia'=mean(distance, na.rm = TRUE),
               'Promedio Tiempo'=mean(air_time, na.rm = TRUE)),
          by =.(dest)] %>%
          mutate_at(vars(starts_with('Promedio')),list(~round(.,2)))

dest	Promedio Distancia	Promedio Tiempo
IAH	1406.82	197.94
ORD	725.34	114.32
LAX	2461.43	325.87
SFO	2572.62	343.77
LAS	2227.00	299.04
MIA	1085.00	153.56
PBI	1023.00	145.27
FLL	1065.00	152.95
DEN	1611.43	224.63
SNA	2434.00	329.29
TPA	997.00	143.47
RSW	1068.00	157.17
SJU	1608.00	201.13
MCO	937.00	135.52
DFW	1372.00	197.99

Funciones

En esta sección, se aplicará brevemente los principales aspectos que integran las propiedades de la programación en R.

lapply

En la siguiente base de datos, el objetivo es calcular la composición porcentual por aquellas columnas numéricas.

**Tabla: Resu**
Paises	Laguna	Montaña
Alemania	137	176
Bolivia	0	32
Colombia	3	47
Cánada	12	65
Total	152	320

Para aquello, aplicamos la siguiente función, la cual la hemos denominado funci

funci = function(x) {
        if (is.numeric(x)) 
                paste0(round(x/x[nrow(Resu)],3)*100,'%')                     
        else as.character(x)                       
}

base_lapply = data.frame(lapply(Resu, FUN = funci))

**Tabla de Frecuencia**
Paises	Laguna	Montaña
Alemania	90.1%	55%
Bolivia	0%	10%
Colombia	2%	14.7%
Cánada	7.9%	20.3%
Total	100%	100%

Composición Porcentual por filas

En la presente sección, se analizará como calcular la composición porcentual de una base de datos, por fila, por medio de dos métodos. Trabajeremos con la base AABB

**Tabla: AABB**
Xile	Yate	Vac
b	2	1
b	4	2
b	7	3
a	2	4
a	4	5
a	7	6
c	2	7
c	4	8
c	7	9

Método Largo

Funciona si la base es de tipo data.frame no con data.table

ML <- cbind(AABB[1], 
                 round(prop.table(as.matrix(AABB[-1]), margin = 1),
                       2)*100)

**Método Largo**
Xile	Yate	Vac
b	67	33
b	67	33
b	70	30
a	33	67
a	44	56
a	54	46
c	22	78
c	33	67
c	44	56

En el caso que la base de datos sea del tipo data.table, se aplica la siguiente rutina

PPP <- sweep(AABB[,-1], 1, rowSums(AABB[,-1]), FUN="/")

Método Corto: Incluye [%]

Este método aparte de ser más corto, es más elegante, ya que mediante la aplicación del comando adorn_pct_formatting, permite la inclusión del simbolo de porcentajes [%]. Para aplicar este comando es importante invocar a la libreria janitor

MC <- AABB %>% 
        adorn_percentages(denominator = "row") %>%
        adorn_pct_formatting(digits = 2)

**Método Corto**
Xile	Yate	Vac
b	66.67%	33.33%
b	66.67%	33.33%
b	70.00%	30.00%
a	33.33%	66.67%
a	44.44%	55.56%
a	53.85%	46.15%
c	22.22%	77.78%
c	33.33%	66.67%
c	43.75%	56.25%

Porcentaje por columnas

MC_Columnas <- AABB %>% 
              adorn_percentages(denominator = "col") %>%
              adorn_pct_formatting(digits = 2)

**Porcentaje Columnas**
Xile	Yate	Vac
b	5.13%	2.22%
b	10.26%	4.44%
b	17.95%	6.67%
a	5.13%	8.89%
a	10.26%	11.11%
a	17.95%	13.33%
c	5.13%	15.56%
c	10.26%	17.78%
c	17.95%	20.00%

**Tabla Base**
Aro	Bate	Drink	Bebida
b	b	9	4
c	a	4	8
a	b	2	10
a	c	5	6
c	c	7	3
a	a	10	5
a	a	1	7
a	a	6	9
b	b	8	2
b	b	3	1

Creamos la función fix, y cambiamos la letra a por Ala y la letra c por Casa

fix <- function(caso) {
        caso <- gsub("a","Ala",caso)
        caso <- gsub('c','Casa', caso)
}

Conj[] <- lapply(Conj, fix)

**Tabla Respuesta**
Aro	Bate	Drink	Bebida
b	b	9	4
Casa	Ala	4	8
Ala	b	2	10
Ala	Casa	5	6
Casa	Casa	7	3
Ala	Ala	10	5
Ala	Ala	1	7
Ala	Ala	6	9
b	b	8	2
b	b	3	1

apply

Válido para data.frame

A <- function(x) x + 1

Conj <- data.frame(Aro    =sample(c('a', 'b', 'c'), 10, replace=TRUE),
                   Bate   =sample(c('a', 'b', 'c'), 10, replace=TRUE),
                   Drink  =sample(10), 
                   Bebida =sample(10))

Conj[,3:4] <- apply(Conj[,3:4], MARGIN=2, FUN=A)

**Aplicación Apply**
Aro	Bate	Drink	Bebida
c	c	7	4
b	c	11	8
b	b	6	10
b	b	9	2
a	c	8	9
b	c	3	3
c	c	2	5
a	b	10	6
c	c	5	11
a	c	4	7

split

Con esa opción podemos segmentar la base de datos por la variable elegida (en este caso, seleccionamos la variable países). El resultado será, una lista con cinco elementos, el cual contiene la información de los cinco países que contiene la base original.

load("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Estaciones.RData")
bases_sp <- split(Estaciones, Estaciones$Paises)

Aplicaciones split:

Caso I

En este apartado se expondrá las ventajas de aplicar listas a una base de datos, con el objetivo de emplear funciones que permita generar un proceso de automatización, produciendo resultados de forma rápida, eficiente y compacta.

Se crea la lista denominada RUNNAWAY, en la cual se generan tres listas con sus respectiva información.
Es necesario generar una lista vacia, en este caso se le denomina carr.
Por cada elemento de la lista RUNNAWAY, se genera una base denominada base, la cual agrupa a la variable age, y genera un conteo por cada uno de los elementos de dicha variable.
La base Unicornio, está compuesta por las variables A y B
La base Score tiene la misma dinámica que la variable Conteo
Todos estos elementos se los almacena en lista carr creada en los primeros pasos.
Para invocar a la nueva base, se crea la lista Pony, la cual se crea con la función carrera.analisis y la lista RUNNAWAY

RUNNAWAY <- split(base, base$name)


carrera.analisis<-function(RUNNAWAY){
                           carr <- list()
                           for (i in 1:length(RUNNAWAY)) {
                           
                             Conteo <- RUNNAWAY[[i]] %>%
                                       group_by(age)%>%
                             summarise(Total =n()) %>%
                             mutate(Acumulado= cumsum(Total),
                                    Perc= paste0(round(cumsum(100*Total/sum(Total)),2),'%'))
                             
                              Unicornio <- tabyl(RUNNAWAY[[i]], Variable_A, Variable_B)
                              
                              Score <-   RUNNAWAY[[i]]    %>%
                                                group_by(notas) %>%
                                                summarise(Total =n()) %>%
                                                mutate(Acumulado= cumsum(Total),
                                                       Perc=paste0(round(cumsum(100*Total/sum(Total)),2),'%'))
                                             
                            carr[[i]]<-list(Conteo   = Conteo,
                                             Unicornio = Unicornio,
                                             Score = Score)
                           }
        return(carr)
}


Ponny <- carrera.analisis(RUNNAWAY)

Caso II

El objetivo de esta rutina es eliminar valores atípicos de la variable numérica.

CARR_NBase <- split(Nueva_Base, Nueva_Base$variable_categorica)


outliers.analisis<-function(CARR_NBase){
                    carr <- list()
                    for (i in 1:length(CARR_NBase)) {
                      
    Outliers <- CARR_NBase[[i]] %>%
                data.table(boxplot(CARR_NBase[[i]]$variable_numerica, plot = FALSE)$out) %>%
                unique(by= 'V2') %>%
                arrange(V2)%>%
                select(-variable_numerica)
    
    Sin_outliers <- CARR_NBase[[i]] [!(CARR_NBase[[i]]$variable_numerica%in%Outliers$V2),] %>%
      mutate(Promedio         =  round(mean(variable_numerica),2),
             Desviacion       =  round(sd(variable_numerica),2),
             Summar           =  Promedio + Desviacion)
             
    carr[[i]]<-list(Base_Original = CARR,
                    Outliers      = Outliers,
                    Sin_outliers  = Sin_outliers)
  }
  return(carr)
}

FFF <- outliers.analisis(CARR_NBase)

Caso III: Guardar un lista en un archivo en Excel

Se necesita activar las librerias rio here. Se guardará en la carpeta Dattos la base denominada Especies_Base, el cual contiene en cada pestaña la información de las Species

Conjunto <- as.data.table(iris)

especies_split <- Conjunto %>% 
                  group_split(Species)

names(especies_split) <- especies_split %>%    
  
  map(.f = ~pull(.x, Species)) %>%        
  map(.f = ~as.character(.x)) %>%          
  map(.f = ~unique(.x))

especies_split %>% 
          writexl::write_xlsx(path = here("Dattos", "Especies_Base.xlsx"))

Caso IV: Guardar un lista en un archivo en .csv

Si por el contrario, queremos generar un archivo .csv por Especie, se aplica la siguiente rutina

Conjunto <- as.data.table(iris)

especies_split <- Conjunto %>% 
                  group_split(Species)

names(especies_split) %>%
  map(.f = ~export(especies_split[[.x]], file = str_glue("{here('Dattos')}/{.x}.csv")))

## list()

Caso V: Pasar archivos en Excel (sheet) al Global Environment

ruta: Generamos la ruta donde se encuentra el archivo que queremos extraer la información.

ruta <- "D:/Documentos/Estadisticos/R/R_studio/Data_Table/Base_Especies_A.xlsx"
Hojas_Nombre <- readxl::excel_sheets(ruta)
print(Hojas_Nombre)

## [1] "setosa"     "versicolor" "virginica"

Hojas_Nombre %>%
             purrr::map(function(sheet){ 
              assign(x = sheet,
                     value = readxl::read_xlsx(path = ruta, sheet = sheet),
                     envir = .GlobalEnv)
          })

## [[1]]
## # A tibble: 50 x 5
##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
##           <dbl>       <dbl>        <dbl>       <dbl> <chr>  
##  1          5.1         3.5          1.4         0.2 setosa 
##  2          4.9         3            1.4         0.2 setosa 
##  3          4.7         3.2          1.3         0.2 setosa 
##  4          4.6         3.1          1.5         0.2 setosa 
##  5          5           3.6          1.4         0.2 setosa 
##  6          5.4         3.9          1.7         0.4 setosa 
##  7          4.6         3.4          1.4         0.3 setosa 
##  8          5           3.4          1.5         0.2 setosa 
##  9          4.4         2.9          1.4         0.2 setosa 
## 10          4.9         3.1          1.5         0.1 setosa 
## # i 40 more rows
## 
## [[2]]
## # A tibble: 50 x 5
##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species   
##           <dbl>       <dbl>        <dbl>       <dbl> <chr>     
##  1          7           3.2          4.7         1.4 versicolor
##  2          6.4         3.2          4.5         1.5 versicolor
##  3          6.9         3.1          4.9         1.5 versicolor
##  4          5.5         2.3          4           1.3 versicolor
##  5          6.5         2.8          4.6         1.5 versicolor
##  6          5.7         2.8          4.5         1.3 versicolor
##  7          6.3         3.3          4.7         1.6 versicolor
##  8          4.9         2.4          3.3         1   versicolor
##  9          6.6         2.9          4.6         1.3 versicolor
## 10          5.2         2.7          3.9         1.4 versicolor
## # i 40 more rows
## 
## [[3]]
## # A tibble: 50 x 5
##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species  
##           <dbl>       <dbl>        <dbl>       <dbl> <chr>    
##  1          6.3         3.3          6           2.5 virginica
##  2          5.8         2.7          5.1         1.9 virginica
##  3          7.1         3            5.9         2.1 virginica
##  4          6.3         2.9          5.6         1.8 virginica
##  5          6.5         3            5.8         2.2 virginica
##  6          7.6         3            6.6         2.1 virginica
##  7          4.9         2.5          4.5         1.7 virginica
##  8          7.3         2.9          6.3         1.8 virginica
##  9          6.7         2.5          5.8         1.8 virginica
## 10          7.2         3.6          6.1         2.5 virginica
## # i 40 more rows

Guardar los archivos como listas empleando purrr::map

Hojas_Nombre %>%
  purrr::map(function(sheet){ # iterate through each sheet name
    readxl::read_xlsx(path = ruta, sheet = sheet)
  }) -> Bases # Assign to a list

Bases <- set_names(Bases, Hojas_Nombre)

Pasamos todas las bases creadas en el punto anterior, como listas

En BASE_III realizamos las siguientes operaciones:

En la primera línea, por cada lista generamos una nueva variable denominada año. En la primera base de la lista, se genera la variable año, que contiene el número 2015, en la segunda base, se crea la misma variable año, pero ahora con el 2016, y así sucesivamente.
En la segunda línea, a la variable Species, realizamos una transformación, de tal manera, que la primera letra de todas las palabras que se encuentren al interior de esa variable, comience con mayúscula.
En la tercera línea, ordenamos todas las bases, de tal manera, que la primera variable en aparecer sea Año.

BASE <- list(setosa, versicolor, virginica)

BASE_III <- Map(cbind,BASE, Año = (1:length(BASE)+2014)) %>%
            map(~ mutate(.x,Species=str_to_title(Species)))%>%
            map(~ select(.x,Año, everything()))

Para pasar de listas a una base de datos compacta

Can_2015_2020 <- bind_rows(BASE_III)

Para pasar las listas a data.frame independientes

lapply(seq_along(Bases), function(i) assign(names(Bases)[i], 
                                              Bases[[i]], envir = .GlobalEnv))

## [[1]]
## # A tibble: 50 x 5
##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
##           <dbl>       <dbl>        <dbl>       <dbl> <chr>  
##  1          5.1         3.5          1.4         0.2 setosa 
##  2          4.9         3            1.4         0.2 setosa 
##  3          4.7         3.2          1.3         0.2 setosa 
##  4          4.6         3.1          1.5         0.2 setosa 
##  5          5           3.6          1.4         0.2 setosa 
##  6          5.4         3.9          1.7         0.4 setosa 
##  7          4.6         3.4          1.4         0.3 setosa 
##  8          5           3.4          1.5         0.2 setosa 
##  9          4.4         2.9          1.4         0.2 setosa 
## 10          4.9         3.1          1.5         0.1 setosa 
## # i 40 more rows
## 
## [[2]]
## # A tibble: 50 x 5
##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species   
##           <dbl>       <dbl>        <dbl>       <dbl> <chr>     
##  1          7           3.2          4.7         1.4 versicolor
##  2          6.4         3.2          4.5         1.5 versicolor
##  3          6.9         3.1          4.9         1.5 versicolor
##  4          5.5         2.3          4           1.3 versicolor
##  5          6.5         2.8          4.6         1.5 versicolor
##  6          5.7         2.8          4.5         1.3 versicolor
##  7          6.3         3.3          4.7         1.6 versicolor
##  8          4.9         2.4          3.3         1   versicolor
##  9          6.6         2.9          4.6         1.3 versicolor
## 10          5.2         2.7          3.9         1.4 versicolor
## # i 40 more rows
## 
## [[3]]
## # A tibble: 50 x 5
##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species  
##           <dbl>       <dbl>        <dbl>       <dbl> <chr>    
##  1          6.3         3.3          6           2.5 virginica
##  2          5.8         2.7          5.1         1.9 virginica
##  3          7.1         3            5.9         2.1 virginica
##  4          6.3         2.9          5.6         1.8 virginica
##  5          6.5         3            5.8         2.2 virginica
##  6          7.6         3            6.6         2.1 virginica
##  7          4.9         2.5          4.5         1.7 virginica
##  8          7.3         2.9          6.3         1.8 virginica
##  9          6.7         2.5          5.8         1.8 virginica
## 10          7.2         3.6          6.1         2.5 virginica
## # i 40 more rows

Names

Para cambiar el nombre de una variable.

names(BD)[2] <- "Trabajo"
head(BD,4)

##    Terraza Trabajo Vac Grupo Conteo
## 1:       b       2   1     1      3
## 2:       b       4   2     1      3
## 3:       b       7   3     1      3
## 4:       a       2   4     2      3

map aplicando data.table

AE_list <- lapply(AE_list, as.data.table): Todos los elementos de la lista los transforma a data.table
map(~.[,lapply(.SD, diff), .SDcols = lat: lon]): Aplica la función .SD, diff bajo el argumento map.

AE <- airports

AE_list <- split(AE, AE$tzone)
AE_list <- lapply(AE_list, as.data.table)

AE_1 <- map(AE_list, ~slice(.x,tail(row_number(),2)))%>%
        map(~.[,lapply(.SD, diff), .SDcols = lat: lon])

bind_rows: dos listas con las mismas columnas

El objetivo de esta rutina es pegar filas una debajo de otra, manteniendo el esquema de listas. Para eso invocamos a map2

Base_A <- airports %>%
          filter(tzone %in% c("America/Denver","America/Chicago"))%>%
          group_by(tzone)%>%
          slice(head(row_number(),5))

Base_A_lista <- split(Base_A, Base_A$tzone)
          

Base_B <- airports %>%
          filter(tzone %in% c("America/Denver","America/Chicago"))%>%
          group_by(tzone)%>%
          slice(tail(row_number(),5))

Base_B_lista <- split(Base_B, Base_B$tzone)

Consolidado_Listas <- map2(Base_A_lista, Base_B_lista,bind_rows)

Crear una columna con valores de un vector

Creamos el vector denominado APL, el cual contiene dos valores, con lo cual se generará una columna denominada APL, que tendrá los valores del vector previamente creado. Al aplicar .before =1, le indicamos que deseamos que la primera columna se cree al inicio de la base de datos.
map(~mutate(.x, APL = if_else(row_number() == 1, APL, 0))): Permite que por cada columna creada por base de datos, solo se mantenga el valor de la primera fila, el resto 0.

"APL" <- c(503, 104)

Consolidado_Listas_A <- map2(Consolidado_Listas, APL, ~ .x %>% 
                             mutate(APL = .y, .before = 1)) %>%
                        map(~mutate(.x, APL = if_else(row_number() == 1, APL, 0)))

Importar archivos en Excel, que contienen el mismo nombre de hojas como listas

#setwd("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Dattos_A")
require(knitr)
opts_knit$set(root.dir = "D:/Documentos/Estadisticos/R/R_studio/Data_Table/Dattos_A")

files <- list.files(pattern=".xlsx")

GH <- list()

for (i in seq_along(files)) {
     GH[[i]] <- files[i] %>%
       map_df(
         ~read_xlsx(path=files[i], sheet= "BAL",skip = 4)) 
}
GH <- set_names(GH, files)

Importar archivos en Excel: setnames Fechas

setwd("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Bank")

files <- list.files(pattern=".xlsx")

GH <- list()

for (i in seq_along(files)) {
  GH[[i]] <- files[i] %>%
    map_df(
      ~read_xlsx(path=files[i], sheet= "BAL",range = "A5:E11")%>%
        setNames(., c('CÓDIGO', 'CUENTA', format(as.Date(as.numeric(names(.)[-2]),
        origin='1899-12-30'), '%Y/%m/%d')))) 
}

GH <- set_names(GH, files)

list_files: Ejercicio completo fusión con map

En la línea excel_files_C, se detallan aquellos archivos con formato .xlsx. \. significa que estás buscando el carácter punto (.). El símbolo $ se utiliza para indicar el final de una cadena. En este caso, \.xlsx significa que se está buscando una cadena que termine con .xlsx
excel_data_list_C: Todos los archivos de Excel, que se encuentran almacenados en la carpeta excel_files_C serán importados como listas
basename: Los archivos almacenados al interior de la lista excel_data_list_C, serán nombrados tal cual el nombre del archivo en Excel.

ruta_C            <- "D:/Documentos/Estadisticos/R/R_studio/Data_Table/Bank_II"

excel_files_C     <- list.files(path = ruta_C, pattern = "\\.xlsx$", full.names = TRUE)

excel_data_list_C <- map(excel_files_C, read_excel)    

names(excel_data_list_C) <- basename(excel_files_C)

Importar archivos en Excel con diferentes estructuras

ruta_C            <- "D:/Documentos/Estadisticos/R/R_studio/Data_Table/Bank_II"
excel_files <- list.files(path = ruta_C, pattern = "\\.xlsx$", full.names = TRUE)

# Create an empty list to store the data.frames
data_frames <- list()

for (i in seq_along(excel_files)) {
  # Extract the base name of the file (without extension)
  file_name <- tools::file_path_sans_ext(basename(excel_files[i]))
  
  # Read the Excel file into a data.frame
  if (i == 4) {
    data_frames[[file_name]] <- read_excel(excel_files[i], col_names = FALSE)
  } else {
    data_frames[[file_name]] <- read_excel(excel_files[i])
  }
}

Formato Excel: openxls- En construcción

LISA <- function(GH){
      Bart <- list()
      for (i in 1:length(GH)) {
    
    AMG <- GH[[i]] %>%
           filter(CÓDIGO %in% c(11,14))%>%
           select(CÓDIGO,'39051','39082')
         
    Bart[[i]] <- list(AMG=AMG)
      }
      return(Bart)
}

HS <- LISA(GH)

HS <- set_names(HS, files)    

library(openxlsx)

headerStyle <- createStyle(fontSize = 12, 
                           fontColour = "#FFFFFF", 
                           halign = "center",
                           fgFill = "#4F81BD", 
                           border=c("top", "bottom", "left", "right"), 
                           borderColour= "#4F81BD", 
                           textDecoration = "bold")

bodyStyle <- createStyle(border="TopBottomLeftRight", numFmt = "COMMA") 



HS %>%
  imap(~{
    wb <- createWorkbook()
    Map(function(data,nameofsheet){
       addWorksheet(wb, nameofsheet)
       addStyle(wb,nameofsheet, headerStyle, rows=1,
                cols=c(1:ncol(as.data.frame(data))),
                gridExpand=TRUE)
       setcolwidths(wb, nameofsheet,
                    cols=c(1:ncol(as.data.frame(data))),
                    widths=20)
       setRowHeights(wb, nameofsheet, rows=1, heights=40)
       addStyle(wb,nameofsheet,bodyStyle,rows=c(2:nrow(as.data.frame(data))+1),
                cols = c(1:ncol(as.data.frame(data))),gridExpand = TRUE)
       writeData(wb, nameofsheet, data)
      }, .x, names(.x))

saveWorkbook(wb, file.path("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Dattos_A",sprintf("Test_%s", .y)))
                }
  )

stringr::str_replace_all

Ordenar la columna CODIGOS, de acuerdo al orden establecido en el vector HHAG
Reemplazar aquellos patrones que contegan 1_, 3_, 4_ y 5_, por vacíos.

Paises_Sud <- read_excel("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Paises_Sud.xlsx")

Paises_Sud_List <- split(Paises_Sud, Paises_Sud$LETRA)

HHAG <- c("1_Cascada", "3_Yield", "4_Producto", "5_Origen")

Paises_BC <- map(Paises_Sud_List,~arrange(.x,sapply(CODIGOS, function(y) which(y==HHAG))))  %>%
             map(~mutate_at(.x,vars(2),~ stringr::str_replace_all(string = .x, 
                                                      pattern = "[1_,3_,4_,5]", replacement = "")))

Lo anterior, se lo puede expresar de la siguiente manera, respecto al orden de las filas

Paises_Sud <- read_excel("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Paises_Sud.xlsx")

Paises_Sud_List <- split(Paises_Sud, Paises_Sud$LETRA)

HHAG <- c("1_Cascada", "3_Yield", "4_Producto", "5_Origen")

Paises_BC <- map(Paises_Sud_List,~slice(.x, match(HHAG,CODIGOS)))

map_at

Si deseamos modificar cierta información por elemento de lista, invocamos la siguiente rutina.Esto implica que del elemento Argentina, trabajaremos, con las filas 1 y 4, mientras que del elemento Colombia, trabajaremos con las filas 2 y 3. Por su parte, del elemento Brasil, trabajaremos con todos sus elementos.

LO <- read_excel("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Paises_Sud.xlsx")

LO_List <- split(LO, LO$LETRA)


LoA <- LO_List %>%
       map_at(c("Argentina"),
              ~slice(.x,c(1,4)))%>%
       map_at(c("Colombia"),
              ~slice(.x,c(2,3)))

map_at: ejercicio completo

data_frames_A <- data_frames %>%
                 map_at("CASH", ~ .x %>%
                         setNames(c('Fecha:', format(as.Date(as.numeric(names(.x)[-1]), 
                                                             origin = '1899-12-30'), '%Y/%m/%d'))) %>%
                         filter(`Fecha:` == "B Saldo Final:   A + (1 - 2)") %>%
                         select(`2025/02/28`) %>%
                         mutate(`Tasa Int` = 0.0425)%>%
                         rename("Valor Nominal"=1)  %>%
                         mutate_if(is.character, as.numeric))%>%
                 map_at("Valoración PAGOS Feb-2025", ~ .x %>%  
                         slice(5:10) %>%  
                         row_to_names(row_number = 1) %>%
                         filter(!No. =="SUBTOTAL POSICION INSTRUMENTOS AL DESCUENTO")%>%
                         select(8,13)%>%
                         mutate_if(is.character, as.numeric)%>%
                         rename("Valor Nominal"=1,
                                `Tasa Int` =2)) %>%
                 map_at("Venc_4_PAGOS", ~ .x %>%
                        slice(13:15)%>%
                        select(13,11)%>%  
                        mutate_if(is.character, as.numeric)%>%
                        rename("Valor Nominal"=1,
                                 `Tasa Int` =2)  
                          )

imap

Un ejercicio similar al anterior y el cual permite trabajar con dos condicionales es el siguiente

AD <- read_excel("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Paises_Sud.xlsx")

AD <- split(AD, AD$LETRA)

AD1 <- AD %>%
       imap(~if(.y %in% c("Argentina", "Colombia")){
         .x %>%
           slice(c(1:3))
       }
       else{
         slice(.x,c(2:4))
       
       }
)

imap: create a new variable with the name of the data.frame inside the list

my_list_named <- imap(my_list, ~ mutate(.x, Animales = .y))

my_list_named[["Toros"]]

##    name Animales
## 1 Alice    Toros
## 2   Bob    Toros

imap: Doble interative

rollback(): es una función que pertenece al paquete timeDate en R, el cual está orientado a manejo de fechas y cálculos financieros.

La función rollback() se utiliza para obtener la fecha del último día hábil anterior a una fecha dada, es decir, “retroceder” hasta el día laboral anterior, ignorando fines de semana o días festivos definidos en el calendario.

El parámetro roll_to_first controla el comportamiento en caso de que la fecha pivote ya sea un día no hábil (por ejemplo, fin de semana). Si fuera TRUE, la función retornaría el primer día hábil siguiente a Fecha_pivote.

Fecha_pivote   <- dmy("30-04-2025")
fecha_anterior <- rollback(Fecha_pivote, roll_to_first = FALSE)

tasas_bloomberg_A <- read_excel("tasas_bloomberg_A.xlsx")%>%
                     select(1,67,69)%>%
                     pivot_longer(cols  = 2:3,
                                  names_to = c("Índice"),
                                  values_to = "Ratio")

## New names:
## * `AGDN030Y INDEX` -> `AGDN030Y INDEX...38`
## * `AGDN030Y INDEX` -> `AGDN030Y INDEX...66`

MMes <- format(Fecha_pivote, "%B", locale = "es_ES.UTF-8")

Fecha	Índice	Ratio
2013-12-01	SOFRRATE Index	0
2013-12-01	LD20TRUU	0
2013-12-02	SOFRRATE Index	0
2013-12-02	LD20TRUU	0
2013-12-03	SOFRRATE Index	0

Para replicar un conjunto de datos, aplicando la segunda fila del siguiente chunk.

tasas_bloomberg_AA <- split(tasas_bloomberg_A, tasas_bloomberg_A$Índice) 

tasas_bloomberg_AA[["LD20TRUU_LM"]] <- tasas_bloomberg_AA[["LD20TRUU"]]

tasas_bloomberg_AB <- tasas_bloomberg_AA %>%   
                      map_at(c("SOFRRATE Index"), ~ .x %>%
                               filter(Fecha > "2024-06-30") %>%
                               mutate(Fecha = ymd(Fecha),
                                      Ratio = Ratio / 100,
                                      incremento = (1 + Ratio)^(1 / 365)) %>%
                               mutate(multiplicador = cumprod(replace(incremento, 
                                                                      row_number() == 1, 1))) %>%
                               
                               {df <- .
                                 
                                 # 1. Monthly change (last vs end of previous month)
                                 fecha_pivote   <- max(df$Fecha, na.rm = TRUE)
                                 fecha_anterior <- rollback(fecha_pivote, roll_to_first = FALSE)
                                 
                                 valor_pivote <- df %>%
                                                 filter(Fecha <= fecha_pivote) %>%
                                                 slice_tail(n = 1) %>%
                                                 pull(multiplicador)
                                 
                                 valor_ant <- df %>%
                                              filter(Fecha <= fecha_anterior) %>%
                                              slice_tail(n = 1) %>%
                                              pull(multiplicador)
                                 
                                 cambio_mensual <- (valor_pivote / valor_ant) - 1
                                 
                                 # 2. Acumulado (first to last)
                                 VI <- df %>% 
                                          slice_head(n = 1) %>% 
                                          pull(multiplicador)
                                 VF <- valor_pivote
                                 acumulado <- (VF / VI) - 1
                                 
                                 # 3. YTM enero-abril (last of April vs last of December)
                                 VI_dic <- df %>%
                                           filter(month(Fecha) == 12, 
                                                  year(Fecha)  == year(fecha_pivote) - 1) %>%
                                           filter(Fecha == max(Fecha)) %>%
                                           pull(multiplicador)
                                 
                                 ytm_enero_2025 <- if (length(VI_dic) > 0) {
                                                      (VF / VI_dic) - 1
                                                   } else {
                                                     NA_real_  # if no December data available
                                                   }
                                 
                                 df %>%
                                   mutate(cambio_mensual = cambio_mensual,
                                          acumulado = acumulado,
                                          !!paste0("ytm_enero_", MMes) := ytm_enero_2025)%>%
                                   slice_tail(n = 1)%>%
                                   select(1,6:ncol(.))%>%
                                   mutate(across(where(is.numeric), ~ .x * 100))%>%
                                   mutate(across(where(is.numeric), ~round(.x,digits = 3)))
                                 
                                          })%>%
  imap(~ {
    df <- .x
    nombre <- .y
    
    if (nombre == "LD20TRUU" || nombre == "LD20TRUU_LM") {
      # Filtro de fechas específico
      df <- df %>%
        filter(Fecha > if (nombre == "LD20TRUU") "2023-12-20" else "2024-06-30") %>%
        mutate(Fecha = ymd(Fecha))
      
      # Fechas clave
      fecha_pivote   <- max(df$Fecha, na.rm = TRUE)
      fecha_anterior <- rollback(fecha_pivote, roll_to_first = FALSE)
      
      # Valor final
      valor_pivote <- df %>%
        filter(Fecha <= fecha_pivote) %>%
        slice_tail(n = 1) %>%
        pull(Ratio)
      
      # Valor anterior
      valor_ant <- df %>%
        filter(Fecha <= fecha_anterior) %>%
        slice_tail(n = 1) %>%
        pull(Ratio)
      
      cambio_mensual <- (valor_pivote / valor_ant) - 1
      
      # Acumulado
      VI <- df %>% slice_head(n = 1) %>% pull(Ratio)
      VF <- valor_pivote
      acumulado_bruto <- (VF / VI) - 1
      
      # Si es LD20TRUU, aplicar tasa anualizada
      if (nombre == "LD20TRUU") {
        dias_dif <- as.numeric(fecha_pivote - df$Fecha[1])
        acumulado <- (1 + acumulado_bruto)^(365 / dias_dif) - 1
      } else {
        acumulado <- acumulado_bruto
      }
      
      # YTM enero-abril
      VI_dic <- df %>%
        filter(month(Fecha) == 12, year(Fecha) == year(fecha_pivote) - 1) %>%
        filter(Fecha == max(Fecha)) %>%
        pull(Ratio)
      
      ytm_enero_2025 <- if (length(VI_dic) > 0) {
        (VF / VI_dic) - 1
      } else {
        NA_real_
      }
      
      df %>%
        mutate(
          cambio_mensual = cambio_mensual,
          acumulado = acumulado,
          !!paste0("ytm_enero_", MMes) := ytm_enero_2025
        ) %>%
        slice_tail(n = 1) %>%
        select(1, 4:6) %>%
        mutate(across(where(is.numeric), ~ round(.x * 100, 3)))
    } else {
      df  # No hacer nada si no es LD20TRUU o LD20TRUU_LM
    }
  })

map & nrow

Mapas <-  airports %>%
          filter(tzone %in% c("America/Denver","America/Chicago", "America/New_York"))%>%
          group_by(tzone)%>%
          slice(head(row_number(),10))

Mapas_A <- split(Mapas, Mapas$tzone)

Mapas_A <- Mapas_A %>%
           map_at(c("America/Chicago"),
                  ~slice(.x,c(1:3)))

Mapas_B <- Mapas_A %>%
           map(~if(nrow(.x)>=10){
             slice(.x,c(1:5))
           }else{
             slice(.x,c(1:2))
             })

select, colnames(.), ifelse

Lo que nos indica esta rutina, es lo siguiente: Si dentro de las variables, existe aquella denominada Yate, elígeme esa variable, caso contrario elígeme la variable Oceano.

docu <- list.files(pattern=".xlsx")
docu <- docu[c(1,6)]

GH <- list()

for (i in seq_along(docu)) {
     GH[[i]] <- docu[i] %>%
       map_df(
         ~read_xlsx(path=docu[i], sheet= "Test")) 
}
GH <- set_names(GH, docu)

Arco <- map(GH,~select(.x,Barco, Casa, ifelse("Yate" %in% colnames(.), "Yate", "Oceano")))

print(Arco)

select, any_of

any_select <- read_excel("D:/Documentos/Estadisticos/R/R_studio/Data_Table/any_select.xlsx")

City <- split(any_select, any_select$Ciudad)

# Vector Nombres

Nombres <- c ("Ciudad","Habitantes", "Salario", "Temperatura")

City_AA <- City %>% map(~select(.x,any_of(Nombres)))
City_AA

## $`La Paz`
## # A tibble: 2 x 4
##   Ciudad Habitantes Salario Temperatura
##   <chr>       <dbl>   <dbl>       <dbl>
## 1 La Paz        372     792         484
## 2 La Paz        887     621         457
## 
## $Lima
## # A tibble: 2 x 4
##   Ciudad Habitantes Salario Temperatura
##   <chr>       <dbl>   <dbl>       <dbl>
## 1 Lima          743     170         207
## 2 Lima          459     324         523
## 
## $Quito
## # A tibble: 2 x 4
##   Ciudad Habitantes Salario Temperatura
##   <chr>       <dbl>   <dbl>       <dbl>
## 1 Quito         831     612         723
## 2 Quito         224     777         751

Extraer nombre específico

heroes <- tibble(archivo=paste0('Bank_II/', dir('Bank_II')))%>%
          mutate(Capa=str_replace(archivo,pattern = '.*GAME_',''),
                 Capa=str_replace(Capa, pattern = '_.*$',''))

archivo	Capa
Bank_II/GAME_BATMAN_SEP_2343_web.xlsx	BATMAN
Bank_II/GAME_ROBIN_SEP_2343_web.xlsx	ROBIN

Importación de bases de datos provenientes de Excel

Importar archivos en formato .xlsx- libreria purr

setwd("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Bank")

#knitr::opts_knit$set(root.dir = normalizePath("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Bank"))

docu <- list.files("D:/Documentos/Estadisticos/R/R_studio/Data_Table/Bank")

MMN <- list()

for (i in seq_along(docu)) {
     MMN[[i]] <- docu[i] %>%
       map_df(
         ~read_xlsx(path=docu[i], sheet= "BAL",skip = 4)) 
}
MMN <- set_names(MMN, docu)

MMN <- map(MMN,~ select(.x,c(1,2,235))%>%
       map(~filter(.x,CÓDIGO %in% c("11","12","14"))))

Importar todas las hojas de todos los libros

fil <- list.files(path = "D:/Documentos/Estadisticos/R/R_studio/Data_Table/Fina",
                  pattern = "*.xlsx")

read_excel_allsheets <- function(filename) { 
  sheets <- readxl::excel_sheets(filename) 
  x <- lapply(sheets, function(X) readxl::read_excel(filename, sheet = X)) 
  names(x) <- sheets 
  x 
} 

out <- lapply(fil, read_excel_allsheets)
names(out) <- basename(fil)

Importar ciertas hojas del archivo de Excel

# Define the Excel file path
file_path <- "Escenarios_DEF.xlsx"

# Specify the sheet names you want to import (as a vector)
sheets_to_import <- c("Productivo corporativo", "Productivo empresarial",
                      "Productivo pymes")

# Create an empty list to store the data frames
data_list_ESC <- list()

# Loop through each sheet name and import it into the list
for (sheet_name in sheets_to_import) {
     data_list_ESC[[sheet_name]] <- read_excel(file_path, sheet = sheet_name)
}

Función: Determinar valores atípicos

Hola
1
2
3
4
3
200
3
400
1100

eliminar_atipicos <- function(x, na.rm= TRUE, ...){
qnt <- quantile(x, probs=c(.25,.75), na.rm= na.rm,...)
H   <- 1.5*IQR(x, na.rm= na.rm)
y   <- x
y [x <(qnt[1]-H)] <- NA
y [x >(qnt[2]+H)] <- NA
y
}

QB <- men %>%
      mutate_at(vars(Hola), funs(eliminar_atipicos))

Hola
1
2
3
4
3
200
3
400
NA

map & bind_rows

AA <- map(BB, ~bind_rows(.x,summarise(., across(where(is.numeric), sum),
                                         across(where(is.character),~"Total"))))

Listas: ordenar número de filas

BB <- VV [order(sapply(VV,nrow),decreasing)]

map2 & left_join

AA <- BB%>% map2(left_join,c("Casa"="kl"))

compact

Esta rutina proviene de la libreria purrr, la cual tiene como objetivo, elementos vacios al interior de listas

AD <- list(a = "a", b = NULL, c = integer(0), d = NA, e = list())
  
AF <- compact(AD)

keep

Permite filtrar por el número de elementos al interior de listas

AA <- BB %>% keep(~all(nrow(.x) >= 13))

left_join: varias bases de datos

AA <- purrr::reduce(list(BASE_A, BASE_B,BASE_C,BASE_D), dplyr::left_join, by="VAR_COMUN")

Extraer dos elementos de una lista de listas

rt <- list.map(rt, c(.[1],.[2]))

pluck

Con esta opción, ud podrá elegir elementos de una lista de lista, y ubicarlo en la primera posición


AS <- FF %>%
      map_at(c(1,2,3),pluck(1))%>%
      map_at(c(4,5,6), pluck(3))

Improve map

aa <- setdat %>%
      map(~.x %>%
            filter(!is.na(CASINO), Lobo != "Oveja") %>%
            rename(MMM = 1, BBB = 2))

Iterative map_dfr

Esta rutina permite iterar el código FIXBIS_POSICIÓN_RKP a través de la fecha pivote creada previamente.

# Define the sequence of dates
fechas_pivote <- seq(ymd("2024-12-01"), ymd("2024-12-31"), by = "days")

# Iterate over each Fecha_Pivote_C and bind results
Base_plazo_AAR <- map_dfr(fechas_pivote, function(Fecha_Pivote_C) {
                  Base_plazo_A %>%
                    pivot_longer(cols = `1 Semana US0001W Index`:`360 días AGDN360Y INDEX`,
                                 names_to = c("Índice"),
                                 values_to = "Tasa Descuento") %>%
                    rename(`Fecha de vencimiento` = 1) %>%
                    mutate(Fecha = Fecha_Pivote_C) %>%
                    unite(concatenar, Fecha, `Fecha de vencimiento`, Índice, sep = " ", remove = FALSE) %>%
                    dplyr::select(Fecha, `Fecha de vencimiento`, concatenar, everything()) %>%
                    mutate(Control = ifelse(Fecha == `Fecha de vencimiento`, 1, 0)) %>%
                    dplyr::filter(Control == 1) %>%
                    unite(concatenar_II, Fecha, Índice, sep = " ", remove = FALSE)
                })

# Base dataset for all days up to 368
TASAS_FIXBIS <- data.frame("Días por vencer" = seq(1, 368, by = 1), stringsAsFactors = FALSE)

# Improved extraction of discount rates from Tasas_Agencias_A
dias_por_vencer_AA <- c(1, 7, 14,21, 30, 60, 90, 120, 150, 180, 210, 240, 270,300,330, 360)

# Iterate over each date
TASAS_FIXBIS_AR <- map_dfr(fechas_pivote, function(Fecha_Pivote_C) {
  
  # Calculate tasas_descuento for the current Fecha_Pivote_C
  TASAS_FIXBIS %>%
    rename(`Días por vencer` = 1) %>%
    mutate(
      "Tiempo por vencer" = case_when(
        `Días por vencer` == 1   ~ "1 día",
        `Días por vencer` == 7   ~ "1 semana",
        `Días por vencer` == 14  ~ "2semanas",
        `Días por vencer` == 21  ~ "3 semanas",
        `Días por vencer` == 30  ~ "1 mes",
        `Días por vencer` == 60  ~ "2 meses",
        `Días por vencer` == 90  ~ "3 meses",
        `Días por vencer` == 120 ~ "4 meses",
        `Días por vencer` == 150 ~ "5 meses",
        `Días por vencer` == 180 ~ "6 meses",
        `Días por vencer` == 210 ~ "7 meses",
        `Días por vencer` == 240 ~ "8 meses",
        `Días por vencer` == 270 ~ "9 meses",
        `Días por vencer` == 300 ~ "10 meses",
        `Días por vencer` == 330 ~ "11 meses",
        `Días por vencer` == 360 ~ "12 meses",
        TRUE ~ ""
      ),
      Índice = case_when(
        `Días por vencer` == 1   ~ "FIXBUC1D Index",
        `Días por vencer` == 7   ~ "Fixbuc1w Index",
        `Días por vencer` == 14  ~ "Fixbuc2w Index",
        `Días por vencer` == 21  ~ "Fixbuc3w Index",
        `Días por vencer` == 30  ~ "Fixbuc1m Index",
        `Días por vencer` == 60  ~ "Fixbuc2m Index",
        `Días por vencer` == 90  ~ "Fixbuc3m Index",
        `Días por vencer` == 120 ~ "Fixbuc4m Index",
        `Días por vencer` == 150 ~ "Fixbuc5m Index",
        `Días por vencer` == 180 ~ "Fixbuc6m Index",
        `Días por vencer` == 210 ~ "Fixbuc7m Index",
        `Días por vencer` == 240 ~ "Fixbuc8m Index",
        `Días por vencer` == 270 ~ "Fixbuc9m Index",
        `Días por vencer` == 300 ~ "Fixbuc10m Index",
        `Días por vencer` == 330 ~ "Fixbuc11m Index",
        `Días por vencer` == 360 ~ "Fixbuc1y Index",
        TRUE ~ ""),
      `Fecha de vencimiento` = as.Date(Fecha_Pivote_C) + `Días por vencer`,  
      Fecha = Fecha_Pivote_C) %>%
    unite(concatenar, Fecha, `Fecha de vencimiento`, Índice, sep = " ", remove = FALSE) %>%
    select(Fecha, `Fecha de vencimiento`, concatenar, everything()) %>%
    mutate(Control = ifelse(Fecha == `Fecha de vencimiento`, 1, 0)) %>%
    unite(concatenar_II, Fecha, `Tiempo por vencer`, Índice, sep = " ", remove = FALSE) %>%
    left_join(select(Base_plazo_AAR, "concatenar_II", "Tasa Descuento"), by = c("concatenar_II"))
})

tasas_descuento <-  TASAS_FIXBIS_AR %>%
                    filter(`Días por vencer` %in% dias_por_vencer_AA) %>%
                    pull(`Tasa Descuento`)

# Assign descriptive names to the extracted rates
names(tasas_descuento) <- c("un_dd", "siete_dia", "catorce_di", "veinte_uno_di", "treinta_di", 
                            "sesenta_di", "noventa_di", "ciento_20_di", "ciento_50_di", 
                            "ciento_80_di", "Dosc_10_di", "Dosc_40_di", "Dosc_70_di", "Tres_di",
                            "Tres_30_di", "Tres_60_di")

# Check if days up to 360 are present
max_days_A <- 360

# Extend the data frame to include all days up to 360
TASAS_FIXBIS_A_extended <- TASAS_FIXBIS_AR %>%
                           complete(`Días por vencer` = 1:max_days_A)


# known_days <- c(1, 7, 14, 21, 30, 60, 90, 120, 150, 180, 210, 240, 270, 300, 330, 360)
# 
# known_rates <- tasas_descuento[c("un_dd", "siete_dia", "catorce_di", "veinte_uno_di", 
#                                  "treinta_di", "sesenta_di", "noventa_di", "ciento_20_di", 
#                                  "ciento_50_di", "ciento_80_di", "Dosc_10_di", "Dosc_40_di", 
#                                  "Dosc_70_di", "Tres_di", "Tres_30_di", "Tres_60_di")]

# Interpolate rates for all days
TASAS_FIXBIS_AA <- TASAS_FIXBIS_A_extended %>%
                   mutate(`Tasa Descuento` = if_else(`Días por vencer` %in% known_days, 
                                                      `Tasa Descuento`,  # Keep existing rates for known days
                                                      approx(x = known_days, y = known_rates, 
                                                             xout = `Días por vencer`, rule = 2)$y))

FIXBIS_POSICIÓN_Ventas <-   read_excel(excel_files_internacional, col_names = FALSE) %>%
                            set_colnames_and_clean()%>%
                            filter(`TRAN TYPE`   == "Sell Long", 
                                   str_detect(INSTRUMENTO, "^FIXBIS"))%>%
                            select("Precio Venta" =`F Valor Co.`,INSTRUMENTO,"V.Nomial Co.") %>%
                            mutate(`Precio Venta` = mdy(`Precio Venta`))

options(digits = 12)

FIXBIS_POSICIÓN_RK <- map_dfr(fechas_pivote, function(Fecha_Pivote_C) {
  # Read and clean the data
  df <- read_excel(excel_files_internacional, col_names = FALSE) %>%
    set_colnames_and_clean() %>%
    filter(`TRAN TYPE` == "Buy", str_detect(INSTRUMENTO, "^FIXBIS")) %>%
    mutate(
      `F Valor Co.` = mdy(`F Valor Co.`),
      `Fvcto` = mdy(`Fvcto`),
      Fecha = Fecha_Pivote_C  # Add the Fecha column explicitly
    ) %>%
    mutate(
      `F Valor Co.` = if_else(year(`F Valor Co.`) < 2024, `F Valor Co.` + years(100), `F Valor Co.`),
      `Fvcto` = if_else(year(`Fvcto`) < 2024, `Fvcto` + years(100), `Fvcto`)
    ) %>%
    mutate(
      `Días x Vencer` = as.numeric(difftime(Fvcto, Fecha_Pivote_C, units = "days")),
      `Días Trans` = as.numeric(difftime(Fecha_Pivote_C, `F Valor Co.`, units = "days")),
      `Diferencias` = as.numeric(difftime(Fvcto, `F Valor Co.`, units = "days")),
      n = 360 / Diferencias,
      `Tasa Descuento Inicial` = ((`V.Nomial Co.` - `COMPRA TOTAL Co.`) / `V.Nomial Co.`) * n,
      `Interés Acumulado` = `V.Nomial Co.` * (1 - `Tasa Descuento Inicial` * `Días x Vencer` / 360) - `COMPRA TOTAL Co.`,
      Fecha_Pivote = Fecha_Pivote_C
    ) %>%
    rowwise() %>%
    mutate(`V.Nom + int.` = sum(`V.Nomial Co.`, `Interés Calculado`, na.rm = TRUE)) %>%
    ungroup() %>%
    left_join(FIXBIS_POSICIÓN_Ventas, by = "INSTRUMENTO") %>%
    mutate(
      `Precio Venta` = case_when(
        is.na(`Precio Venta`) ~ Fvcto,  # If NA, use Fvcto
        TRUE ~ as.Date(`Precio Venta`)  # Convert if it's a character but not numeric
      )
    ) %>%
    mutate(
      Vencimiento_num = as.numeric(`Fvcto`) + 25569,  # Convert Vencimiento to numeric
      Operación_num = as.numeric(OPERACIÓN)
    ) %>%
    mutate(
      Columna_B = case_when(
        `Fvcto` <= Fecha_Pivote_C ~ NA_real_,  # Step 1
        `F Valor Co.` > Fecha_Pivote_C ~ NA_real_,  # Step 2
        (`Precio Venta` <= Fecha_Pivote_C & `Precio Venta` != 0) ~ NA_real_,  # Step 3
        TRUE ~ Vencimiento_num * 10000 + Operación_num  # Step 4: Use Vencimiento_num instead of Fvcto
      ),
      Columna_A = ifelse(!is.na(Columna_B), rank(Columna_B, ties.method = "min"), NA)
    ) %>%
    filter(!is.na(Columna_A)) %>%
    arrange(Columna_A)
  
  # Perform the left_join with the correct column names
  df <- df %>%
    left_join(
      select(TASAS_FIXBIS_AA, `Días por vencer`, `Tasa Descuento`, Fecha),
      by = c("Días x Vencer" = "Días por vencer", "Fecha_Pivote" = "Fecha")
    ) %>%
    rename(`Tasa Descuento Mercado` = `Tasa Descuento`) %>%
    mutate(
      `Tasa Descuento Mercado` = round(`Tasa Descuento Mercado` / 100, 10),
      `Precio Limpio` = (1 - ((`Tasa Descuento Mercado` * `Días x Vencer`) / 360)) * 100,
      `Precio Limpio` = round(`Precio Limpio`, 10)
    ) %>%
    mutate(`Valor de Mercado` = round((`Precio Limpio` / 100) * `V.Nomial Co.`, 2)) %>%
    rowwise() %>%
    mutate(`Valor Efectivo 1/.` = sum(`Interés Acumulado`, `COMPRA TOTAL Co.`, na.rm = TRUE)) %>%
    ungroup() %>%
    mutate(
      across(c("Tasa Descuento Inicial", "Tasa Descuento Mercado"), french_number),
      across(c("Valor Efectivo 1/.", "Interés Acumulado"), ~ round(.x, 2))
    ) %>%
    select("Columna_A", Emisor = `BROKER NAME`, "Fvcto", `F Valor Co.`, Fecha_Pivote,"Fecha Venta"=`Precio Venta`, 
           "Tasa Descuento Inicial","Valor Pagado" = `COMPRA TOTAL Co.`, "Valor Nominal o Futuro 2/." = "V.Nomial Co.", 
           "Interés Acumulado","Valor Efectivo 1/.", `Tasa Descuento Mercado`, "Días x Vencer", "Días Trans", 
           `Valor de Mercado`)
  
  return(df)
})

map and rename multiple

aa <-setdat %>%
    map(~.x %>% filter(!is.na(CASINO),
                       Lobo !="Oveja"))%>%
    map(~.x %>% rename(MMM= 1,
                       BBB=2))

Iterative between two list even though both lists do not have the same data. frame

grepl: It is used for filtering based on text patterns. The $ in the regex ensures the pattern matches only at the end of the string.

excel_data_list_1 <- excel_data_list[grepl("_1.xlsx$", names(excel_data_list))] %>%
                     map(set_colnames_and_clean)

names(excel_data_list_1) <- sub("_1.xlsx$", "", names(excel_data_list_1))

excel_data_list_2 <- excel_data_list[grepl("_2.xlsx$", names(excel_data_list))] %>%
                     map(set_colnames_and_clean_LP)

names(excel_data_list_2) <- sub("_2.xlsx$", "", names(excel_data_list_2))

# Get all unique names from both lists
all_names <- union(names(excel_data_list_1), names(excel_data_list_2))

# Iterate over all names and bind_rows when both exist, otherwise keep the available one
excel_data_list_a <-  map(all_names, ~ bind_rows(
                      excel_data_list_1[[.x]] %||% tibble(),  # If missing, use empty tibble()
                      excel_data_list_2[[.x]] %||% tibble()
                      
names(excel_data_list_a) <- all_names

variable	2022-01-01	2022-01-02	2022-01-03	2022-01-04	2022-01-05	2022-01-06	2022-01-07	2022-01-08	2022-01-09	2022-01-10
B	100	110	105	200	210	190	180	170	165	175
C	120	130	150	170	250	160	130	120	110	130

variable	2022-01-01	2022-01-02	2022-01-03	2022-01-04	2022-01-05	2022-01-06	2022-01-07	2022-01-08	2022-01-09	2022-01-10
B	100	110	105	200	210	190	180	170	165	175
C	120	130	150	170	250	160	130	120	110	130

Libreria data.table:

Autor: René Díaz Flores

Introducción

Librerias

Base de Datos

Comandos básicos

Operaciones Básicas de Filas

Operaciones Básicas Columnas

Subconjunto de datos: Manipulación de la información - Filas y Columnas

Group

GRP: Conteo

Conteo por elementos de cierto grupo

Todo junto

Seleccionar filas y columnas simultáneamente

Seleccionar por posición de las columnas

Seleccionar nombre de las variables

setDT

setnames: Cambiar nombre columnas

Determinar filas repetidas

Base de Datos

Filas únicas

Filas únicas, con respecto a una columna específica

Fusionar tablas (data.table)

Base de Datos

Aplicando by.x by.y

Reemplazar

Reemplazar NA por 0

Reemplazar el contenido de una variable

Ordenar conjunto de datos

Cálculos varios

Promedio y número de observaciones: Simil a summarize tidyverse

Subconjunto de datos

Crear nuevas variables en función de variables pre-existentes

Creación de variables: Caso II

Base original

Resultado

Subasignar por referencia

Eliminar una columna

Cálculo Compuesto: dcast.data.table

Cálculo Compuesto II: Aplicación conceptos básicos

Cambiar nombre de variables que comparten un patrón

Cálculo Compuesto II: Reemplazar contenido de una variable

Transponer variable:

Reemplazar contenido de una variable: II Opción

SD: Subset Data

SD: Filtrar datos

like Convenience function for calling grep.

SC: Subset Columns

Diferenciar entre filas

Transformar columnas tipo character to factor

Lista

Reshaping

Base de Datos

Wide to Long

Long to Wide

Doble dcast

Combinación librerias tidyverse y data.table

Funciones

lapply

Composición Porcentual por filas

Método Largo

Método Corto: Incluye [%]

Porcentaje por columnas

apply

split

Aplicaciones split:

Caso I

Caso II

Caso III: Guardar un lista en un archivo en Excel

Caso IV: Guardar un lista en un archivo en .csv

Caso V: Pasar archivos en Excel (sheet) al Global Environment

Guardar los archivos como listas empleando purrr::map

Pasamos todas las bases creadas en el punto anterior, como listas

Para pasar de listas a una base de datos compacta

Para pasar las listas a data.frame independientes

Names

map aplicando data.table

bind_rows: dos listas con las mismas columnas

Crear una columna con valores de un vector

Importar archivos en Excel, que contienen el mismo nombre de hojas como listas

variable	2022-01-01	2022-01-02	2022-01-03	2022-01-04	2022-01-05	2022-01-06	2022-01-07	2022-01-08	2022-01-09	2022-01-10
B	100	110	105	200	210	190	180	170	165	175
C	120	130	150	170	250	160	130	120	110	130