Gastotransportemunicipal
Claudia Guerrero S
2025-10-07
Lectura, uso de otras variables como el sexo del jefe perspectiva de género
#https://www.inegi.org.mx/programas/enigh/nc/2024/#microdatos
# Cuadro 2.1
# Ingreso corriente promedio trimestral por hogar en deciles de
# hogares y su coeficiente de GINI
# 2024
## Limpia la pantalla de tablas o basura de un ejercicio anterior
rm(list = ls())
## Carga librerÃas
## Abre la tabla concentradohogar
ruta<-"C:/Users/cguer/Documents/Claudia/Midropbox/Investigacion y escritos/karamanis/data/"
infile <- "concentradohogar.CSV"
nomarchi<-paste0(ruta,infile)
Conc<-read.csv(nomarchi,stringsAsFactors = FALSE)
#attach(Conc)
## Selecciona las variables de interés
Conc <- Conc [ c('folioviv', 'foliohog', 'ing_cor', 'factor', 'upm','est_dis','sexo_jefe','ubica_geo','gasto_mon','transporte','publico','foraneo','adqui_vehi','mantenim','refaccion','combus','comunica')]
## Se define la columna de los deciles
Numdec<-c('Total', 'I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX', 'X')
Numdec<-c('I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX', 'X')
ruta<-"C:/Users/cguer/Documents/Claudia/Midropbox/Investigacion y escritos/karamanis/data/"
infile <- "ubicageo.CSV"
nomarchi<-paste0(ruta,infile)
ubicageo<-read.csv(nomarchi,stringsAsFactors = FALSE)
#unique(ubicageo$desc_ent)
Conc<-left_join(Conc, ubicageo, by = "ubica_geo")
#unique(ubicageo$desc_ent)
## Hogares
## Se crea una bandera para numerar los hogares
Conc$Nhog <- 1
#Conc<-filter(Conc,entidad==5)
## Ordena Conc de acuerdo a ing_cor, folioviv, foliohog
Conc<- orderBy (~+ing_cor+folioviv+foliohog, data=Conc)
## Suma todos los factores y guarda el valor en el vector tot_hogares
tot_hogares <- sum(Conc$factor)
## Se divide la suma de factores entre diez para sacar el tamaño del decil
## (se debe de truncar el resultado quitando los decimales)
tam_dec<-trunc(tot_hogares/10)
## Muestra la suma del factor en variable hogar
Conc$tam_dec=tam_dec
BD1 <- Conc
## Creación de deciles de hogares
## Se renombra la tabla concentrado a BD1
## Dentro de la tabla BD1 se crea la variable MAXT y se le asignan los
## valores que tiene el ing_cor.
BD1$MAXT <- BD1$ing_cor
## Se ordena de menor a mayor según la variable MAXT
BD1 <- BD1[with(BD1, order(rank(MAXT))),]
## Se aplica la función cumsum, suma acumulada a la variable factor
BD1$ACUMULA <- cumsum(BD1$factor)
## Entra a un ciclo donde genera los deciles 1 a 10
for(i in 1:9)
{
a1<-BD1[dim(BD1[BD1$ACUMULA<tam_dec*i,])[1]+1,]$factor
BD1<-rbind(BD1[1:(dim(BD1[BD1$ACUMULA<tam_dec*i,])[1]+1),],
BD1[(dim(BD1[BD1$ACUMULA<tam_dec*i,])[1]+1):dim(BD1[1])[1],])
b1<-tam_dec*i-BD1[dim(BD1[BD1$ACUMULA<tam_dec*i,])[1],]$ACUMULA
BD1[(dim(BD1[BD1$ACUMULA<tam_dec*i,])[1]+1),]$factor<-b1
BD1[(dim(BD1[BD1$ACUMULA<tam_dec*i,])[1]+2),]$factor<-(a1-b1)
}
BD1$ACUMULA2<-cumsum(BD1$factor)
BD1$DECIL <- 0
BD1[(BD1$ACUMULA2<=tam_dec),]$DECIL <- 1
for(i in 1:9)
{
BD1[((BD1$ACUMULA2>tam_dec*i)&(BD1$ACUMULA2<=tam_dec*(i+1))),]$DECIL <- (i+1)
}
## Total de hogares
x <- tapply(BD1$factor,BD1$Nhog,sum)
## Deciles
y <- tapply(BD1$factor,as.numeric(BD1$DECIL),sum)
## Se calcula el promedio de ingreso para el total y para cada uno de los deciles
ing_cormed_t <- tapply(BD1$factor*BD1$ing_cor,BD1$Nhog,sum)/x
ing_cormed_d <- tapply(BD1$factor*BD1$ing_cor,as.numeric(BD1$DECIL),sum)/y
bd1col2<-left_join(Conc,BD1,by=c('folioviv','foliohog','ing_cor','factor'))
#BD1[as.numeric(BD1$DECIL) %in% '0',]$DECIL <- 10
## Total de hogares
## Selecciona las variables de transporte
BD1al <- bd1col2[ c('transporte.x','publico.x','foraneo.x','adqui_vehi.x','mantenim.x','refaccion.x','combus.x')]
BD1al$max_col_base <- apply(BD1al, 1, function(x) names(x)[which.max(x)])
merged_BD1_inner <- merge(BD1, BD1al, by = 0)
BD1nvo <- merged_BD1_inner[c('folioviv', 'foliohog', 'ing_cor', 'factor', 'upm', 'est_dis','sexo_jefe','ubica_geo','gasto_mon','transporte','publico','foraneo','adqui_vehi','mantenim','refaccion','combus','comunica','DECIL','max_col_base','entidad','desc_ent','municipio','desc_mun','Nhog')]
Conc <- Conc [ c('folioviv', 'foliohog', 'ing_cor', 'factor', 'upm','est_dis','sexo_jefe','ubica_geo','gasto_mon','transporte','publico','foraneo','adqui_vehi','mantenim','refaccion','combus','comunica')]
colnames(BD1nvo) <- c('folioviv', 'foliohog', 'ing_cor', 'factor', 'upm', 'est_dis','sexo_jefe','ubica_geo','gasto_mon','transporte','publico','foraneo','adqui_vehi','mantenim','refaccion','combus','comunica','DECIL','max_col_base','entidad','desc_ent','municipio','desc_mun','Nhog')
BD1nvo$max_col_base <- gsub("\\.x", "", BD1nvo$max_col_base)
df_dplyr <-BD1nvo %>%
rowwise() %>%
mutate(selected_value = cur_data()[[max_col_base]]) %>%
ungroup()
df_dplyr$edomun<-paste0(df_dplyr$entidad, df_dplyr$municipio)
#unique(df_dplyr$edomun)
## Se carga el diseño muestral
mydesign <- svydesign(id=~upm,strata=~est_dis,data=df_dplyr,weights=~factor)
## transporte
MingcorTot <- svyratio(~ing_cor,denominator=~Nhog,mydesign) # Total
MingcorEnt <- svyby(~ing_cor,denominator=~Nhog,by=~edomun ,mydesign,svyratio) # Nacional
MtransporteTot <- svyratio(~transporte,denominator=~Nhog,mydesign) # Total
MtransporteEnt <- svyby(~transporte,denominator=~Nhog,by=~edomun ,mydesign,svyratio) # Nacional
##publico
MpublicoTot <- svyratio(~publico,denominator=~Nhog,mydesign)
MpublicoEnt <- svyby(~publico,denominator=~Nhog,by=~edomun ,mydesign,svyratio)
##foraneo
MforaneoTot <- svyratio(~foraneo,denominator=~Nhog,mydesign) # Total
MforaneoEnt <- svyby(~foraneo,denominator=~Nhog,by=~edomun ,mydesign,svyratio) # Nacional
##adqui_vehi
Madqui_vehiTot <- svyratio(~adqui_vehi,denominator=~Nhog,mydesign)
Madqui_vehisEnt <- svyby(~adqui_vehi,denominator=~Nhog,by=~edomun ,mydesign,svyratio)
#mantenim
MmantenimTot <- svyratio(~mantenim,denominator=~Nhog,mydesign) # Total
MmantenimEnt <- svyby(~mantenim,denominator=~Nhog,by=~edomun ,mydesign,svyratio) # Nacional
##refaccion
MrefaccionTot <- svyratio(~refaccion,denominator=~Nhog,mydesign)
MrefaccionEnt <- svyby(~refaccion,denominator=~Nhog,by=~edomun ,mydesign,svyratio)
##combus
McombusTot <- svyratio(~combus,denominator=~Nhog,mydesign) # Total
McombusEnt <- svyby(~combus,denominator=~Nhog,by=~edomun ,mydesign,svyratio) # Nacional
c_ent_ES <- data.frame(c(MtransporteTot,MtransporteEnt),
c(MpublicoTot,MpublicoEnt),
c(MforaneoTot,MforaneoEnt),
c(Madqui_vehiTot,Madqui_vehisEnt),
c(MmantenimTot,MmantenimEnt),
c(MrefaccionTot,MrefaccionEnt),
c(McombusTot,McombusEnt),
c(MingcorTot,MingcorEnt))
#Entidades <- c('Aguascalientes', 'Baja California',
#'Baja California Sur', 'Campeche', 'Coahuila de Zaragoza', 'Colima',
#'Chiapas', 'Chihuahua', 'Ciudad de México', 'Durango', 'Guanajuato',
#'Guerrero', 'Hidalgo', 'Jalisco', 'México', 'Michoacán de Ocampo',
#'Morelos', 'Nayarit', 'Nuevo León', 'Oaxaca', 'Puebla', 'Querétaro',
#'Quintana Roo', 'San Luis PotosÃ', 'Sinaloa', 'Sonora', 'Tabasco',
#'Tamaulipas', 'Tlaxcala', 'Veracruz de Ignacio de la Llave', 'Yucatán',
#'Zacatecas')
## Se agregan los nombres de las entidades a las filas
#Entidades<-as.data.frame(Entidades)
#row.names(c_ent_ES) <- Entidades$Entidades
ubicageo$edomun<-paste0(ubicageo$entidad, ubicageo$municipio)
c_ent_ali <- c_ent_ES [c('edomun', 'ing_cor.Nhog','transporte.Nhog','publico.Nhog','foraneo.Nhog','adqui_vehi.Nhog','mantenim.Nhog','refaccion.Nhog','combus.Nhog')]
colnames(c_ent_ali) <- c('edomun', 'ing_cor','transporte','publico','foraneo','adqui_vehi','mantenim','refaccion','combus')
c_ent_ali<-left_join(c_ent_ali, ubicageo, by = "edomun")
c_ent_ali<-c_ent_ali |> filter(entidad ==5)
titul<-"publico"
library(ggsci)
library(MetBrewer)
c_ent_ali$prop<-c_ent_ali$publico/c_ent_ali$transporte
p <- ggplot(data = c_ent_ali,
mapping = aes(y = fct_reorder(desc_mun,prop), x = prop, label=sprintf("%0.4f", prop),
fill = prop))
dodge <- position_dodge(width=0.9)
q<- p + geom_col(position = dodge, alpha = 1) +
#geom_text(nudge_x=-.085,nudge_y = -0.15, color = "grey100", fontface = "bold", size = 4,label = scales::percent(c_ent_ali$prop,accuracy=0.3)) +
#geom_text(nudge_x=-.085,nudge_y = -0.15, color = "grey100", fontface = "bold", size = 4,label = sprintf("%1.2f%%", c_ent_ali$prop*100)) +
geom_text(nudge_x=-.02,nudge_y = -0.15, color = "grey100", fontface = "bold", size = 4,label = sprintf("%1.2f%%", c_ent_ali$prop*100)) +
# geom_errorbar(position = dodge, width = 0.2) +
scale_y_discrete(labels = scales::wrap_format(15)) +
scale_x_continuous(labels = scales::percent) +
#scale_color_met_d("Cross") +
#scale_fill_gradientn(colours = terrain.colors(10))
#scale_color_viridis_c(direction = -1)
#paletteer::scale_fill_paletteer_c("scico::lajolla",na.value = "transparent",direction = -1)+
#scale_fill_met_c("Cross") +
#scale_fill_met_c("Monet") +
scale_fill_bs5("orange")+
#scale_fill_tw3("emerald",reverse=FALSE)+
labs(title = paste0("Consumo de ", titul, " en Coahuila"),
subtitle = 'proporción demás transporte',
caption = "Fuente: ENIGH 2024 Gráfica:Claudia Guerrero",
#fill = paste0("'",{varname},"'"),
#color = paste0("'",{varname},"'"),
x = "Porcentaje", y = "Estados") +
coord_cartesian(expand = FALSE) +
#facet_wrap(~ NOM_ENT, ncol = 2) +
#theme_void() +
theme(legend.position = "bottom",
legend.key.height = unit(2, "lines"),
legend.key.width = unit(5, "lines"),
axis.title=element_text(size=1,face="bold"),
axis.text.y = element_text(size = 8,face="bold"),
plot.background = element_rect(fill = "grey99", color = NA),
plot.title = element_text(size = 18, face = "bold"),
plot.subtitle = element_text(size = 12, margin = margin(0, 0, 10, 0)),
plot.caption = element_text(size = 5, color = "grey30", margin = margin(10, 0, 0, 0)),
plot.margin = margin(0, 0, 0, 0),
panel.background = element_rect(fill = "transparent"),
)
q
map<-"inegi"
pal<-"gsci"
if (!dir.exists(glue("images/{map}"))) {
dir.create(glue("images/{map}"))
}
outfile <- str_to_lower(glue("images/{map}/{map}_{pal}rubtmunotros.png"))
# Now that everything is assigned, save these objects so we
# can use then in our markup script
ggsave(outfile, width = 300, height = 300, units = "mm", dpi = "retina",limitsize = FALSE)codent<-substr(c_ent_ali$entidad,1,2)
codent<-sprintf("%02d%s", as.numeric(gsub("[^0-9]+", "", codent)), gsub("[0-9]+", "", codent))
c_ent_ali$CVE_ENT<-sprintf("%02d%s", as.numeric(gsub("[^0-9]+", "", codent)), gsub("[0-9]+", "", codent))
codmun<-substr(c_ent_ali$municipio,1,3)
codmun<-sprintf("%03d%s", as.numeric(gsub("[^0-9]+", "", codmun)), gsub("[0-9]+", "", codmun))
c_ent_ali$CVE_MUN<-codmun
c_ent_ali$CVEGEO<-paste0(c_ent_ali$CVE_ENT,c_ent_ali$CVE_MUN)
ruta<-"C:/Users/cguer/Documents/Claudia/Midropbox/Investigacion y escritos/karamanis/data/conjunto_de_datos/"
infile <- "05mun.shp"
nomarchi<-paste0(ruta,infile)
datageo<- read_sf(nomarchi,options = "ENCODING=latin1")
transportemapa<- inner_join(c_ent_ali,datageo, by = "CVEGEO")
sf_transportemapa <- st_as_sf(transportemapa)
p<-ggplot()+
geom_sf(data=datageo,color="black",fill="transparent")+
geom_sf(data=sf_transportemapa,aes(fill=prop),show.legend=TRUE)+
#scale_color_met_d("Cross") +
scale_fill_bs5("orange")+
#scale_fill_tw3("emerald",reverse=FALSE)+
theme_void() +
theme(
#legend.position = "none",
#legend.key.height = unit(0.6, "lines"),
#legend.key.width = unit(5, "lines"),
strip.text = element_text(margin = margin(5, 0, 0, 0)),
plot.background = element_rect(fill = "white", color = NA),
plot.title = element_text(face = "bold"),
plot.subtitle = element_text(margin = margin(5, 0, 20, 0)),
plot.caption = element_text(margin = margin(15, 0, 0, 0)),
plot.margin = margin(10, 0, 5, 0)
)+
coord_sf()
p
library(ggpubr)
ggarrange(q,p, common.legend = TRUE)
outfile <- str_to_lower(glue("images/{map}/{map}_{pal}publicotcoah.png"))
# Now that everything is assigned, save these objects so we
# can use then in our markup script
ggsave(outfile, width = 300, height = 300, units = "mm", dpi = "retina",limitsize = FALSE,bg="white")