library(data.table)
# Funciones----
separadores <- function(x){
format(round(as.numeric(x), 2), nsmall=2, big.mark=".", decimal.mark = ",")
}
miles <- function(x){
x0 <- as.character(x)
x1 <- nchar(x)
x2 <- ifelse(x1 == 6, paste0(substr(x0, 1, 3),".",  substr(x0, 4, 6)),
ifelse(x1 == 5, paste0(substr(x0, 1, 2),".",  substr(x0, 3, 5)),
ifelse(x1 == 4, paste0(substr(x0, 1, 1),".",  substr(x0, 2, 4)),
ifelse(x1 <= 3,  x0, "\\textcolor{red}{[revisar función miles]}"))))
}
millones <- function(x){
x0 <- as.character(x)
x1 <- nchar(x)
x2 <- ifelse(x1 == 7, paste0(substr(x0, 1, 1), "'", substr(x0, 2, 4), ".",  substr(x0, 5, 7)),
ifelse(x1 == 8, paste0(substr(x0, 1, 2), "'", substr(x0, 3, 5), ".",  substr(x0, 6, 8)),
ifelse(x1 == 9, paste0(substr(x0, 1, 3), "'", substr(x0, 4, 6), ".",  substr(x0, 7, 9)),
miles(x0))))
}
# Colores----
color_texto <- "#293A40"
color_gr1 <- "#A2E8FF"
color_gr2 <- "#FFC6A2"
color_gr3 <- "#609EB2"
color_gr4 <- "#B2754E"
color_gr5 <- "#40E0D0"
color_gr6 <- "#FFAEC9"
#cambio de número a letras
num2letra=function(x){
if(x==0){y="cero"}
else if(x==1){y="uno"}
else if(x==2){y="dos"}
else if(x==3){y="tres"}
else if(x==4){y="cuatro"}
else if(x==5){y="cinco"}
else if(x==6){y="seis"}
else if(x==7){y="siete"}
else if(x==8){y="ocho"}
else if(x==9){y="nueve"}
else if(x==10){y="diez"}
else if(x==11){y="once"}
else if(x==12){y="doce"}
return(y)
}
#conteo número de registros
conteo<-function(x){
cols<-c("ano","mes")
bdd<-fread(x,select = all_of(cols))
bdd<-bdd %>%
group_by(ano,mes) %>%
summarise(n_reg=nrow(.))
return(bdd)
}
# Define el código para el color
size <- 2.25 # tamaño de las etiquetas de los gráficos
# Define tema para los gráficos en ggplot2----
theme_reess <- theme_minimal() + theme(
panel.background = element_rect(fill = "grey97", colour = "grey50"),
legend.position="bottom",
legend.title = element_blank(),
text = element_text(family="monse", color=color_texto),
axis.text.x = element_text(angle=90, size = 6.5),
axis.text.y = element_text(size = 6.5),
axis.ticks = element_blank(),
axis.line.y = element_blank(),
axis.line.x = element_blank(),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
panel.grid.major.y = element_line(
# Set the color to grey60
color = "grey60",
# Set the size to 0.25
size = 0.25,
# Set the linetype to dotted
linetype = "dotted"
),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()
)
theme_set(theme_reess)
ruta_nreg_comp<-"base registros\\n_reg_2009_2020.csv" #ruta archivo con registros bdd definitivas
ruta_bdd_reess<-"D:\\Procesamiento\\Bases_REESS"      #ruta bases semidefinitivas y provisionales
#Actualización bases definitivas (1:Si 0:No) y año actualizado
act_nreg_comp<-0 ; anio_act_bdd_def<-2021
# n_bdd<-168+6
# n_bdd_def<-144
####### ~~~~~~~~~~~~~~~~~~~~~~~~ sentencias ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#####
fuente <- "Fuente: Instituto Nacional de Estadística y Censos"
fecha_corte <- "junio 2023"
per_bdd_def<-"enero 2009 a diciembre 2020"      #Periodo bases definitivas
per_bdd_sem<-"enero 2021 a agosto 2022"         #Periodo bases semidefinitivas
per_bdd_prov<-"septiembre 2022 a junio 2023"    #Periodo bases provisionales
f_ult_bdd<-"BDD\\_REESS\\_2023\\_6"             #Formato nombre de última base disponible
if(act_nreg_comp==1){
actu<-paste0("BDD_REESS_",anio_act_bdd_def)
nm_bdd_act<-paste0("base registros\\n_reg_2009_",anio_act_bdd_def,".csv")
arc_act<-list.files(ruta_bdd_reess,pattern = actu ,full.names = T)
bdd_act<-lapply(arc_act,conteo)
bdd_act<-do.call(rbind,bdd_act)
bdd_nreg_comp1<-fread(ruta_nreg_comp)
bdd_nreg_comp<-rbind(bdd_nreg_comp,bdd_act)
fwrite(bdd_nreg_comp,nm_bdd_act)
rm(bdd_act,bdd_nreg_comp1)
}
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
#Sentencia número de variables
bdd_col<-fread(tail(arc,1))
ncol_bdd<-ncol(bdd_col)
rm(bdd_col)
#conteo número de registros bdd semidefinitivas y provisionales
bdd_nreg<-lapply(arc,conteo)
bdd_nreg<-do.call(rbind,bdd_nreg)
#carga archivo bdd definitivas anterior
if(act_nreg_comp==0){
bdd_nreg_comp<-fread(ruta_nreg_comp)
}
#número de bases definitivas
n_bdd_def<-nrow(bdd_nreg_comp)
#base_registros final
bdd_nreg<-rbind(bdd_nreg_comp,bdd_nreg)
rm(bdd_nreg_comp)
#número total de bases
n_bdd<-nrow(bdd_nreg)
#número de bases semidefinitivas
n_bdd_sem<-n_bdd-n_bdd_def-10
#número de registro primera y última base
nreg_ult_bdd<-millones(bdd_nreg[nrow(bdd_nreg),"n_reg"])
nreg_prim_bdd<-millones(bdd_nreg[1,"n_reg"])
#transoformación base wide
bdd_nreg<-bdd_nreg %>%
mutate(n_reg=millones(n_reg),
mes=case_when(mes==1 ~ "Ene",
mes==2 ~ "Feb",
mes==3 ~ "Mar",
mes==4 ~ "Abr",
mes==5 ~ "May",
mes==6 ~ "Jun",
mes==7 ~ "Jul",
mes==8 ~ "Ago",
mes==9 ~ "Sep",
mes==10 ~ "Oct",
mes==11 ~ "Nov",
mes==12 ~ "Dic")) %>%
spread(.,key = mes,value = n_reg) %>%
rename("Año"=ano) %>%
select(`Año`, Ene, Feb,Mar,Abr,May,Jun,Jul,Ago,Sep,Oct,Nov,Dic)
View(bdd_nreg)
ruta_nreg_comp<-"base registros\\n_reg_2009_2020.csv" #ruta archivo con registros bdd definitivas
ruta_bdd_reess<-"D:\\Procesamiento\\Bases_REESS"      #ruta bases semidefinitivas y provisionales
#Actualización bases definitivas (1:Si 0:No) y año por actualizar
# Se cambia solo en caso de haber existido una actualización en las bases definitivas
act_nreg_comp<-1 ; anio_act_bdd_def<-2021
####### ~~~~~~~~~~~~~~~~~~~~~~~~ sentencias ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#####
fuente <- "Fuente: Instituto Nacional de Estadística y Censos"
fecha_corte <- "junio 2023"
per_bdd_def<-"enero 2009 a diciembre 2020"      #Periodo bases definitivas
per_bdd_sem<-"enero 2021 a agosto 2022"         #Periodo bases semidefinitivas
per_bdd_prov<-"septiembre 2022 a junio 2023"    #Periodo bases provisionales
f_ult_bdd<-"BDD\\_REESS\\_2023\\_6"             #Formato nombre de última base disponible
if(act_nreg_comp==1){
actu<-paste0("BDD_REESS_",anio_act_bdd_def)
nm_bdd_act<-paste0("base registros\\n_reg_2009_",anio_act_bdd_def,".csv")
arc_act<-list.files(ruta_bdd_reess,pattern = actu ,full.names = T)
bdd_act<-lapply(arc_act,conteo)
bdd_act<-do.call(rbind,bdd_act)
bdd_nreg_comp1<-fread(ruta_nreg_comp)
bdd_nreg_comp<-rbind(bdd_nreg_comp,bdd_act)
fwrite(bdd_nreg_comp,nm_bdd_act)
rm(bdd_act,bdd_nreg_comp1)
}
if(act_nreg_comp==1){
actu<-paste0("BDD_REESS_",anio_act_bdd_def)
nm_bdd_act<-paste0("base registros\\n_reg_2009_",anio_act_bdd_def,".csv")
arc_act<-list.files(ruta_bdd_reess,pattern = actu ,full.names = T)
bdd_act<-lapply(arc_act,conteo)
bdd_act<-do.call(rbind,bdd_act)
bdd_nreg_comp1<-fread(ruta_nreg_comp)
bdd_nreg_comp<-rbind(bdd_nreg_comp1,bdd_act)
fwrite(bdd_nreg_comp,nm_bdd_act)
rm(bdd_act,bdd_nreg_comp1)
}
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
#Sentencia número de variables
bdd_col<-fread(tail(arc,1))
ncol_bdd<-ncol(bdd_col)
rm(bdd_col)
#conteo número de registros bdd semidefinitivas y provisionales
bdd_nreg<-lapply(arc,conteo)
bdd_nreg<-do.call(rbind,bdd_nreg)
#carga archivo bdd definitivas anterior
if(act_nreg_comp==0){
bdd_nreg_comp<-fread(ruta_nreg_comp)
}
#número de bases definitivas
n_bdd_def<-nrow(bdd_nreg_comp)
#base_registros final
bdd_nreg<-rbind(bdd_nreg_comp,bdd_nreg)
rm(bdd_nreg_comp)
#número total de bases
n_bdd<-nrow(bdd_nreg)
#número de bases semidefinitivas
n_bdd_sem<-n_bdd-n_bdd_def-10
#número de registro primera y última base
nreg_ult_bdd<-millones(bdd_nreg[nrow(bdd_nreg),"n_reg"])
nreg_prim_bdd<-millones(bdd_nreg[1,"n_reg"])
#transoformación base wide
bdd_nreg<-bdd_nreg %>%
mutate(n_reg=millones(n_reg),
mes=case_when(mes==1 ~ "Ene",
mes==2 ~ "Feb",
mes==3 ~ "Mar",
mes==4 ~ "Abr",
mes==5 ~ "May",
mes==6 ~ "Jun",
mes==7 ~ "Jul",
mes==8 ~ "Ago",
mes==9 ~ "Sep",
mes==10 ~ "Oct",
mes==11 ~ "Nov",
mes==12 ~ "Dic")) %>%
spread(.,key = mes,value = n_reg) %>%
rename("Año"=ano) %>%
select(`Año`, Ene, Feb,Mar,Abr,May,Jun,Jul,Ago,Sep,Oct,Nov,Dic)
View(bdd_nreg)
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
#Sentencia número de variables
bdd_col<-fread(tail(arc,1))
ncol_bdd<-ncol(bdd_col)
rm(bdd_col)
bdd_nreg<-lapply(arc,conteo)
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
if(act_nreg_comp==1){
arc<-arc[!str_detect(arc,as.character(anio_act_bdd_def))]
}
arc
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
if(act_nreg_comp==1){
arc<-arc[!str_detect(arc,as.character(anio_act_bdd_def))]
}
#Sentencia número de variables
bdd_col<-fread(tail(arc,1))
ncol_bdd<-ncol(bdd_col)
rm(bdd_col)
bdd_nreg<-lapply(arc,conteo)
bdd_nreg<-do.call(rbind,bdd_nreg)
#carga archivo bdd definitivas anterior
if(act_nreg_comp==0){
bdd_nreg_comp<-fread(ruta_nreg_comp)
}
#número de bases definitivas
n_bdd_def<-nrow(bdd_nreg_comp)
#base_registros final
bdd_nreg<-rbind(bdd_nreg_comp,bdd_nreg)
if(act_nreg_comp==1){
actu<-paste0("BDD_REESS_",anio_act_bdd_def)
nm_bdd_act<-paste0("base registros\\n_reg_2009_",anio_act_bdd_def,".csv")
arc_act<-list.files(ruta_bdd_reess,pattern = actu ,full.names = T)
bdd_act<-lapply(arc_act,conteo)
bdd_act<-do.call(rbind,bdd_act)
bdd_nreg_comp1<-fread(ruta_nreg_comp)
bdd_nreg_comp<-rbind(bdd_nreg_comp1,bdd_act)
fwrite(bdd_nreg_comp,nm_bdd_act)
rm(bdd_act,bdd_nreg_comp1)
}
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
if(act_nreg_comp==1){
arc<-arc[!str_detect(arc,as.character(anio_act_bdd_def))]
}
#Sentencia número de variables
bdd_col<-fread(tail(arc,1))
ncol_bdd<-ncol(bdd_col)
rm(bdd_col)
#conteo número de registros bdd semidefinitivas y provisionales
bdd_nreg<-lapply(arc,conteo)
bdd_nreg<-do.call(rbind,bdd_nreg)
#carga archivo bdd definitivas anterior
if(act_nreg_comp==0){
bdd_nreg_comp<-fread(ruta_nreg_comp)
}
#número de bases definitivas
n_bdd_def<-nrow(bdd_nreg_comp)
#base_registros final
bdd_nreg<-rbind(bdd_nreg_comp,bdd_nreg)
rm(bdd_nreg_comp)
#número total de bases
n_bdd<-nrow(bdd_nreg)
#número de bases semidefinitivas
n_bdd_sem<-n_bdd-n_bdd_def-10
#número de registro primera y última base
nreg_ult_bdd<-millones(bdd_nreg[nrow(bdd_nreg),"n_reg"])
nreg_prim_bdd<-millones(bdd_nreg[1,"n_reg"])
#transoformación base wide
bdd_nreg<-bdd_nreg %>%
mutate(n_reg=millones(n_reg),
mes=case_when(mes==1 ~ "Ene",
mes==2 ~ "Feb",
mes==3 ~ "Mar",
mes==4 ~ "Abr",
mes==5 ~ "May",
mes==6 ~ "Jun",
mes==7 ~ "Jul",
mes==8 ~ "Ago",
mes==9 ~ "Sep",
mes==10 ~ "Oct",
mes==11 ~ "Nov",
mes==12 ~ "Dic")) %>%
spread(.,key = mes,value = n_reg) %>%
rename("Año"=ano) %>%
select(`Año`, Ene, Feb,Mar,Abr,May,Jun,Jul,Ago,Sep,Oct,Nov,Dic)
View(bdd_nreg)
# Chunk 1: librerias
# Profilaxis
rm(list = ls())
# Librerías----
library(knitr)
library(openxlsx)
library(tidyverse)
library(ggpubr)
library(reshape2)
library(showtext)
font_add_google("Montserrat", "monse")
showtext_auto()
library(hrbrthemes)
library(xtable)
options(xtable.floating = FALSE)
options(xtable.timestamp = "")
library(lubridate)
library(scales)
library(ggrepel)
library(tibble)
library(fmsb)
library(data.table)
# Funciones----
separadores <- function(x){
format(round(as.numeric(x), 2), nsmall=2, big.mark=".", decimal.mark = ",")
}
miles <- function(x){
x0 <- as.character(x)
x1 <- nchar(x)
x2 <- ifelse(x1 == 6, paste0(substr(x0, 1, 3),".",  substr(x0, 4, 6)),
ifelse(x1 == 5, paste0(substr(x0, 1, 2),".",  substr(x0, 3, 5)),
ifelse(x1 == 4, paste0(substr(x0, 1, 1),".",  substr(x0, 2, 4)),
ifelse(x1 <= 3,  x0, "\\textcolor{red}{[revisar función miles]}"))))
}
millones <- function(x){
x0 <- as.character(x)
x1 <- nchar(x)
x2 <- ifelse(x1 == 7, paste0(substr(x0, 1, 1), "'", substr(x0, 2, 4), ".",  substr(x0, 5, 7)),
ifelse(x1 == 8, paste0(substr(x0, 1, 2), "'", substr(x0, 3, 5), ".",  substr(x0, 6, 8)),
ifelse(x1 == 9, paste0(substr(x0, 1, 3), "'", substr(x0, 4, 6), ".",  substr(x0, 7, 9)),
miles(x0))))
}
# Colores----
color_texto <- "#293A40"
color_gr1 <- "#A2E8FF"
color_gr2 <- "#FFC6A2"
color_gr3 <- "#609EB2"
color_gr4 <- "#B2754E"
color_gr5 <- "#40E0D0"
color_gr6 <- "#FFAEC9"
#cambio de número a letras
num2letra=function(x){
if(x==0){y="cero"}
else if(x==1){y="uno"}
else if(x==2){y="dos"}
else if(x==3){y="tres"}
else if(x==4){y="cuatro"}
else if(x==5){y="cinco"}
else if(x==6){y="seis"}
else if(x==7){y="siete"}
else if(x==8){y="ocho"}
else if(x==9){y="nueve"}
else if(x==10){y="diez"}
else if(x==11){y="once"}
else if(x==12){y="doce"}
return(y)
}
#conteo número de registros
conteo<-function(x){
cols<-c("ano","mes")
bdd<-fread(x,select = all_of(cols))
bdd<-bdd %>%
group_by(ano,mes) %>%
summarise(n_reg=nrow(.))
return(bdd)
}
# Define el código para el color
size <- 2.25 # tamaño de las etiquetas de los gráficos
# Define tema para los gráficos en ggplot2----
theme_reess <- theme_minimal() + theme(
panel.background = element_rect(fill = "grey97", colour = "grey50"),
legend.position="bottom",
legend.title = element_blank(),
text = element_text(family="monse", color=color_texto),
axis.text.x = element_text(angle=90, size = 6.5),
axis.text.y = element_text(size = 6.5),
axis.ticks = element_blank(),
axis.line.y = element_blank(),
axis.line.x = element_blank(),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
panel.grid.major.y = element_line(
# Set the color to grey60
color = "grey60",
# Set the size to 0.25
size = 0.25,
# Set the linetype to dotted
linetype = "dotted"
),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()
)
theme_set(theme_reess)
# Chunk 2: Direcciones y fuentes
ruta_nreg_comp<-"base registros\\n_reg_2009_2020.csv" #ruta archivo con registros bdd definitivas
ruta_bdd_reess<-"D:\\Procesamiento\\Bases_REESS"      #ruta bases semidefinitivas y provisionales
#Actualización bases definitivas (1:Si 0:No) y año por actualizar
# Se cambia solo en caso de haber existido una actualización en las bases definitivas
act_nreg_comp<-1 ; anio_act_bdd_def<-2021
####### ~~~~~~~~~~~~~~~~~~~~~~~~ sentencias ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#####
fuente <- "Fuente: Instituto Nacional de Estadística y Censos"
fecha_corte <- "junio 2023"
per_bdd_def<-"enero 2009 a diciembre 2020"      #Periodo bases definitivas
per_bdd_sem<-"enero 2021 a agosto 2022"         #Periodo bases semidefinitivas
per_bdd_prov<-"septiembre 2022 a junio 2023"    #Periodo bases provisionales
f_ult_bdd<-"BDD\\_REESS\\_2023\\_6"             #Formato nombre de última base disponible
# Chunk 3: bdd_act
if(act_nreg_comp==1){
actu<-paste0("BDD_REESS_",anio_act_bdd_def)
nm_bdd_act<-paste0("base registros\\n_reg_2009_",anio_act_bdd_def,".csv")
arc_act<-list.files(ruta_bdd_reess,pattern = actu ,full.names = T)
bdd_act<-lapply(arc_act,conteo)
bdd_act<-do.call(rbind,bdd_act)
bdd_nreg_comp1<-fread(ruta_nreg_comp)
bdd_nreg_comp<-rbind(bdd_nreg_comp1,bdd_act)
fwrite(bdd_nreg_comp,nm_bdd_act)
rm(bdd_act,bdd_nreg_comp1)
}
# Chunk 4: bdd_fin
arc<-list.files(ruta_bdd_reess,pattern = "BDD_REESS",full.names = T)
if(act_nreg_comp==1){
arc<-arc[!str_detect(arc,as.character(anio_act_bdd_def))]
}
#Sentencia número de variables
bdd_col<-fread(tail(arc,1))
ncol_bdd<-ncol(bdd_col)
rm(bdd_col)
#conteo número de registros bdd semidefinitivas y provisionales
bdd_nreg<-lapply(arc,conteo)
bdd_nreg<-do.call(rbind,bdd_nreg)
#carga archivo bdd definitivas anterior
if(act_nreg_comp==0){
bdd_nreg_comp<-fread(ruta_nreg_comp)
}
#número de bases definitivas
n_bdd_def<-nrow(bdd_nreg_comp)
#base_registros final
bdd_nreg<-rbind(bdd_nreg_comp,bdd_nreg)
rm(bdd_nreg_comp)
#número total de bases
n_bdd<-nrow(bdd_nreg)
#número de bases semidefinitivas
n_bdd_sem<-n_bdd-n_bdd_def-10
#número de registro primera y última base
nreg_ult_bdd<-millones(bdd_nreg[nrow(bdd_nreg),"n_reg"])
nreg_prim_bdd<-millones(bdd_nreg[1,"n_reg"])
#transoformación base wide
bdd_nreg<-bdd_nreg %>%
mutate(n_reg=millones(n_reg),
mes=case_when(mes==1 ~ "Ene",
mes==2 ~ "Feb",
mes==3 ~ "Mar",
mes==4 ~ "Abr",
mes==5 ~ "May",
mes==6 ~ "Jun",
mes==7 ~ "Jul",
mes==8 ~ "Ago",
mes==9 ~ "Sep",
mes==10 ~ "Oct",
mes==11 ~ "Nov",
mes==12 ~ "Dic")) %>%
spread(.,key = mes,value = n_reg) %>%
rename("Año"=ano) %>%
select(`Año`, Ene, Feb,Mar,Abr,May,Jun,Jul,Ago,Sep,Oct,Nov,Dic)
# Chunk 5: tabla_conteo
# Transformar a tabla latex
bold <- function(x) {paste('{\\textcolor{color_tit_tbl}{\\textbf{',x,'}}}', sep ='')}
latexT_s_e <- xtable(bdd_nreg, row.names = F,
align= c("|m{.5in}|",
"|>{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering}p{0.35in}|",
">{\\centering\\arraybackslash}p{0.35in}|"))
print.xtable(latexT_s_e, booktabs = F, include.rownames=FALSE,
add.to.row = list(pos = list(-1),
command = "\\rowcolor{color_filaTabla}"),
sanitize.colnames.function=bold,
hline.after = c(1:nrow(bdd_nreg))
)
