1. Realice una revisión de los datos nulos, vacíos o si tienen algún otro carácter.

(a) En caso de presentar valores diferentes a tipo numérico (las variables que apliquen), reemplace con NA.

data_prac2 <- read.csv("/Users/emilianorubioramos/Desktop/8vo Semestre/Cómputo Cientifico/data_prac_2.csv", 
                  dec = ".", 
                  na.strings = c("&&", "null", "$"), 
                  stringsAsFactors = TRUE)

# Convertimos las variables a numéricas adecuadamente
data_prac2$edad <- as.numeric(as.character(data_prac2$edad))
data_prac2$imc <- as.numeric(as.character(data_prac2$imc))
data_prac2$hijos <- as.numeric(as.character(data_prac2$hijos))
data_prac2$clm <- as.numeric(as.character(data_prac2$clm))

(b) Verifique que las variables tengan el formato adecuado para trabajar.

str(data_prac2)

## '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  : num  0 1 3 0 0 0 1 3 2 0 ...
##  $ fumador: Factor w/ 2 levels "no","si": 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(data_prac2)

##       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   si: 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

(c) ¿Hay manera de detectar valores duplicados?, en caso negativo, ¿qué podría proponer como identificador, para evitar duplicados en el data set?

# Verificar duplicados
data_prac2 %>%
  janitor::get_dupes()

##   edad      sexo   imc hijos fumador   region      clm dupe_count
## 1   19 masculino 30.59     0      no noroeste 1639.563          2
## 2   19 masculino 30.59     0      no noroeste 1639.563          2

# Quitar duplicados
data_prac2 <- data_prac2 %>%
  distinct()

(d) Reemplace los valores no disponibles con las técnicas usadas, y haga una tabla resumen sobre los resultados (summary) de las variables numéricas, ¿cuál técnica sugiere usar y por qué?

— Hacemos un data frame con las variables numéricas

variables_numericas <- data.frame(
  edad = data_prac2$edad, 
  imc = data_prac2$imc, 
  hijos = data_prac2$hijos, 
  monto_reclamacion = data_prac2$clm
)

— Reemplazamos los NA con diferentes métodos

# Reemplazar con la media
datos_mean <- data.frame(lapply(variables_numericas, function(x) ifelse(is.na(x), mean(x, na.rm = TRUE), x)))

# Reemplazar con la media recortada
datos_mean_rec <- data.frame(lapply(variables_numericas, function(x) ifelse(is.na(x), mean(x, na.rm = TRUE, trim = 0.15), x)))

# Reemplazar con la mediana
datos_median <- data.frame(lapply(variables_numericas, function(x) ifelse(is.na(x), median(x, na.rm = TRUE), x)))

# Reemplazar por interpolación
datos_interp <- data.frame(lapply(variables_numericas, function(x) ifelse(is.na(x), na.approx(x, na.rm = TRUE), x)))

# Reemplazar con la moda
datos_moda <- data.frame(lapply(variables_numericas, function(x) ifelse(is.na(x), mfv(x, na_rm = TRUE), x)))

# Tabla resumen de cada método de imputación
cat("Datos originales con NA:\n")

## Datos originales con NA:

summary(variables_numericas)

##       edad            imc            hijos       monto_reclamacion
##  Min.   :18.00   Min.   :15.96   Min.   :0.000   Min.   : 1122    
##  1st Qu.:27.00   1st Qu.:26.22   1st Qu.:0.000   1st Qu.: 4750    
##  Median :39.00   Median :30.30   Median :1.000   Median : 9382    
##  Mean   :39.24   Mean   :30.62   Mean   :1.096   Mean   :13287    
##  3rd Qu.:51.00   3rd Qu.:34.59   3rd Qu.:2.000   3rd Qu.:16781    
##  Max.   :64.00   Max.   :53.13   Max.   :5.000   Max.   :63770    
##  NA's   :72      NA's   :39                      NA's   :41

cat("\nDatos con media:\n")

## 
## Datos con media:

summary(datos_mean)

