Tipo de Hogar y Pobreza Infantil

# Limpiar entorno de trabajo
rm(list=objects())

################################### Paquetes ###################################
library(haven)
library(flextable)
library(paletteer)
library(plotrix)

################################# Directorios ##################################
folder <- "~/Dropbox/Analisis/Uniparentalidad Femenina y Pobreza Infantil"
dirdata <- file.path(folder, "data")

############################# Carga Bases de Datos #############################
setwd(dirdata)
casen2022 <- read_sav("2022/Base de datos Casen 2022 SPSS.sav")
setwd(folder)

# Consideramos solo datos utilizados para disminuír espacio usado en la memoria
casen2022[,c("id_vivienda", "hogar", "expr", "sexo", "edad", "pco1", "tipohogar", "pobreza")] |>
  zap_missing() |>
  as_factor() -> casen2022


# Filtramos sólo datos de la quinta region para disminuír espacio usado en la memoria
#casen2022[casen2022$region==5,] |>
#  zap_missing() |>
#  as_factor() -> casen2022


################################ Recodificación ################################
casen2022$idhogar <- with(casen2022, interaction(id_vivienda, hogar)) |>
  as.numeric()

# Sexo jefatura de hogar
sexojh <- rep(NA, nrow(casen2022))
sexojh[with(casen2022, pco1 == "1. Jefatura de Hogar" & sexo == "1. Hombre")] <- 1
sexojh[with(casen2022, pco1 == "1. Jefatura de Hogar" & sexo == "2. Mujer")] <- 2
sexojh <- tapply(sexojh, casen2022$idhogar, sum, na.rm=TRUE)
sexojh <- sexojh[as.character(casen2022$idhogar)]
names(sexojh) <- NULL
sexojh <- unlist(sexojh)
attr(sexojh, "label") <- "Sexo Jefatura de Hogar"
sexojh <- factor(sexojh, levels=1:2, labels=c("Masculina", "Femenina"))
casen2022$sexojh <- sexojh
rm(sexojh)

# Filtro para dejar sólo a los menores de 6 años:
casen2022 <- casen2022[casen2022$edad <=6,]

############################## Tablas y Gráficos ###############################

attach(casen2022)

mipal <- paletteer_d("ggsci::default_jama", 4)

###                                              ###
### Tabla1: Pobreza infantil según tipo de hogar ###
###                                              ###
tab1 <- xtabs(expr ~ tipohogar+pobreza, data=casen2022, drop.unused.levels = TRUE)

ftab1 <- proc_freq(casen2022, "tipohogar", "pobreza", T,F,F,"expr") |>
  add_footer_lines("Situación de Pobreza en menores de 6 años según tipo de hogar. Fuente: Casen 2022")

ftab1

ptab1 <-  proportions(tab1, 1)*100

barplot(ptab1, beside=TRUE, col=mipal,
        main="Porcentaje situación de pobreza en menores de 6 años\n
        respecto del tipo de hogar",
        sub="Fuente: Elaboración propia en base a datos de Casen 2022")
legend("topleft",legend=rownames(ptab1), fill=mipal)

###                                              ###
### Tabla2: Pobreza infantil según tipo de hogar ###
### En hogares con jefatura de hogar femenina    ###
###                                              ###
tab2 <- xtabs(expr ~ tipohogar+pobreza, data=casen2022[sexojh == "Femenina",], drop.unused.levels = TRUE)

ftab2 <- proc_freq(casen2022[sexojh == "Femenina",], "tipohogar", "pobreza", T,F,F,"expr") |>
  add_footer_lines("Situación de Pobreza en menores de 6 años según tipo de hogar,
                   en hogares con jefatura de hogar femenina. Fuente: Casen 2022")

ftab2

ptab2 <-  proportions(tab2, 1)*100

barplot(ptab2, beside=TRUE, col=mipal,
        main="Porcentaje situación de pobreza en menores de 6 años\n
        respecto del tipo de hogar. Jefatura Hogar=Femenina",
        sub="Fuente: Elaboración propia en base a datos de Casen 2022")
legend("topleft",legend=rownames(ptab1), fill=mipal)

###                                              ###
### Tabla2: Pobreza infantil según tipo de hogar ###
### En hogares con jefatura de hogar masculina   ###
###                                              ###
tab3 <- xtabs(expr ~ tipohogar+pobreza, data=casen2022[edad <=6 & sexojh == "Masculina",], drop.unused.levels = TRUE)

ftab3 <- proc_freq(casen2022[edad <=6 & sexojh == "Masculina",], "tipohogar", "pobreza", T,F,F,"expr") |>
  add_footer_lines("Situación de Pobreza en menores de 6 años según tipo de hogar,
                   en hogares con jefatura de hogar masculina Fuente: Casen 2022")

ftab3

ptab3 <-  proportions(tab3, 1)*100

barplot(ptab3, beside=TRUE, col=mipal,
        main="Porcentaje situación de pobreza en menores de 6 años\n
        respecto del tipo de hogar. Jefatura Hogar=Masculina",
        sub="Fuente: Elaboración propia en base a datos de Casen 2022")
legend("topleft",legend=rownames(ptab1), fill=mipal)


tab4 <- xtabs(expr ~ tipohogar+pobreza+sexojh, data=casen2022, drop.unused.levels = TRUE) |>
  proportions(c(1,3)) |>
  as.data.frame() |>
  subset(pobreza != "No pobreza")
tab4$pobreza <- droplevels(tab4$pobreza)
tab4$Porcentaje <- tab4$Freq*100

op <- par(mar=c(5, 4, 4, 2) + 0.1)
m <- matrix(c(1, 1:4, 4, 5, 5), ncol=2, byrow=TRUE)
layout(m, heights=c(0.1,0.65,0.2,0.05))
layout.show(5)
par(mar=c(0,0,0,0))
plot.new()
text(0.5,0.5,
     "Porcentaje situación de pobreza en menores de 6 años\n
     respecto del tipo de hogar",
     cex=1.5,font=2)
par(mar=c(5, 4, 4, 2) + 0.5)
for(sjh in levels(tab4$sexojh)) {
  barplot(Porcentaje ~ tipohogar+pobreza,
          data=tab4[tab4$sexojh==sjh,],
          ylim=c(0,15),
          main=paste("Jefatura de hogar:",sjh),
          beside=TRUE,
          col=mipal)
  xtabs(Porcentaje~tipohogar+pobreza, data=tab4[tab4$sexojh==sjh,]) |>
    round(1) -> p
  boxed.labels(c(1:4,6:9)+.5, p+.7, paste0(p,"%"), cex=.5)
}
par(mar = c(0, 0, 0, 0))
plot.new()
legend("center",legend=levels(tab4$tipohogar), fill=mipal, inset=0, ncol=2)
par(mar = c(0, 0, 0, 0))
plot.new()
text(0.5,0.5,
     "Fuente: Elaboración propia en base a datos de CASEN 2022",
     cex=1,font=1)
par(op)

detach(casen2022)