Practica 2
Julio Alberto Zamora Trejo
2025-02-28
Carga de datos y preparación inicial
# Localizamos nuestra carpeta con nuestros archivos
setwd("C:/Users/taroj/Documents/Actuaria_Octavo Semestre/COMPUTO CIENTIFICO/Practica 2")
# Cargamos la base de datos
datos <- read.csv("data_prac_2 1.csv", header = TRUE, sep = ",", dec = ",",
na.strings = c("null", "**"), stringsAsFactors = FALSE)
# Verificamos los nombres de las columnas
colnames(datos)## [1] "edad" "sexo" "imc" "hijos" "fumador" "region" "clm"
## [8] "X"# Verificamos cuántos datos vacíos tenemos por columna
datos %>% summarise_all(~sum(is.na(.)))## edad sexo imc hijos fumador region clm X
## 1 6 0 8 0 0 0 4 308# Conocemos el tipo de datos que tenemos
str(datos)## 'data.frame': 1338 obs. of 8 variables:
## $ edad : chr "19" "18" "28" "33" ...
## $ sexo : chr "femenino" "masculino" "masculino" "masculino" ...
## $ imc : chr "27.9" "33.77" "33" "22.705" ...
## $ hijos : int 0 1 3 0 0 0 1 3 2 0 ...
## $ fumador: chr "yes" "no" "no" "no" ...
## $ region : chr "suroeste" "sureste" "sureste" "noroeste" ...
## $ clm : chr "16884.924" "1725.5523" "4449.462" "21984.47061" ...
## $ X : int NA NA NA NA NA NA NA NA NA NA ...1. Revisión de datos nulos, vacíos o caracteres especiales
# Convertir columnas numéricas correctamente
datos$edad <- as.numeric(datos$edad)## Warning: NAs introducidos por coercióndatos$imc <- as.numeric(datos$imc)## Warning: NAs introducidos por coercióndatos$clm <- as.numeric(datos$clm)## Warning: NAs introducidos por coerción# Cambiamos las variables categóricas a factores
datos$sexo <- as.factor(datos$sexo)
datos$fumador <- as.factor(datos$fumador)
datos$region <- as.factor(datos$region)
# Eliminamos la columna "X" que no es necesaria
datos <- datos %>% select(-X)
# Verificamos los datos después de la conversión
str(datos)## 'data.frame': 1338 obs. of 7 variables:
## $ edad : num 19 18 28 33 NA 31 46 37 37 60 ...
## $ sexo : Factor w/ 2 levels "femenino","masculino": 1 2 2 2 2 1 1 1 2 1 ...
## $ imc : num 27.9 33.8 33 22.7 28.9 ...
## $ hijos : int 0 1 3 0 0 0 1 3 2 0 ...
## $ fumador: Factor w/ 2 levels "no","yes": 2 1 1 1 1 1 1 1 1 1 ...
## $ region : Factor w/ 4 levels "noreste","noroeste",..: 4 3 3 2 2 3 3 2 1 2 ...
## $ clm : num 16885 1726 4449 21984 3867 ...# Contar los NA después de la conversión
datos %>% summarise_all(~sum(is.na(.)))## edad sexo imc hijos fumador region clm
## 1 72 0 39 0 0 0 41(a) Reemplazo de valores no numéricos con NA
# Ya corregimos el tipo de dato de "edad", "imc" y "clm", pero convertimos los datos que no sean numéricos en NA
datos$edad <- as.numeric(as.character(datos$edad))
datos$imc <- as.numeric(as.character(datos$imc))
datos$clm <- as.numeric(as.character(datos$clm))(b) Verificación del formato adecuado de las variables
# Hemos convertido correctamente:
# Numéricas: edad, imc, clm, hijos
# Categóricas: sexo, fumador, region
# Verificamos:
str(datos)## 'data.frame': 1338 obs. of 7 variables:
## $ edad : num 19 18 28 33 NA 31 46 37 37 60 ...
## $ sexo : Factor w/ 2 levels "femenino","masculino": 1 2 2 2 2 1 1 1 2 1 ...
## $ imc : num 27.9 33.8 33 22.7 28.9 ...
## $ hijos : int 0 1 3 0 0 0 1 3 2 0 ...
## $ fumador: Factor w/ 2 levels "no","yes": 2 1 1 1 1 1 1 1 1 1 ...
## $ region : Factor w/ 4 levels "noreste","noroeste",..: 4 3 3 2 2 3 3 2 1 2 ...
## $ clm : num 16885 1726 4449 21984 3867 ...summary(datos)## edad sexo imc hijos fumador
## Min. :18.00 femenino :662 Min. :15.96 Min. :0.000 no :1064
## 1st Qu.:27.00 masculino:676 1st Qu.:26.22 1st Qu.:0.000 yes: 274
## Median :39.00 Median :30.30 Median :1.000
## Mean :39.23 Mean :30.62 Mean :1.095
## 3rd Qu.:51.00 3rd Qu.:34.59 3rd Qu.:2.000
## Max. :64.00 Max. :53.13 Max. :5.000
## NA's :72 NA's :39
## region clm
## noreste :324 Min. : 1122
## noroeste:325 1st Qu.: 4747
## sureste :364 Median : 9378
## suroeste:325 Mean :13278
## 3rd Qu.:16776
## Max. :63770
## NA's :41# Visualización rápida de los NA
vis_miss(datos)
(c) Detección de valores duplicados
# Detectamos los valores duplicados
duplicados <- datos %>% duplicated()
sum(duplicados) # Nos indica que tenemos 1 fila duplicada## [1] 1datos <- datos %>% distinct()(d) Reemplazo de valores no disponibles
# Seleccionamos solo las columnas numéricas
datos_num <- select(datos, edad, imc, clm)
# Aplicamos diferentes técnicas para imputar los NA
# Reemplazo con la Media
datos_mean <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), mean(x, na.rm = TRUE), x)))
# Reemplazo con la Mediana
datos_median <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), median(x, na.rm = TRUE), x)))
# Reemplazo con la Moda (para valores categóricos)
datos_mode <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), mfv(x, na_rm = TRUE), x)))
# Reemplazo con Media Recortada (trimmed mean)
datos_trimmed_mean <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), mean(x, na.rm = TRUE, trim = 0.1), x)))
# Interpolación (Relleno de valores)
datos_interpol <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), na.approx(x, na.rm = FALSE), x)))
# Imputación con Regresión Lineal
imputed_data <- mice(datos, method = "norm.predict", m = 1)##
## iter imp variable
## 1 1 edad imc clm
## 2 1 edad imc clm
## 3 1 edad imc clm
## 4 1 edad imc clm
## 5 1 edad imc clmdatos_lm <- complete(imputed_data)
# Resumen Estadístico de las Variables Numéricas
# Para el método de la media
summary(datos_mean)## edad imc clm
## Min. :18.00 Min. :15.96 Min. : 1122
## 1st Qu.:27.00 1st Qu.:26.40 1st Qu.: 4878
## Median :39.24 Median :30.59 Median : 9705
## Mean :39.24 Mean :30.62 Mean :13287
## 3rd Qu.:51.00 3rd Qu.:34.40 3rd Qu.:16115
## Max. :64.00 Max. :53.13 Max. :63770# Para la mediana
summary(datos_median)## edad imc clm
## Min. :18.00 Min. :15.96 Min. : 1122
## 1st Qu.:27.00 1st Qu.:26.40 1st Qu.: 4878
## Median :39.00 Median :30.30 Median : 9382
## Mean :39.23 Mean :30.61 Mean :13167
## 3rd Qu.:51.00 3rd Qu.:34.40 3rd Qu.:16115
## Max. :64.00 Max. :53.13 Max. :63770# Para la moda
summary(datos_mode)## edad imc clm
## Min. :18.00 Min. :15.96 Min. : 1122
## 1st Qu.:25.00 1st Qu.:26.40 1st Qu.: 4762
## Median :38.00 Median :30.59 Median : 9305
## Mean :38.13 Mean :30.66 Mean :13254
## 3rd Qu.:51.00 3rd Qu.:34.40 3rd Qu.:16587
## Max. :64.00 Max. :53.13 Max. :63770# Para la media recortada
summary(datos_trimmed_mean)## edad imc clm
## Min. :18.00 Min. :15.96 Min. : 1122
## 1st Qu.:27.00 1st Qu.:26.40 1st Qu.: 4878
## Median :39.05 Median :30.45 Median : 9705
## Mean :39.23 Mean :30.61 Mean :13219
## 3rd Qu.:51.00 3rd Qu.:34.40 3rd Qu.:16115
## Max. :64.00 Max. :53.13 Max. :63770# Para la interpolación
summary(datos_interpol)## edad imc clm
## Min. :18.00 Min. :15.96 Min. : 1122
## 1st Qu.:27.00 1st Qu.:26.22 1st Qu.: 4796
## Median :39.00 Median :30.40 Median : 9411
## Mean :39.29 Mean :30.62 Mean :13274
## 3rd Qu.:51.00 3rd Qu.:34.58 3rd Qu.:16819
## Max. :64.00 Max. :53.13 Max. :63770# Para regresión
summary(datos_lm)## edad sexo imc hijos fumador
## Min. :18.00 femenino :662 Min. :15.96 Min. :0.000 no :1063
## 1st Qu.:27.00 masculino:675 1st Qu.:26.40 1st Qu.:0.000 yes: 274
## Median :39.00 Median :30.30 Median :1.000
## Mean :39.22 Mean :30.60 Mean :1.096
## 3rd Qu.:51.00 3rd Qu.:34.40 3rd Qu.:2.000
## Max. :64.00 Max. :53.13 Max. :5.000
## region clm
## noreste :324 Min. : -502.8
## noroeste:324 1st Qu.: 4762.3
## sureste :364 Median : 9411.0
## suroeste:325 Mean :13290.7
## 3rd Qu.:16727.2
## Max. :63770.4Qué técnica sugeriría usar
La elección depende de la naturaleza de los datos: - Si hay valores atípicos, mediana o media recortada. - Si los datos son continuos y tienen una tendencia, interpolación. - Si queremos mayor precisión, regresión lineal. - Si los datos son categóricos, moda. - Si los NA son pocos, la mediana es una opción segura. - Si los datos tienen una relación fuerte entre variables, la regresión lineal puede ser la mejor opción.
2. Análisis con base de datos imputada mediante interpolación
# Agregar las variables categóricas desde la base original
datos_interpol <- datos_interpol %>% mutate(
sexo = datos$sexo,
fumador = datos$fumador,
region = datos$region,
hijos = datos$hijos
)
# Verificamos que las columnas se hayan agregado correctamente
colnames(datos_interpol)## [1] "edad" "imc" "clm" "sexo" "fumador" "region" "hijos"(a) Histograma para variables numéricas
ggplot(datos_interpol, aes(x = imc)) +
geom_histogram(binwidth = 2, fill = "blue", color = "black", alpha = 0.7) +
labs(title = "Distribución del IMC", x = "IMC", y = "Frecuencia") +
theme_minimal()
¿Es significativo para un análisis univariante? El histograma es útil para analizar la distribución de una variable individual, pero si queremos ver relaciones entre variables, gráficos como boxplots o densidades podrían ser más útiles.
(b) Media de monto de reclamación por sexo
media_sexo <- aggregate(clm ~ sexo, data = datos_interpol, FUN = mean)
print(media_sexo)## sexo clm
## 1 femenino 12517.00
## 2 masculino 14016.57(c) Media de monto de reclamación por fumador y sexo
media_fumador_sexo <- aggregate(clm ~ fumador + sexo, data = datos_interpol, FUN = mean)
print(media_fumador_sexo)## fumador sexo clm
## 1 no femenino 8934.788
## 2 yes femenino 29555.859
## 3 no masculino 8205.914
## 4 yes masculino 32873.799(d) Región con mayor monto promedio de reclamación
region_max <- aggregate(clm ~ region, data = datos_interpol, FUN = mean)
region_max[which.max(region_max$clm), ]## region clm
## 3 sureste 14588.32(e) Creación de columna “obesidad”
datos_interpol$obesidad <- ifelse(datos_interpol$imc > 30, "Sí", "No")(f) Top 10 de personas obesas
top_obesos <- datos_interpol %>%
filter(obesidad == "Sí") %>%
select(edad, sexo, hijos, clm, region) %>%
arrange(desc(clm)) %>%
head(10)
print(top_obesos)## edad sexo hijos clm region
## 1 54 femenino 0 63770.43 sureste
## 2 45 masculino 0 62592.87 sureste
## 3 52 masculino 3 60021.40 noroeste
## 4 31 femenino 1 58571.07 noreste
## 5 33 femenino 0 55135.40 noroeste
## 6 60 masculino 0 52590.83 suroeste
## 7 28 masculino 1 51194.56 suroeste
## 8 64 masculino 2 49577.66 sureste
## 9 59 masculino 1 48970.25 sureste
## 10 44 femenino 0 48885.14 sureste