##       edad            imc            hijos       monto_reclamacion
##  Min.   :18.00   Min.   :15.96   Min.   :0.000   Min.   : 1122    
##  1st Qu.:27.00   1st Qu.:26.40   1st Qu.:0.000   1st Qu.: 4878    
##  Median :39.24   Median :30.59   Median :1.000   Median : 9705    
##  Mean   :39.24   Mean   :30.62   Mean   :1.096   Mean   :13287    
##  3rd Qu.:51.00   3rd Qu.:34.40   3rd Qu.:2.000   3rd Qu.:16115    
##  Max.   :64.00   Max.   :53.13   Max.   :5.000   Max.   :63770

cat("\nDatos con media recortada:\n")

## 
## Datos con media recortada:

summary(datos_mean_rec)

##       edad            imc            hijos       monto_reclamacion
##  Min.   :18.00   Min.   :15.96   Min.   :0.000   Min.   : 1122    
##  1st Qu.:27.00   1st Qu.:26.40   1st Qu.:0.000   1st Qu.: 4878    
##  Median :39.07   Median :30.43   Median :1.000   Median : 9705    
##  Mean   :39.23   Mean   :30.61   Mean   :1.096   Mean   :13197    
##  3rd Qu.:51.00   3rd Qu.:34.40   3rd Qu.:2.000   3rd Qu.:16115    
##  Max.   :64.00   Max.   :53.13   Max.   :5.000   Max.   :63770

cat("\nDatos con mediana:\n")

## 
## Datos con mediana:

summary(datos_median)

##       edad            imc            hijos       monto_reclamacion
##  Min.   :18.00   Min.   :15.96   Min.   :0.000   Min.   : 1122    
##  1st Qu.:27.00   1st Qu.:26.40   1st Qu.:0.000   1st Qu.: 4878    
##  Median :39.00   Median :30.30   Median :1.000   Median : 9382    
##  Mean   :39.23   Mean   :30.61   Mean   :1.096   Mean   :13167    
##  3rd Qu.:51.00   3rd Qu.:34.40   3rd Qu.:2.000   3rd Qu.:16115    
##  Max.   :64.00   Max.   :53.13   Max.   :5.000   Max.   :63770

cat("\nDatos con interpolación:\n")

## 
## Datos con interpolación:

summary(datos_interp)

##       edad            imc            hijos       monto_reclamacion
##  Min.   :18.00   Min.   :15.96   Min.   :0.000   Min.   : 1122    
##  1st Qu.:27.00   1st Qu.:26.22   1st Qu.:0.000   1st Qu.: 4796    
##  Median :39.00   Median :30.40   Median :1.000   Median : 9411    
##  Mean   :39.29   Mean   :30.62   Mean   :1.096   Mean   :13274    
##  3rd Qu.:51.00   3rd Qu.:34.58   3rd Qu.:2.000   3rd Qu.:16819    
##  Max.   :64.00   Max.   :53.13   Max.   :5.000   Max.   :63770

cat("\nDatos con moda:\n")

## 
## Datos con moda:

summary(datos_moda)

##       edad            imc            hijos       monto_reclamacion
##  Min.   :18.00   Min.   :15.96   Min.   :0.000   Min.   : 1122    
##  1st Qu.:25.00   1st Qu.:26.40   1st Qu.:0.000   1st Qu.: 4762    
##  Median :38.00   Median :30.59   Median :1.000   Median : 9305    
##  Mean   :38.13   Mean   :30.66   Mean   :1.096   Mean   :13254    
##  3rd Qu.:51.00   3rd Qu.:34.40   3rd Qu.:2.000   3rd Qu.:16586    
##  Max.   :64.00   Max.   :53.13   Max.   :5.000   Max.   :63770

Se recomienda utilizar el método de interpolación para reemplazar los valores NA, ya que proporciona una estimación más precisa al considerar la tendencia de los datos.

2. Teniendo la base funcional, emplee el data set con reemplazamiento mediante interpolación, para realizar lo siguiente:

