Diego Durán Martínez A00835110
#install.packages(c("haven", "dplyr", "kableExtra", "survey")) # Solo si no están instaladas
library(haven) # Para leer archivos SPSS
library(dplyr) # Para manipulación de datos##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union#library(kableExtra) # Para crear tablas visuales
#library(survey) # Para exportar resultados a Excel
ruta <- normalizePath("/Users/diegoduran/Desktop/base")archivos <- list.files(path = ruta, pattern = "\\.sav$", full.names = TRUE)
# Leer todos los archivos y guardarlos en una lista
lista_datos <- lapply(archivos, read_sav)
# Opcional: Asignar nombres a cada dataset en la lista según el nombre del archivo
names(lista_datos) <- tools::file_path_sans_ext(basename(archivos))# Extraer cada elemento de la lista en un objeto individual en el entorno global
list2env(lista_datos, envir = .GlobalEnv)## <environment: R_GlobalEnv>#install.packages("writexl") # Solo la primera vez
#install.packages("kableExtra")
#install.packages("survey")
library(writexl) # Cargar la librería## Warning: package 'writexl' was built under R version 4.4.1library(haven)
library(dplyr)
library(tidyr)
library(kableExtra)##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rowslibrary(survey)## Loading required package: grid## Loading required package: Matrix##
## Attaching package: 'Matrix'## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack## Loading required package: survival##
## Attaching package: 'survey'## The following object is masked from 'package:graphics':
##
## dotchart# Filtrar solo las bases que comienzan con "SEC"
sec_bases <- lista_datos[grep("^SEC", names(lista_datos))]
# Crear una lista para almacenar los conteos por base de datos
conteo_gasto <- lapply(names(sec_bases), function(nombre) {
df <- sec_bases[[nombre]]
# Obtener nombres de columnas y etiquetas
nombres_columnas <- names(df)
etiquetas_columnas <- sapply(df, function(var) attr(var, "label"))
# Contar cuántos nombres de columnas contienen "gasto"
count_nombres <- sum(grepl("gasto", nombres_columnas, ignore.case = TRUE))
# Contar cuántas etiquetas contienen "gasto"
count_etiquetas <- sum(grepl("gasto", etiquetas_columnas, ignore.case = TRUE), na.rm = TRUE)
# Crear un dataframe con los resultados
data.frame(Archivo = nombre, Columnas_Gasto = count_nombres, Etiquetas_Gasto = count_etiquetas)
})
# Unir los resultados en una sola tabla
resultado_conteo <- do.call(rbind, conteo_gasto)
# Mostrar la tabla ordenada de mayor a menor aparición de "gasto"
resultado_conteo <- resultado_conteo[order(-resultado_conteo$Columnas_Gasto, -resultado_conteo$Etiquetas_Gasto), ]
print(resultado_conteo)## Archivo Columnas_Gasto Etiquetas_Gasto
## 2 SEC00 1 10
## 8 SEC04 1 4
## 7 SEC03 0 19
## 10 SEC06 0 16
## 11 SEC07 0 12
## 5 SEC02 0 5
## 12 SEC08A 0 2
## 13 SEC08B 0 1
## 14 SEC08C 0 1
## 15 SEC08D 0 1
## 1 SEC0 0 0
## 3 SEC01 0 0
## 4 SEC01A 0 0
## 6 SEC02A 0 0
## 9 SEC05 0 0*analizar SEC03
procesar_datos <- function(data) {
column_labels <- sapply(data, function(col) attr(col, "label"))
labels_vector <- sapply(column_labels, function(x) {
if (is.null(x)) {
return(NA) # Si no hay etiqueta, asigna NA
} else {
return(x) # Devuelve la etiqueta
}
})
# Crear resumen de las variables con "gasto"
summary_table <- data %>%
summarise(across(everything(), ~ sum(!is.na(.)))) %>%
pivot_longer(cols = everything(), names_to = "Variable", values_to = "Non_Null_Count") %>%
mutate(Description = labels_vector) %>%
filter(grepl("gasto", Description, ignore.case = TRUE)) %>%
select(Variable, Description, Non_Null_Count)
return(summary_table)
}
# Aplicar la función a cada dataset en la lista
resultados <- lapply(lista_datos, procesar_datos)# Convertir todas las columnas 'Description' a tipo character
resultados <- lapply(resultados, function(df) {
df %>% mutate(Description = as.character(Description))
})
# Unir todas las tablas en una sola
tabla_final <- bind_rows(resultados)kable(tabla_final, format = "html") %>%
kable_styling(full_width = FALSE)| Variable | Description | Non_Null_Count |
|---|---|---|
| GASTOHOG | Gastos del Hogar | 21710 |
| GHALI | Gasto del Hogar en Alimentos | 21710 |
| GHASE | Gasto del Hogar en Artículos y Servicios | 21710 |
| GHUL6 | Gasto del Hogar en Ultimos 6 Meses | 21710 |
| GHU12 | Gasto del Hogar en Ultimos 12 Meses | 21710 |
| GMED | Gasto del Hogar en Educación | 21710 |
| GMVI | Gasto del Hogar en Vivienda | 21710 |
| GMEM | Gasto del Hogar en Empleo | 21710 |
| GMSA | Gasto del Hogar en Salud | 21710 |
| GTMH | Gasto del Hogar en Sección 8 | 21710 |
| R2231 | Matricula no gasto | 25155 |
| R223A1 | Matricula no gasto | 25156 |
| R223A2 | Monto Gasto | 16200 |
| R223B1 | No Gasto | 25156 |
| R223B2 | Monto Gasto | 5350 |
| R33101B | Gasto de agua en dólares | 14754 |
| R33102B | Gasto de electricidad en dólares | 19018 |
| R33103B | Gasto de kerosen en dólares | 661 |
| R33104B | Gasto de gas propano en dólares | 10202 |
| R33105B | Gasto de candela en dólares | 786 |
| R33106B | Gasto de leña en dólares | 546 |
| R33107B | Gasto de carga de batería en dólares | 87 |
| R33109B | Gasto de telefono fijo en dólares | 3696 |
| R33110B | Gasto de celular en dólares | 18142 |
| R33111B | Gasto de cable/cable del vecino en dólares | 4805 |
| R33112B | Gasto de internet en dólares | 777 |
| R33113B | Gasto de cibercafe en dólares | 2054 |
| R33114B | Gasto de impuestos municipales en dólares | 2131 |
| R33115B | Gasto de pago de vigilancia en dólares | 406 |
| R33116B | Gasto de recolección de basura en dólares | 482 |
| R33117A | Otros tipo de gasto | 21710 |
| R33117B | Otros Ultimo gasto ? | 403 |
| R33101B1 | Gasto de agua envasada en dólares | 1946 |
| R33101B2 | Gasto de agua envasada en dólares | 1569 |
| R44901 | Si / No Tuvo gasto | 70326 |
| R44902 | Si / No Tuvo gasto | 70327 |
| R44903 | Si / No Tuvo gasto | 70327 |
| R44904 | Si / No Tuvo gasto | 70327 |
| R605 | ¿CUÁNTO FUE EL GASTO EN CONSULTA DE (…)? | 6019 |
| R605A | Gasto del hogar | 937 |
| R606 | ¿CUÁNTO FUE EL GASTO EN ANÁLISIS DE LABORATORIO DE (…)? | 6019 |
| R606A | Gasto del hogar | 577 |
| R607 | ¿CUÁNTO FUE EL GASTO DE (…) EN RAYOS X? | 6019 |
| R607A | Gasto del hogar Rayos X | 55 |
| R608 | ¿CUÁNTO FUE EL GASTO DE (…) EN OTROS EXÁMENES? | 6019 |
| R608A | Gasto del hogar | 28 |
| R612 | ¿CUÁNTO FUE EL GASTO EN HOSPITALIZACIÓN DE (…)? | 281 |
| R612A | Gasto del Hogar | 18 |
| R613 | ¿CUÁNTO FUE EL GASTO EN MEDICAMENTOS DE (…)? | 281 |
| R613A | Gasto del hogar | 9 |
| R614 | Examenes no gasto | 281 |
| R614A | Examenes laboratorio rayos “x” gasto del Hogar | 6 |
| R615 | ¿CUÁNTO FUE EL GASTO DE (…) EN MEDICINAS? | 10367 |
| R615A | Medicinas monto gasto del hogar | 4781 |
| R70506A | Gastos médicos consulta permanente | 4840 |
| R70506B | Gastos médicos consulta permanente | 4747 |
| R70507A | Gastos médicos internaciòn | 4840 |
| R70507B | Gastos médicos internaciòn | 4747 |
| R70508A | Otros gastos médicos permanente (exámenes, medicinas, etc) | 4839 |
| R70508B | Otros gastos médicos permanente (exámenes, medicinas, etc) | 4746 |
| R70509A | Gastos médicos consulta eventual | 4839 |
| R70509B | Gastos médicos consulta eventual | 4747 |
| R70510A | Otros gastos médicos eventuales (exámenes, medicinas, etc) | 4840 |
| R70510B | Otros gastos médicos eventuales (exámenes, medicinas, etc) | 4747 |
| R70511A | Gastos en educación | 4840 |
| R70511B | Gastos en educación | 4747 |
| R804 | Frecuencia ¿Cuántas veces realiza este gasto o lo adquiere a la SEMANA? | 779382 |
| R806 | ¿Cuál fue el gasto total de los alimetos que compró o adquirió? (Especificar el valor en dólares) | 779382 |
| R811B1 | ¿Cuál fue el valor del gasto? | 70144 |
| R811C1 | ¿Cuál fue el valor del gasto? | 28357 |
| R811D1 | ¿Cuál fue el valor del gasto? | 4664 |
# Cargar la librería necesaria
library(haven)
library(dplyr)
library(tidyr)
# Leer la base de datos SEC03 desde lista_datos
data_SEC03 <- lista_datos[["SEC03"]]
# Obtener las etiquetas de las columnas
column_labels_SEC03 <- sapply(data_SEC03, function(col) attr(col, "label"))
# Obtener las etiquetas de las columnas (Value) de la lista column_labels
labels_vector_SEC03 <- sapply(column_labels_SEC03, function(x) {
if (is.null(x)) {
return(NA) # Si no hay etiqueta, asigna NA
} else {
return(x) # Devuelve la etiqueta
}
})
# Convertir a tabla con nombres de columnas, etiquetas y conteo de datos no nulos
summary_table_SEC03 <- data_SEC03 %>%
summarise(across(everything(), ~ sum(!is.na(.)))) %>%
pivot_longer(cols = everything(), names_to = "Variable", values_to = "Non_Null_Count") %>%
mutate(Description = labels_vector_SEC03) %>%
filter(grepl("gasto", Description, ignore.case = TRUE)) %>%
select(Variable, Description, Non_Null_Count)
# Mostrar la tabla final
print(summary_table_SEC03)## # A tibble: 19 × 3
## Variable Description Non_Null_Count
## <chr> <chr> <int>
## 1 R33101B Gasto de agua en dólares 14754
## 2 R33102B Gasto de electricidad en dólares 19018
## 3 R33103B Gasto de kerosen en dólares 661
## 4 R33104B Gasto de gas propano en dólares 10202
## 5 R33105B Gasto de candela en dólares 786
## 6 R33106B Gasto de leña en dólares 546
## 7 R33107B Gasto de carga de batería en dólares 87
## 8 R33109B Gasto de telefono fijo en dólares 3696
## 9 R33110B Gasto de celular en dólares 18142
## 10 R33111B Gasto de cable/cable del vecino en dólares 4805
## 11 R33112B Gasto de internet en dólares 777
## 12 R33113B Gasto de cibercafe en dólares 2054
## 13 R33114B Gasto de impuestos municipales en dólares 2131
## 14 R33115B Gasto de pago de vigilancia en dólares 406
## 15 R33116B Gasto de recolección de basura en dólares 482
## 16 R33117A Otros tipo de gasto 21710
## 17 R33117B Otros Ultimo gasto ? 403
## 18 R33101B1 Gasto de agua envasada en dólares 1946
## 19 R33101B2 Gasto de agua envasada en dólares 1569# Exportar la tabla a un archivo Excel (opcional)
library(writexl)
write_xlsx(summary_table_SEC03, "Resumen_Gasto_SEC03.xlsx")# Cargar librerías necesarias
library(dplyr)
# Leer la base de datos SEC03
data_SEC03 <- lista_datos[["SEC03"]]
# Seleccionar las variables específicas de gasto
variables_gasto <- c("R33101B", "R33102B", "R33103B", "R33104B", "R33105B", "R33106B",
"R33107B", "R33109B", "R33110B", "R33111B", "R33112B", "R33113B",
"R33114B", "R33115B", "R33116B", "R33117A", "R33117B",
"R33101B1", "R33101B2")
# Calcular el gasto total del hogar sumando las variables seleccionadas
data_SEC03 <- data_SEC03 %>%
mutate(
gasto_total = rowSums(select(., all_of(variables_gasto)), na.rm = TRUE) # Sumar las variables específicas de gasto
)
# Ver el resumen de las nuevas variables
summary(data_SEC03$gasto_total)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.50 17.00 29.25 42.91 52.90 1049.00summary(data_SEC03$gasto_per_capita)## Warning: Unknown or uninitialised column: `gasto_per_capita`.## Length Class Mode
## 0 NULL NULLsummary(data_SEC03$sumatoria_gastos_hogar)## Warning: Unknown or uninitialised column: `sumatoria_gastos_hogar`.## Length Class Mode
## 0 NULL NULL# Mostrar las primeras filas para verificar
head(data_SEC03)## # A tibble: 6 × 174
## EDICION LOTE TIPO FOLIO VIV R301 R301B R301C R301OTR R302 R302B
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl+lbl> <dbl> <dbl+> <dbl> <dbl+l> <dbl+>
## 1 2012 1 0 1 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 2 2012 1 0 4 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 3 2012 1 0 2 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 4 2012 1 0 5 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 5 2012 1 0 3 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 6 2012 1 0 6 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## # ℹ 163 more variables: R302OTR <dbl>, R303 <dbl+lbl>, R303B <dbl+lbl>,
## # R303OTR <dbl>, R304 <dbl+lbl>, R304OTR <dbl>, R305 <dbl>, R306 <dbl>,
## # R307 <dbl>, R308 <dbl+lbl>, R308OTR <dbl>, R308B <dbl>, R308C <dbl>,
## # R309 <dbl+lbl>, R310 <dbl>, R310A <dbl>, R311 <dbl+lbl>, R311OTR <dbl>,
## # R311H <dbl>, R311M <dbl>, R312 <dbl+lbl>, R312H <dbl>, R313 <dbl+lbl>,
## # R313OTR <dbl>, R314 <dbl>, R314H <dbl>, R314M <dbl>, R3141 <dbl>,
## # R3142 <dbl>, R315 <dbl+lbl>, R316 <dbl+lbl>, R316OTR <dbl>, …# Asegúrate de tener la librería dplyr cargada
library(dplyr)
# Variables relacionadas con el gasto
variables_gasto <- c("R33101B", "R33102B", "R33103B", "R33104B", "R33105B", "R33106B",
"R33107B", "R33109B", "R33110B", "R33111B", "R33112B", "R33113B",
"R33114B", "R33115B", "R33116B", "R33117A", "R33117B",
"R33101B1", "R33101B2")
# Calcular el porcentaje de aporte de cada rubro de gasto respecto al gasto total del hogar
data_SEC03 <- data_SEC03 %>%
mutate(across(all_of(variables_gasto), ~ . / gasto_total * 100, .names = "porcentaje_{.col}"))
# Verifica que el cálculo se haya realizado correctamente
head(data_SEC03)## # A tibble: 6 × 193
## EDICION LOTE TIPO FOLIO VIV R301 R301B R301C R301OTR R302 R302B
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl+lbl> <dbl> <dbl+> <dbl> <dbl+l> <dbl+>
## 1 2012 1 0 1 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 2 2012 1 0 4 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 3 2012 1 0 2 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 4 2012 1 0 5 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 5 2012 1 0 3 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## 6 2012 1 0 6 0 1 [Casa p… NA 1 [Si] NA 4 [¿Lá… 1 [Si]
## # ℹ 182 more variables: R302OTR <dbl>, R303 <dbl+lbl>, R303B <dbl+lbl>,
## # R303OTR <dbl>, R304 <dbl+lbl>, R304OTR <dbl>, R305 <dbl>, R306 <dbl>,
## # R307 <dbl>, R308 <dbl+lbl>, R308OTR <dbl>, R308B <dbl>, R308C <dbl>,
## # R309 <dbl+lbl>, R310 <dbl>, R310A <dbl>, R311 <dbl+lbl>, R311OTR <dbl>,
## # R311H <dbl>, R311M <dbl>, R312 <dbl+lbl>, R312H <dbl>, R313 <dbl+lbl>,
## # R313OTR <dbl>, R314 <dbl>, R314H <dbl>, R314M <dbl>, R3141 <dbl>,
## # R3142 <dbl>, R315 <dbl+lbl>, R316 <dbl+lbl>, R316OTR <dbl>, …# Crear un nuevo dataframe con los datos organizados por rubro de gasto
rubros_gasto <- data_SEC03 %>%
select(all_of(variables_gasto), gasto_total, FAC03) %>%
pivot_longer(cols = all_of(variables_gasto), names_to = "Rubro", values_to = "Valor_Gasto") %>%
mutate(
Porcentaje_Aporte = Valor_Gasto / gasto_total * 100,
Gasto_Ponderado = Valor_Gasto * FAC03
)
# Verifica cómo quedó la transformación
head(rubros_gasto)## # A tibble: 6 × 6
## gasto_total FAC03 Rubro Valor_Gasto Porcentaje_Aporte Gasto_Ponderado
## <dbl> <dbl> <chr> <dbl+lbl> <dbl> <dbl>
## 1 21.1 75 R33101B 2.29 10.9 172.
## 2 21.1 75 R33102B 5.06 24.0 379.
## 3 21.1 75 R33103B NA NA NA
## 4 21.1 75 R33104B 6.75 32.0 506.
## 5 21.1 75 R33105B NA NA NA
## 6 21.1 75 R33106B NA NA NA# Sumar los gastos ponderados para obtener un total general
total_gasto_ponderado <- sum(rubros_gasto$Gasto_Ponderado, na.rm = TRUE)
# Verifica el total del gasto ponderado
total_gasto_ponderado## [1] 84052493# Calcular el porcentaje que aporta cada rubro respecto al total ponderado
rubros_gasto <- rubros_gasto %>%
mutate(Porcentaje_Ponderado = Gasto_Ponderado / total_gasto_ponderado * 100)
# Verifica cómo quedaron los porcentajes ponderados
head(rubros_gasto)## # A tibble: 6 × 7
## gasto_total FAC03 Rubro Valor_Gasto Porcentaje_Aporte Gasto_Ponderado
## <dbl> <dbl> <chr> <dbl+lbl> <dbl> <dbl>
## 1 21.1 75 R33101B 2.29 10.9 172.
## 2 21.1 75 R33102B 5.06 24.0 379.
## 3 21.1 75 R33103B NA NA NA
## 4 21.1 75 R33104B 6.75 32.0 506.
## 5 21.1 75 R33105B NA NA NA
## 6 21.1 75 R33106B NA NA NA
## # ℹ 1 more variable: Porcentaje_Ponderado <dbl># Añadir las etiquetas correspondientes a cada rubro de gasto
#rubros_gasto <- rubros_gasto %>%
# left_join(data.frame(
# Rubro = variables_gasto,
# Etiqueta = column_labels_2023[match(variables_gasto, names(data_SEC03))],
# stringsAsFactors = FALSE
# ), by = "Rubro")
# Verifica la tabla final con las etiquetas
#head(rubros_gasto)*ya casi acababa:(