Práctica 2
Karen Idaly Nava
2025-02-28
- 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.
datos <- read.csv("data_prac_2.csv", header = T, dec = ".",
na.strings = c("&&", "null", "$$"), stringsAsFactors = T)b. Verifique que las variables tengan el fomato adecuado para trabajar.
str(datos)## 'data.frame': 1338 obs. of 7 variables:
## $ edad : int 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","s\xed": 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 ...datos$fumador <- lapply(datos$fumador, function(x) ifelse(x == "no", "no", "si"))
datos$fumador <- factor(datos$fumador, levels = c("si", "no"))c. Hay manera de detectar valores duplicados?, en caso negativo, ¿qué podría proponer como identificador, para evitar duplicados en el data set?
datos %>%
janitor::get_dupes()## No variable names specified - using all columns.## 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
datos <- datos %>%
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
datos_num <- data.frame(edad = datos$edad, imc = datos$imc, hijos = datos$hijos, clm = datos$clm)— Reemplazamos los NA
# Reemplazar con la media
datos_1 <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), mean(x, na.rm = T), x)))
# Reemplazar con la media recortada
datos_2 <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), mean(x, na.rm = T, trim = 0.15), x)))
# Reemplazar con la mediana
datos_3 <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), median(x, na.rm = T), x)))
# Reemplazar por interpolación
datos_4 <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), na.approx(x, na.rm = T), x)))
# Reemplazar con la moda
datos_5 <- data.frame(lapply(datos_num, function(x) ifelse(is.na(x), mfv(x, na_rm = T), x)))— Obtenemos el resumen de las variables numéricas
# Tabla resumen
summary(datos_num)## edad imc hijos clm
## 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 :41summary(datos_1$edad)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.00 27.00 39.24 39.24 51.00 64.00summary(datos_2)## edad imc hijos clm
## 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. :63770summary(datos_3)## edad imc hijos clm
## 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. :63770summary(datos_4)## edad imc hijos clm
## 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. :63770summary(datos_5)## edad imc hijos clm
## 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.:16587
## Max. :64.00 Max. :53.13 Max. :5.000 Max. :63770Como sugerencia personal usaría el método de reemplazo por interpolación dado que este resulta ser más efectivo y estricto a la hora de hacer el reemplazo, sin embargo, la media recortada también es una opción considerable ya que al eliminar los extremos hace mejores estimaciones.
- 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_f <- data.frame(sexo = datos$sexo, fumador = datos$fumador, region = datos$region, datos_4)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?.
# Edad
ggplot(datos_f, aes(edad)) + geom_histogram(fill = "darkseagreen") +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "EDAD", x = NULL, y = NULL)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# IMC
ggplot(datos_f, aes(imc)) + geom_histogram(fill = "lightpink3") +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "IMC", x = NULL, y = NULL)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Número de hijos
ggplot(datos_f, aes(hijos)) + geom_histogram(fill = "plum3") +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "NÚMERO DE HIJOS", x = NULL, y = NULL)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# CLM
ggplot(datos_f, aes(clm)) + geom_histogram(fill = "slategray2") +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "RECLAMACIONES", x = NULL, y = NULL)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Aunque los histogramas proporcionan un buen acercamiento al análisis de los datos pues permiten observar de forma precisa como estos se distribuyen, personalmente, considero que se puede perder información pues el intervalo es bastante amplio dado el número de observaciones; estos podrían ser complementados con gráficos de dispersión o tablas de frecuencia
b. Calcule la media de monto de reclamación por sexo.
rec_by_sex <- datos_f %>%
group_by(sexo) %>%
summarise(prom_mont = mean(clm))
rec_by_sex## # A tibble: 2 × 2
## sexo prom_mont
## <fct> <dbl>
## 1 femenino 12517.
## 2 masculino 14017.ggplot(datos_f, aes(x = sexo, y = clm, fill = sexo)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("femenino" = "indianred3",
"masculino" = "salmon3")) +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "RECLAMACIONES POR SEXO", x = NULL, y = NULL) +
guides(fill = "none")
c. Calcule la media de monto de reclamación por fumador y sexo.
rec_by_sex_fum <- datos_f %>%
group_by(sexo, fumador) %>%
summarise(prom_mont_ = mean(clm))## `summarise()` has grouped output by 'sexo'. You can override using the
## `.groups` argument.rec_by_sex_fum## # A tibble: 4 × 3
## # Groups: sexo [2]
## sexo fumador prom_mont_
## <fct> <fct> <dbl>
## 1 femenino si 29556.
## 2 femenino no 8935.
## 3 masculino si 32874.
## 4 masculino no 8206.ggplot(datos_f, aes(x = fumador, y = clm, fill = fumador)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("si" = "darkseagreen4",
"no" = "darkslategray4")) +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "RECLAMACIONES POR CONDICIÓN DE FUMADOR", x = NULL, y = NULL) +
guides(fill = "none")
d. Identifique la región con mayor monto promedio de reclamación.
rec_by_reg <- datos_f %>%
group_by(region) %>%
summarise(prom_rec_reg = mean(clm)) %>%
arrange(desc(prom_rec_reg))
rec_by_reg## # A tibble: 4 × 2
## region prom_rec_reg
## <fct> <dbl>
## 1 sureste 14588.
## 2 noreste 13577.
## 3 noroeste 12418.
## 4 suroeste 12354.ggplot(datos_f, aes(x = region, y = clm, fill = region)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("noreste" = "goldenrod2",
"noroeste" = "deeppink3",
"sureste" = "darkorange3",
"suroeste" = "brown3")) +
theme(plot.title = element_text(family = "serif", face = "bold", size = 15,
hjust = 0.5, vjust = 1, lineheight = 1),
axis.text.x = element_text(family = "serif"),
axis.text.y = element_text(family = "serif")) +
labs(title = "RECLAMACIONES POR REGIÓN", x = NULL, y = NULL) +
guides(fill = "none")
e. Cree una columna con la etiqueta ”obesidad”, si el imc es mayor a 30.
datos_f <- datos_f %>%
mutate(Clasificación = ifelse(imc>30, "Obesidad", ""))f. Identifique el top 10 de personas obesas indicando: edad, sexo, hijos, monto de reclamación y región.
top_by_clas <- datos_f %>%
select(imc, Clasificación, edad, sexo, hijos, clm, region) %>%
arrange(desc(imc))
head(top_by_clas, 10)## imc Clasificación edad sexo hijos clm region
## 1 53.13 Obesidad 18 masculino 0 1163.463 sureste
## 2 52.58 Obesidad 22 masculino 1 44501.398 sureste
## 3 50.38 Obesidad 23 masculino 1 2438.055 sureste
## 4 49.06 Obesidad 58 masculino 0 11381.325 sureste
## 5 47.74 Obesidad 52 masculino 1 9748.911 sureste
## 6 47.60 Obesidad 37 femenino 2 46113.511 suroeste
## 7 47.52 Obesidad 47 masculino 1 8083.920 sureste
## 8 47.41 Obesidad 54 femenino 0 63770.428 sureste
## 9 46.75 Obesidad 52 femenino 5 12592.534 sureste
## 10 46.70 Obesidad 54 femenino 2 11538.421 suroeste