Actualizamos la base para contemplar nuevamente las variables no numéricas

datos_completos <- data.frame(
  sexo = data_prac2$sexo, 
  fumador = data_prac2$fumador, 
  region = data_prac2$region, 
  datos_interp
)


colnames(datos_completos)[colnames(datos_completos) == "monto_reclamacion"] <- "monto_reclamacion"

(a) Usando ggplot, realice un histograma para analizar las variables numéricas, ¿este sería el tipo de gráfico más significativo para su análisis univariante?

datos_long <- pivot_longer(
  datos_completos,
  cols = c(edad, imc, hijos, monto_reclamacion),
  names_to = "variable",
  values_to = "valor"
)


ggplot(datos_long, aes(x = valor, fill = variable)) +
  geom_histogram(color = "white", alpha = 0.7, bins = 30) +
  facet_wrap(~ variable, scales = "free", ncol = 2) +
  scale_fill_viridis_d() +
  labs(
    title = "Distribución de variables numéricas",
    x = "Valor", 
    y = "Frecuencia",
    fill = "Variable"
  ) +
  theme(
    legend.position = "none",
    strip.text = element_text(size = 12, face = "bold"),
    plot.title = element_text(hjust = 0.5, size = 16)
  )

ggplot(datos_long, aes(x = valor, fill = variable)) +
  geom_density(alpha = 0.7) +
  facet_wrap(~ variable, scales = "free", ncol = 2) +
  scale_fill_viridis_d() +
  labs(
    title = "Densidad de variables numéricas",
    x = "Valor", 
    y = "Densidad",
    fill = "Variable"
  ) +
  theme(
    legend.position = "none",
    strip.text = element_text(size = 12, face = "bold"),
    plot.title = element_text(hjust = 0.5, size = 16)
  )

(b) Calcule la media de monto de reclamación por sexo.

reclamacion_por_sexo <- datos_completos %>%
  group_by(sexo) %>%
  summarise(promedio_reclamacion = mean(monto_reclamacion))


ggplot(reclamacion_por_sexo, aes(x = sexo, y = promedio_reclamacion, fill = sexo)) +
  geom_col() +
  geom_text(aes(label = round(promedio_reclamacion, 2)), vjust = -0.5, size = 4) +
  scale_fill_brewer(palette = "Set1") +
  labs(
    title = "Monto promedio de reclamación por sexo",
    x = "Sexo",
    y = "Monto promedio de reclamación"
  ) +
  theme(legend.position = "none")

(c) Calcule la media de monto de reclamación por fumador y sexo.

reclamacion_por_sexo_fumador <- datos_completos %>%
  group_by(sexo, fumador) %>%
  summarise(promedio_reclamacion = mean(monto_reclamacion), .groups = "drop")


ggplot(reclamacion_por_sexo_fumador, aes(x = sexo, y = promedio_reclamacion, fill = fumador)) +
  geom_col(position = "dodge", width = 0.7) +
  geom_text(aes(label = round(promedio_reclamacion, 2)), 
            position = position_dodge(width = 0.7), 
            vjust = -0.5, size = 3.5) +
  scale_fill_brewer(palette = "Set2") +
  labs(
    title = "Monto promedio de reclamación por sexo y condición de fumador",
    x = "Sexo",
    y = "Monto promedio de reclamación",
    fill = "Fumador"
  ) +
  theme(legend.position = "bottom")

(d) Identifique la región con mayor monto promedio de reclamación.

reclamacion_por_region <- datos_completos %>%
  group_by(region) %>%
  summarise(promedio_reclamacion = mean(monto_reclamacion)) %>%
  arrange(desc(promedio_reclamacion))


ggplot(reclamacion_por_region, aes(x = reorder(region, promedio_reclamacion), y = promedio_reclamacion, fill = region)) +
  geom_col() +
  geom_text(aes(label = round(promedio_reclamacion, 2)), hjust = -0.1, size = 3.5) +
  scale_fill_viridis_d() +
  labs(
    title = "Monto promedio de reclamación por región",
    subtitle = "Ordenado de mayor a menor",
    x = "Región",
    y = "Monto promedio de reclamación"
  ) +
  theme(
    legend.position = "none",
    axis.text.x = element_text(angle = 45, hjust = 1)
  ) +
  coord_flip()

(e) Cree una columna con la etiqueta “obesidad”, si el imc es mayor a 30.

datos_completos <- datos_completos %>%
  mutate(estado_nutricional = case_when(
    imc > 40 ~ "Obesidad mórbida",
    imc > 35 ~ "Obesidad clase II",
    imc > 30 ~ "Obesidad clase I",
    imc > 25 ~ "Sobrepeso",
    imc > 18.5 ~ "Peso normal",
    TRUE ~ "Bajo peso"
  ))


ggplot(datos_completos, aes(x = estado_nutricional, fill = estado_nutricional)) +
  geom_bar() +
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5, size = 3.5) +
  scale_fill_brewer(palette = "RdYlBu") +
  labs(
    title = "Distribución por estado nutricional",
    x = "Estado nutricional",
    y = "Cantidad de personas"
  ) +
  theme(
    legend.position = "none",
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

(f) Identifique el top 10 de personas obesas indicando: edad, sexo, hijos, monto de reclamación y región.

top_obesos <- datos_completos %>%
  filter(grepl("Obesidad", estado_nutricional)) %>%
  select(imc, estado_nutricional, edad, sexo, hijos, monto_reclamacion, region) %>%
  arrange(desc(imc)) %>%
  head(10)


knitr::kable(top_obesos, 
             caption = "Top 10 personas con mayor IMC",
             col.names = c("IMC", "Estado Nutricional", "Edad", "Sexo", "Hijos", "Monto Reclamación", "Región"))

Top 10 personas con mayor IMC
IMC	Estado Nutricional	Edad	Sexo	Hijos	Monto Reclamación	Región
53.13	Obesidad mórbida	18	masculino	0	1163.463	sureste
52.58	Obesidad mórbida	22	masculino	1	44501.398	sureste
50.38	Obesidad mórbida	23	masculino	1	2438.055	sureste
49.06	Obesidad mórbida	58	masculino	0	11381.325	sureste
47.74	Obesidad mórbida	52	masculino	1	9748.911	sureste
47.60	Obesidad mórbida	37	femenino	2	46113.511	suroeste
47.52	Obesidad mórbida	47	masculino	1	8083.920	sureste
47.41	Obesidad mórbida	54	femenino	0	63770.428	sureste
46.75	Obesidad mórbida	52	femenino	5	12592.534	sureste
46.70	Obesidad mórbida	54	femenino	2	11538.421	suroeste

ggplot(top_obesos, aes(x = reorder(paste("Persona", row.names(top_obesos)), imc), y = imc, fill = sexo)) +
  geom_col() +
  geom_text(aes(label = round(imc, 1)), hjust = -0.1, size = 3.5) +
  scale_fill_brewer(palette = "Set1") +
  labs(
    title = "Top 10 personas con mayor IMC",
    x = "",
    y = "IMC",
    fill = "Sexo"
  ) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1)
  ) +
  coord_flip()

datos_obesos <- datos_completos %>%
  filter(grepl("Obesidad", estado_nutricional))

ggplot(datos_obesos, aes(x = edad, y = monto_reclamacion, size = imc, color = sexo)) +
  geom_point(alpha = 0.7) +
  facet_wrap(~ region) +
  scale_size_continuous(range = c(2, 8)) +
  scale_color_brewer(palette = "Set1") +
  labs(
    title = "Relación entre edad, monto de reclamación e IMC",
    subtitle = "Para personas con obesidad, por región",
    x = "Edad",
    y = "Monto de reclamación",
    size = "IMC",
    color = "Sexo"
  ) +
  theme(
    legend.position = "right",
    strip.text = element_text(size = 10, face = "bold")
  )

Práctica 2

Emiliano Rubio Ramos

2025-03-05