Análisis exploratorio de datos del proyecto final

Importación de la base de datos

Importamos la base de datos del proyecto final, la cual contiene datos de la vida cotidiana de 100000 individuos, y el objetivo de la misma es predecir si la persona corre riesgo de contraer una enfermedad o no.

file_id <- "1ishmv5Y8t_aTkwyukQ0ufPwtE9ghwEL0"
url <- paste0("https://drive.google.com/uc?export=download&id=", file_id)

#Guardar como archivo local
GET(url, write_disk("base_final.csv", overwrite = TRUE))

## Response [https://drive.usercontent.google.com/download?id=1ishmv5Y8t_aTkwyukQ0ufPwtE9ghwEL0&export=download]
##   Date: 2025-08-16 04:05
##   Status: 200
##   Content-Type: application/octet-stream
##   Size: 53 MB
## <ON DISK>  C:\DataViz\actividades_en_clase\base_final.csv

#Leer la base
df <- read.csv("base_final.csv")

Vistazo a la base de datos:

head(df)

##   survey_code age gender   height   weight      bmi bmi_estimated bmi_scaled
## 1           1  56   Male 173.4169 56.88664 18.91593      18.91593   56.74778
## 2           2  69 Female 163.2074 97.79986 36.71628      36.71628  110.14883
## 3           3  46   Male 177.2820 80.68756 25.67305      25.67305   77.01915
## 4           4  32 Female 172.1013 63.14287 21.31848      21.31848   63.95544
## 5           5  60 Female 163.6088 40.00000 14.94330      14.94330   44.82991
## 6           6  25   Male 186.7880 55.27611 15.84307      15.84307   47.52922
##   bmi_corrected waist_size blood_pressure heart_rate cholesterol   glucose
## 1      18.98912   72.16513       118.2643   60.74982    214.5805 103.00818
## 2      36.51142   85.59889       117.9180   66.46370    115.7940 116.90513
## 3      25.58743   90.29503       123.0737   76.04321    138.1348  89.18030
## 4      21.17711  100.50421       148.1735   68.78198    203.0174 128.37580
## 5      14.84430   69.02115       150.6132   92.33536    200.4124  94.81333
## 6      16.08783   86.59192       118.7230   51.97148    165.6592  99.49677
##    insulin sleep_hours sleep_quality work_hours physical_activity daily_steps
## 1       NA    6.475885          Fair   7.671313         0.3569184   13320.943
## 2 10.13160    8.428410          Good   9.515198         0.5682193   11911.201
## 3       NA    5.702164          Poor   5.829853         3.7644062    2974.035
## 4 18.73318    5.188316          Good   9.489693         0.8894743    5321.539
## 5 16.03870    7.912514          Good   7.275450         2.9016081    9791.377
## 6       NA   10.065352          Poor   8.536500         3.5813084    9221.120
##   calorie_intake sugar_intake alcohol_consumption smoking_level water_intake
## 1       2673.547     44.47689                        Non-smoker    1.6942619
## 2       2650.377     74.66341           Regularly         Light    0.7164092
## 3       1746.755     19.70238           Regularly         Heavy    2.4879004
## 4       2034.193     82.58005        Occasionally         Heavy    2.6433347
## 5       2386.210     45.96132                             Heavy    1.9683928
## 6       2565.732     71.99968        Occasionally         Heavy    2.1152130
##   screen_time stress_level mental_health_score mental_health_support
## 1    5.003963            2                   8                    No
## 2    5.925455            3                   9                    No
## 3    4.371250            0                   1                    No
## 4    4.116064           10                   4                    No
## 5    3.180087            9                   7                   Yes
## 6    5.878847            7                   6                    No
##   education_level   job_type occupation   income  diet_type exercise_type
## 1             PhD       Tech     Farmer 6759.822      Vegan      Strength
## 2     High School     Office   Engineer 6240.518      Vegan        Cardio
## 3          Master     Office    Teacher 3429.179      Vegan        Cardio
## 4          Master      Labor    Teacher 2618.504 Vegetarian         Mixed
## 5          Master Unemployed     Doctor 3662.086      Vegan          None
## 6     High School     Office    Teacher 3667.152 Vegetarian          None
##   device_usage healthcare_access insurance sunlight_exposure meals_per_day
## 1         High              Poor        No              High             5
## 2     Moderate          Moderate        No              High             5
## 3         High              Good       Yes              High             4
## 4          Low          Moderate        No              High             1
## 5          Low          Moderate       Yes              High             1
## 6          Low          Moderate       Yes              High             4
##   caffeine_intake family_history pet_owner electrolyte_level gene_marker_flag
## 1        Moderate             No       Yes                 0                1
## 2            High            Yes        No                 0                1
## 3        Moderate             No        No                 0                1
## 4            None             No       Yes                 0                1
## 5            High            Yes       Yes                 0                1
## 6            None            Yes       Yes                 0                1
##   environmental_risk_score daily_supplement_dosage  target
## 1                      5.5              -2.2755022 healthy
## 2                      5.5               6.2393399 healthy
## 3                      5.5               5.4237367 healthy
## 4                      5.5               8.3886106 healthy
## 5                      5.5               0.3326224 healthy
## 6                      5.5              -8.9854645 healthy

Y sus dimensiones son:

n<-length(df$survey_code)
m<-length(df)
print(paste(n, " filas y ", m, " columnas"))

## [1] "100000  filas y  48  columnas"

Análisis numérico y de datos faltantes

Antes de comenzar con el análisis gráfico, comprobemos si el dataset tiene datos faltantes, y de ser así, se les realizará una imputación. Usando la función summary_fact() obtenemos lo siguiente:

summary_fact<-function(df){
  names<-names(df)
  for (j in 1:length(names)){
    if (is.character(df[[j]])){
      df[[j]]<-as.factor(df[[j]])
    }
  }
  summary(df)
}

summary_fact(df)

##   survey_code          age           gender          height     
##  Min.   :     1   Min.   :18.00   Female:49868   Min.   :140.0  
##  1st Qu.: 25001   1st Qu.:33.00   Male  :50132   1st Qu.:163.3  
##  Median : 50001   Median :48.00                  Median :170.0  
##  Mean   : 50001   Mean   :48.53                  Mean   :170.0  
##  3rd Qu.: 75000   3rd Qu.:64.00                  3rd Qu.:176.7  
##  Max.   :100000   Max.   :79.00                  Max.   :210.0  
##                                                                 
##      weight            bmi         bmi_estimated      bmi_scaled    
##  Min.   : 40.00   Min.   : 9.988   Min.   : 9.988   Min.   : 29.97  
##  1st Qu.: 59.86   1st Qu.:20.271   1st Qu.:20.271   1st Qu.: 60.81  
##  Median : 69.92   Median :24.157   Median :24.157   Median : 72.47  
##  Mean   : 70.06   Mean   :24.494   Mean   :24.494   Mean   : 73.48  
##  3rd Qu.: 80.03   3rd Qu.:28.259   3rd Qu.:28.259   3rd Qu.: 84.78  
##  Max.   :139.25   Max.   :59.235   Max.   :59.235   Max.   :177.70  
##                                                                     
##  bmi_corrected      waist_size     blood_pressure     heart_rate    
##  Min.   : 9.894   Min.   : 34.09   Min.   : 59.13   Min.   : 34.75  
##  1st Qu.:20.271   1st Qu.: 76.80   1st Qu.:109.81   1st Qu.: 68.28  
##  Median :24.152   Median : 84.96   Median :119.95   Median : 75.05  
##  Mean   :24.494   Mean   : 84.93   Mean   :119.98   Mean   : 74.97  
##  3rd Qu.:28.248   3rd Qu.: 93.02   3rd Qu.:130.12   3rd Qu.: 81.69  
##  Max.   :59.143   Max.   :133.15   Max.   :184.44   Max.   :114.14  
##                                    NA's   :7669     NA's   :14003   
##   cholesterol        glucose          insulin        sleep_hours    
##  Min.   : 58.41   Min.   : 12.43   Min.   :-6.795   Min.   : 3.000  
##  1st Qu.:169.67   1st Qu.: 86.46   1st Qu.:11.627   1st Qu.: 5.987  
##  Median :190.04   Median : 99.99   Median :14.983   Median : 6.998  
##  Mean   :189.97   Mean   : 99.99   Mean   :14.988   Mean   : 7.002  
##  3rd Qu.:210.22   3rd Qu.:113.51   3rd Qu.:18.362   3rd Qu.: 8.019  
##  Max.   :319.88   Max.   :183.88   Max.   :35.465   Max.   :12.000  
##                                    NA's   :15836                    
##    sleep_quality     work_hours     physical_activity  daily_steps   
##  Excellent:25091   Min.   : 0.000   Min.   : 0.000    Min.   : 1000  
##  Fair     :25008   1st Qu.: 6.651   1st Qu.: 1.634    1st Qu.: 5321  
##  Good     :25147   Median : 8.005   Median : 2.971    Median : 7004  
##  Poor     :24754   Mean   : 8.001   Mean   : 3.038    Mean   : 7013  
##                    3rd Qu.: 9.354   3rd Qu.: 4.327    3rd Qu.: 8702  
##                    Max.   :16.000   Max.   :11.632    Max.   :18065  
##                                                       NA's   :8329   
##  calorie_intake    sugar_intake      alcohol_consumption    smoking_level  
##  Min.   : 527.2   Min.   :-27.88               :13910    Heavy     :33208  
##  1st Qu.:1932.3   1st Qu.: 46.50   None        :28477    Light     :33437  
##  Median :2201.0   Median : 60.05   Occasionally:28831    Non-smoker:33355  
##  Mean   :2201.4   Mean   : 60.05   Regularly   :28782                      
##  3rd Qu.:2471.2   3rd Qu.: 73.48                                           
##  Max.   :3949.0   Max.   :141.51                                           
##                                                                            
##   water_intake    screen_time      stress_level    mental_health_score
##  Min.   :0.500   Min.   : 0.000   Min.   : 0.000   Min.   : 0.000     
##  1st Qu.:1.532   1st Qu.: 3.971   1st Qu.: 2.000   1st Qu.: 2.000     
##  Median :2.001   Median : 5.991   Median : 5.000   Median : 5.000     
##  Mean   :2.006   Mean   : 6.022   Mean   : 4.992   Mean   : 5.005     
##  3rd Qu.:2.473   3rd Qu.: 8.024   3rd Qu.: 8.000   3rd Qu.: 8.000     
##  Max.   :5.000   Max.   :16.000   Max.   :10.000   Max.   :10.000     
##                                                                       
##  mental_health_support    education_level        job_type        occupation   
##  No :50104             Bachelor   :25363   Healthcare:16546   Artist  :16657  
##  Yes:49896             High School:25028   Labor     :16777   Doctor  :16927  
##                        Master     :24992   Office    :16704   Driver  :16562  
##                        PhD        :24617   Service   :16571   Engineer:16474  
##                                            Tech      :16691   Farmer  :16719  
##                                            Unemployed:16711   Teacher :16661  
##                                                                               
##      income           diet_type      exercise_type     device_usage  
##  Min.   :  500   Keto      :24764   Cardio  :24988   High    :33562  
##  1st Qu.: 2665   Omnivore  :25089   Mixed   :24778   Low     :33197  
##  Median : 4005   Vegan     :25122   None    :24969   Moderate:33241  
##  Mean   : 4038   Vegetarian:25025   Strength:25265                   
##  3rd Qu.: 5360                                                       
##  Max.   :12029                                                       
##  NA's   :8470                                                        
##  healthcare_access insurance   sunlight_exposure meals_per_day  
##  Good    :33428    No :49879   High    :33081    Min.   :1.000  
##  Moderate:33295    Yes:50121   Low     :33468    1st Qu.:2.000  
##  Poor    :33277                Moderate:33451    Median :3.000  
##                                                  Mean   :2.999  
##                                                  3rd Qu.:4.000  
##                                                  Max.   :5.000  
##                                                                 
##  caffeine_intake  family_history pet_owner   electrolyte_level gene_marker_flag
##  High    :33368   No :49945      No :50153   Min.   :0         Min.   :1       
##  Moderate:33371   Yes:50055      Yes:49847   1st Qu.:0         1st Qu.:1       
##  None    :33261                              Median :0         Median :1       
##                                              Mean   :0         Mean   :1       
##                                              3rd Qu.:0         3rd Qu.:1       
##                                              Max.   :0         Max.   :1       
##                                                                NA's   :10474   
##  environmental_risk_score daily_supplement_dosage      target     
##  Min.   :5.5              Min.   : -9.99990       diseased:29903  
##  1st Qu.:5.5              1st Qu.: -4.98050       healthy :70097  
##  Median :5.5              Median :  0.01559                       
##  Mean   :5.5              Mean   :  0.01573                       
##  3rd Qu.:5.5              3rd Qu.:  5.00842                       
##  Max.   :5.5              Max.   :  9.99997                       
##

De esta función obtenemos información muy relevante:

La variable survey_code hace de ID en la base de datos, por lo que no tiene sentido analizarla
En la base hay tanto variables categóricas como numéricas, y el objetivo el cual es binario.
Existe una columna duplicada: bmi y bmi_estimated. Posteriormente se revisará la relación que tiene bmi con bmi_scaled y bmi_corrected mediante una matriz de correlación.
Las variables electrolyte_level, gene_marker_flag y environmental_risk_score solo tienen registros del mismo valor, 0, 1 y 5 respectivamente, así que no tendría sentido incluir en el análisis una característica con la que todos cuenten.
Las siguientes variables cuentan con valores faltantes: blood_pressure, heart_rate, insulin, daily_steps, alcohol_consumption, income y gene_marker_flag, aunque esta última será eliminada del análisis como ya se comentó anteriormente.
Las variables insulin , sugar_intake y daily_supplement_dosage cuentan con un valor mínimo negativo, lo cual en este contexto no tiene mucho sentido y debe ser tratado correctamente en la sección de valores atípicos.

Tratamiento de datos faltantes

Eliminemos entonces las columnas que no van a ser usadas:

df<-select(df,-bmi_estimated,-electrolyte_level,-gene_marker_flag,-environmental_risk_score)

A su vez, marquemos como NA los registros de insulin , sugar_intake y daily_supplement_dosage cuyo valor sea negativo, ya que si los dejamos así esto podría afectar la imputación y el análisis de outliers.

for (i in 1:n){
  if(!is.na(df$insulin[i]) && df$insulin[i]<0){
    df$insulin[i]=NA
  }
}
for (i in 1:n){
  if(!is.na(df$sugar_intake[i]) && df$sugar_intake[i]<0){
    df$sugar_intake[i]=NA
  }
}
for (i in 1:n){
  if(!is.na(df$daily_supplement_dosage[i]) && df$daily_supplement_dosage[i]<0){
    df$daily_supplement_dosage[i]=NA
  }
}

Como los registros faltantes de la variable alcohol_consumption no están marcados como NA sino como celdas vacías, hagamos este cambio:

for (i in 1:n){
  if (df$alcohol_consumption[i]=="")
  df$alcohol_consumption[i]<-NA
}

Ahora veamos más a detalle la proporción de datos faltantes que hay por variable:

NAs<-function(dataf){
  nas<-c()
  for (j in 1: length(dataf)){
    cont=0
    for (i in 1:n){
      if (is.na(dataf[i,j])){
        cont<-cont+1
      }
    }
    nas[j]<-cont
  }
  return(nas)
}

nas<-NAs(df)
#Proporción de NA´s por columna
nasprp<-nas/n

colnames<-colnames(df)

faltantes<-data.frame(nasprp,colnames)
faltantes

##     nasprp                colnames
## 1  0.00000             survey_code
## 2  0.00000                     age
## 3  0.00000                  gender
## 4  0.00000                  height
## 5  0.00000                  weight
## 6  0.00000                     bmi
## 7  0.00000              bmi_scaled
## 8  0.00000           bmi_corrected
## 9  0.00000              waist_size
## 10 0.07669          blood_pressure
## 11 0.14003              heart_rate
## 12 0.00000             cholesterol
## 13 0.00000                 glucose
## 14 0.15935                 insulin
## 15 0.00000             sleep_hours
## 16 0.00000           sleep_quality
## 17 0.00000              work_hours
## 18 0.00000       physical_activity
## 19 0.08329             daily_steps
## 20 0.00000          calorie_intake
## 21 0.00124            sugar_intake
## 22 0.13910     alcohol_consumption
## 23 0.00000           smoking_level
## 24 0.00000            water_intake
## 25 0.00000             screen_time
## 26 0.00000            stress_level
## 27 0.00000     mental_health_score
## 28 0.00000   mental_health_support
## 29 0.00000         education_level
## 30 0.00000                job_type
## 31 0.00000              occupation
## 32 0.08470                  income
## 33 0.00000               diet_type
## 34 0.00000           exercise_type
## 35 0.00000            device_usage
## 36 0.00000       healthcare_access
## 37 0.00000               insurance
## 38 0.00000       sunlight_exposure
## 39 0.00000           meals_per_day
## 40 0.00000         caffeine_intake
## 41 0.00000          family_history
## 42 0.00000               pet_owner
## 43 0.49911 daily_supplement_dosage
## 44 0.00000                  target

En total hay 6 variables con datos faltantes, que no superan el 15% en cada caso. Al no ser una cantidad tan grande, podemos hacer una imputación simple en cada caso.

Imputación de variables numéricas

`blood_pressure`:

Guardemos una copia del dataset original:

imp_df<-df

Verificamos la distribución de la variable para saber que tipo de imputación realizar.

ggplot(imp_df, aes(x=blood_pressure))+
  geom_histogram(fill="red", color="black")+
  ggtitle("Distribución de la variable blood_pressure") +
  xlab("blood_pressure") + ylab("Frecuencia")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 7669 rows containing non-finite outside the scale range
## (`stat_bin()`).

Parece seguir una distribución normal, comprobemos con el test de Kolmogorov-Smirnov

media<-mean(imp_df$blood_pressure, na.rm=TRUE)
ds<-sd(imp_df$blood_pressure,na.rm=TRUE)
ks.test(imp_df$blood_pressure, "pnorm", mean=media, sd=ds)

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  imp_df$blood_pressure
## D = 0.0017879, p-value = 0.9294
## alternative hypothesis: two-sided

Dado que el p-valor es mayor a mi nivel de significancia (0.05), no existe evidencia suficente para rechazar la normalidad en la distribución de la variable, por lo que podemos realizar una imputación por la media.

for (i in 1:n){
  if (is.na(imp_df$blood_pressure[i])){
    imp_df$blood_pressure[i]=media
  }
}

Evaluamos la imputación

wilcox.test(df$blood_pressure, imp_df$blood_pressure)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df$blood_pressure and imp_df$blood_pressure
## W = 4616101364, p-value = 0.9706
## alternative hypothesis: true location shift is not equal to 0

Dado que el p-valor es mayor a mi nivel de significancia(0.05), no existen diferencias significativas entre la variable imputada y la no imputada.

`heart_rate`:

Verificamos la distribución de la variable para saber que tipo de imputación realizar.

ggplot(imp_df, aes(x=heart_rate))+
  geom_histogram(fill="red", color="black")+
  ggtitle("Distribución de la variable heart_rate") +
  xlab("heart_rate") + ylab("Frecuencia")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 14003 rows containing non-finite outside the scale range
## (`stat_bin()`).

Parece seguir una distribución normal, comprobemos con el test de Kolmogorov-Smirnov

media<-mean(imp_df$heart_rate, na.rm=TRUE)
ds<-sd(imp_df$heart_rate,na.rm=TRUE)
ks.test(imp_df$heart_rate, "pnorm", mean=media, sd=ds)

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  imp_df$heart_rate
## D = 0.0038112, p-value = 0.1644
## alternative hypothesis: two-sided

for (i in 1:n){
  if (is.na(imp_df$heart_rate[i])){
    imp_df$heart_rate[i]=media
  }
}

Evaluamos la imputación

wilcox.test(df$heart_rate, imp_df$heart_rate)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df$heart_rate and imp_df$heart_rate
## W = 4303609806, p-value = 0.7446
## alternative hypothesis: true location shift is not equal to 0

Dado que el p-valor es mayor a mi nivel de significancia(0.05), no existen diferencias significativas entre la variable imputada y la no imputada.

`insulin`:

Verificamos la distribución de la variable para saber que tipo de imputación realizar.

ggplot(imp_df, aes(x=insulin))+
  geom_histogram(fill="red", color="black")+
  ggtitle("Distribución de la variable insulin") +
  xlab("insulin") + ylab("Frecuencia")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 15935 rows containing non-finite outside the scale range
## (`stat_bin()`).

Parece seguir una distribución normal, comprobemos con el test de Kolmogorov-Smirnov

media<-mean(imp_df$insulin, na.rm=TRUE)
ds<-sd(imp_df$insulin,na.rm=TRUE)
ks.test(imp_df$insulin, "pnorm", mean=media, sd=ds)

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  imp_df$insulin
## D = 0.0024184, p-value = 0.7092
## alternative hypothesis: two-sided

for (i in 1:n){
  if (is.na(imp_df$insulin[i])){
    imp_df$insulin[i]=media
  }
}

Evaluamos la imputación

wilcox.test(df$insulin, imp_df$insulin)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df$insulin and imp_df$insulin
## W = 4201282028, p-value = 0.8624
## alternative hypothesis: true location shift is not equal to 0

Dado que el p-valor es mayor a mi nivel de significancia(0.05), no existen diferencias significativas entre la variable imputada y la no imputada.

`daily_steps`:

Verificamos la distribución de la variable para saber que tipo de imputación realizar.

ggplot(imp_df, aes(x=daily_steps))+
  geom_histogram(fill="red", color="black")+
  ggtitle("Distribución de la variable daily_steps") +
  xlab("daily_steps") + ylab("Frecuencia")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 8329 rows containing non-finite outside the scale range
## (`stat_bin()`).

No parece seguir una distribución normal, comprobemos con el test de Kolmogorov-Smirnov

media<-mean(imp_df$daily_steps, na.rm=TRUE)
ds<-sd(imp_df$daily_steps,na.rm=TRUE)
ks.test(imp_df$daily_steps, "pnorm", mean=media, sd=ds)

## Warning in ks.test.default(imp_df$daily_steps, "pnorm", mean = media, sd = ds):
## ties should not be present for the one-sample Kolmogorov-Smirnov test

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  imp_df$daily_steps
## D = 0.0078501, p-value = 2.479e-05
## alternative hypothesis: two-sided

Dado que hay empates, comprobamos normalidad con un lillie.test

library(nortest)
lillie.test(imp_df$daily_steps)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  imp_df$daily_steps
## D = 0.0078501, p-value = 3.14e-13

Dado que el p-valor es menor a mi nivel de significancia (0.05), se rechaza la hipótesis nula de que la variable sigue una distribución normal, por lo que procedemos a imputar con la mediana.

mediana<-median(imp_df$daily_steps,na.rm=TRUE)
for (i in 1:n){
  if (is.na(imp_df$daily_steps[i])){
    imp_df$daily_steps[i]=mediana
  }
}

Evaluamos la imputación

wilcox.test(df$daily_steps, imp_df$daily_steps)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df$daily_steps and imp_df$daily_steps
## W = 4583550000, p-value = 1
## alternative hypothesis: true location shift is not equal to 0

Dado que el p-valor es mayor a mi nivel de significancia(0.05), no existen diferencias significativas entre la variable imputada y la no imputada.

`income`:

Verificamos la distribución de la variable para saber que tipo de imputación realizar.

ggplot(imp_df, aes(x=income))+
  geom_histogram(fill="red", color="black")+
  ggtitle("Distribución de la variable income") +
  xlab("income") + ylab("Frecuencia")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 8470 rows containing non-finite outside the scale range
## (`stat_bin()`).

No parece seguir una distribución normal, comprobemos con el test de Kolmogorov-Smirnov

media<-mean(imp_df$income, na.rm=TRUE)
ds<-sd(imp_df$income,na.rm=TRUE)
ks.test(imp_df$income, "pnorm", mean=media, sd=ds)

## Warning in ks.test.default(imp_df$income, "pnorm", mean = media, sd = ds): ties
## should not be present for the one-sample Kolmogorov-Smirnov test

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  imp_df$income
## D = 0.033386, p-value < 2.2e-16
## alternative hypothesis: two-sided

Dado que hay empates, comprobamos normalidad con un lillie.test

lillie.test(imp_df$income)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  imp_df$income
## D = 0.033386, p-value < 2.2e-16

Dado que el p-valor es menor a mi nivel de significancia (0.05), se rechaza la hipótesis nula de que la variable sigue una distribución normal, por lo que procedemos a imputar con la mediana.

mediana<-median(imp_df$income, na.rm=TRUE)
for (i in 1:n){
  if (is.na(imp_df$income[i])){
    imp_df$income[i]=mediana
  }
}

Evaluamos la imputación

wilcox.test(df$income, imp_df$income)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df$income and imp_df$income
## W = 4576500000, p-value = 1
## alternative hypothesis: true location shift is not equal to 0

Dado que el p-valor es mayor a mi nivel de significancia(0.05), no existen diferencias significativas entre la variable imputada y la no imputada.

`sugar_intake:`

Verificamos la distribución de la variable para saber que tipo de imputación realizar.

ggplot(imp_df, aes(x=sugar_intake))+
  geom_histogram(fill="red", color="black")+
  ggtitle("Distribución de la variable insulin") +
  xlab("insulin") + ylab("Frecuencia")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 124 rows containing non-finite outside the scale range
## (`stat_bin()`).

Parece seguir una distribución normal, comprobemos con el test de Kolmogorov-Smirnov

media<-mean(imp_df$sugar_intake, na.rm=TRUE)
ds<-sd(imp_df$sugar_intake,na.rm=TRUE)
ks.test(imp_df$sugar_intake, "pnorm", mean=media, sd=ds)

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  imp_df$sugar_intake
## D = 0.0036513, p-value = 0.1394
## alternative hypothesis: two-sided

for (i in 1:n){
  if (is.na(imp_df$sugar_intake[i])){
    imp_df$sugar_intake[i]=media
  }
}

Evaluamos la imputación

wilcox.test(df$sugar_intake, imp_df$sugar_intake)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df$sugar_intake and imp_df$sugar_intake
## W = 4993786980, p-value = 0.9992
## alternative hypothesis: true location shift is not equal to 0

Dado que el p-valor es mayor a mi nivel de significancia(0.05), no existen diferencias significativas entre la variable imputada y la no imputada.

`daily_supplement_dosage`:

Luego de que descartamos los valores negativos de esta variable, nos dimos cuenta de que el porcentaje de valores faltantes de la misma es de aproximadamente el 50%, por lo que hacer una imputación podría introducir sesgos. Por esto, decidimos eliminarla del análisis.

imp_df<-select(imp_df,-daily_supplement_dosage)

Variable categórica

alcohol_consumption

Esta variable, al ser categórica, vamos a imputarla con la moda.

names<-names(imp_df)
  for (j in 1:length(names)){
    if (is.character(imp_df[[j]])){
      imp_df[[j]]<-as.factor(imp_df[[j]])
    }
  }

tabla<-table(imp_df$alcohol_consumption)
moda<-names(tabla)[which.max(tabla)]
for (i in 1:n){
  if(is.na(imp_df$alcohol_consumption[i])){
    imp_df$alcohol_consumption[i]<-moda
  }
    
}

Ya que hemos tratado los valores faltantes, vamos ahora con los valores atípicos.

Valores atípicos

Veamos por medio de boxplots los valores atípicos de cada variable numérica:

num_vars <- names(imp_df)[sapply(imp_df, is.numeric)]

for (var in num_vars) {
  boxplot(imp_df[[var]],
          main = paste("Boxplot de", var),
          col = "skyblue",
          border = "black",
          horizontal = TRUE)
}

De estos boxplots tenemos lo siguiente:

Variables sin outliers, como lo son age, stress_level, mental_health_score, meals_per_day. Esto se debe más que nada a que estos valores son discretos y tienen un rango bastante pequeño, por lo que no se detectan outliers por medio del rango intercuartílico.
Para las demás variables tenemos dos casos, outliers solo detectados por “encima” de la caja, y outliers que fueron detectados por “debajo” y por “encima” de la caja. Estas variables si son continuas.

Ahora, se detectarán por medio del rango intercuartílico los outliers, y luego serán capados dependiendo de los tipos de outliers que tenga cada uno.

iqr_bounds_safe <- function(x) {
  x <- as.numeric(x)
  q <- quantile(x, c(0.25, 0.75), na.rm = TRUE, names = FALSE)
  iqr <- q[2] - q[1]
  lo  <- q[1] - 1.5 * iqr
  hi  <- q[2] + 1.5 * iqr
  setNames(c(lo, hi), c("lo", "hi"))
}

df_out<-imp_df
vars_cap_sup <- c(
  "insulin","blood_pressure","bmi","glucose",
  "weight", "bmi_scaled", "bmi_corrected",
  "sleep_hours", "physical_activity", "daily_steps",
  "water_intake", "screen_time", "income"
)



for (v in vars_cap_sup) {


  # 1) Antes del capping
  x_before <- imp_df[[v]]
  b <- iqr_bounds_safe(x_before)
  lo <- as.numeric(b["lo"]); hi <- as.numeric(b["hi"])


  # 2) Capping superior
  x_after <- pmin(x_before, hi, na.rm = TRUE)

  # 3) Reemplazar en df_out
  df_out[[v]] <- x_after


  out_before <- sum(x_before < lo | x_before > hi, na.rm = TRUE)
  out_after  <- sum(x_after  < lo | x_after  > hi, na.rm = TRUE)

  
  par(mfrow = c(2, 2), mar = c(4, 4, 2, 1))

# Histograma antes
hist(x_before, breaks = 30, main = paste(v, "- Antes"),
     xlab = v, col = "lightblue", border = "white")
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

# Histograma después
hist(x_after, breaks = 30, main = paste(v, "- Después"),
     xlab = v, col = "lightgreen", border = "white")
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

# Boxplot antes
boxplot(x_before, main = "Antes", col = "lightblue", horizontal = TRUE)
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

# Boxplot después
boxplot(x_after, main = "Después", col = "lightgreen", horizontal = TRUE)
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

par(mfrow = c(1, 1))  # Reset layout

}

En variables como insulin o glucose, decidimos solo capar por arriba ya que los registros cercanos a 0 no nos parecieron registros errados.

vars_cap_both <- c(
  "height", "waist_size", "heart_rate",
  "cholesterol", "work_hours", "calorie_intake", "sugar_intake"
)


for (v in vars_cap_both) {


  # 1) Antes del capping
  x_before <- imp_df[[v]]
  b <- iqr_bounds_safe(x_before)
  lo <- as.numeric(b["lo"]); hi <- as.numeric(b["hi"])


  # 2) Capping inferior y superior
  x_after <- pmin(pmax(x_before, lo), hi, na.rm = TRUE)

  # 3) Reemplazar en df_out
  df_out[[v]] <- x_after

  out_before <- sum(x_before < lo | x_before > hi, na.rm = TRUE)
  out_after  <- sum(x_after  < lo | x_after  > hi, na.rm = TRUE)

  
  par(mfrow = c(2, 2), mar = c(4, 4, 2, 1))

# Histograma antes
hist(x_before, breaks = 30, main = paste(v, "- Antes"),
     xlab = v, col = "lightblue", border = "white")
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

# Histograma después
hist(x_after, breaks = 30, main = paste(v, "- Después"),
     xlab = v, col = "lightgreen", border = "white")
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

# Boxplot antes
boxplot(x_before, main = "Antes", col = "lightblue", horizontal = TRUE)
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

# Boxplot después
boxplot(x_after, main = "Después", col = "lightgreen", horizontal = TRUE)
abline(v = hi, col = "red", lwd = 2, lty = 2)
abline(v = lo, col = "red", lwd = 2, lty = 2)

par(mfrow = c(1, 1))  # Reset layout

}

Guardemos estos cambios en el dataframe que tenía las imputaciones de los valores faltantes.

imp_df<-df_out

Análisis exploratorio de datos (EDA)

Luego de tratar los datos, veamos nuevamente la información que nos ofrece la función summary():

summary(imp_df)

##   survey_code          age           gender          height     
##  Min.   :     1   Min.   :18.00   Female:49868   Min.   :143.2  
##  1st Qu.: 25001   1st Qu.:33.00   Male  :50132   1st Qu.:163.3  
##  Median : 50001   Median :48.00                  Median :170.0  
##  Mean   : 50001   Mean   :48.53                  Mean   :170.0  
##  3rd Qu.: 75000   3rd Qu.:64.00                  3rd Qu.:176.7  
##  Max.   :100000   Max.   :79.00                  Max.   :196.9  
##      weight            bmi           bmi_scaled     bmi_corrected   
##  Min.   : 40.00   Min.   : 9.988   Min.   : 29.97   Min.   : 9.894  
##  1st Qu.: 59.86   1st Qu.:20.271   1st Qu.: 60.81   1st Qu.:20.271  
##  Median : 69.92   Median :24.157   Median : 72.47   Median :24.152  
##  Mean   : 70.05   Mean   :24.467   Mean   : 73.40   Mean   :24.467  
##  3rd Qu.: 80.03   3rd Qu.:28.259   3rd Qu.: 84.78   3rd Qu.:28.248  
##  Max.   :110.28   Max.   :40.240   Max.   :120.72   Max.   :40.213  
##    waist_size     blood_pressure     heart_rate     cholesterol   
##  Min.   : 52.46   Min.   : 59.13   Min.   :53.16   Min.   :108.8  
##  1st Qu.: 76.80   1st Qu.:110.82   1st Qu.:69.54   1st Qu.:169.7  
##  Median : 84.96   Median :119.98   Median :74.97   Median :190.0  
##  Mean   : 84.93   Mean   :119.95   Mean   :74.97   Mean   :190.0  
##  3rd Qu.: 93.02   3rd Qu.:129.19   3rd Qu.:80.47   3rd Qu.:210.2  
##  Max.   :117.35   Max.   :156.74   Max.   :96.85   Max.   :271.1  
##     glucose          insulin           sleep_hours       sleep_quality  
##  Min.   : 12.43   Min.   : 0.005744   Min.   : 3.000   Excellent:25091  
##  1st Qu.: 86.46   1st Qu.:12.340408   1st Qu.: 5.987   Fair     :25008  
##  Median : 99.99   Median :15.007665   Median : 6.998   Good     :25147  
##  Mean   : 99.98   Mean   :14.982856   Mean   : 7.001   Poor     :24754  
##  3rd Qu.:113.51   3rd Qu.:17.663430   3rd Qu.: 8.019                    
##  Max.   :154.08   Max.   :25.647964   Max.   :11.068                    
##    work_hours     physical_activity  daily_steps    calorie_intake
##  Min.   : 2.597   Min.   :0.000     Min.   : 1000   Min.   :1124  
##  1st Qu.: 6.651   1st Qu.:1.634     1st Qu.: 5500   1st Qu.:1932  
##  Median : 8.005   Median :2.971     Median : 7004   Median :2201  
##  Mean   : 8.001   Mean   :3.036     Mean   : 7006   Mean   :2201  
##  3rd Qu.: 9.354   3rd Qu.:4.327     3rd Qu.: 8524   3rd Qu.:2471  
##  Max.   :13.408   Max.   :8.366     Max.   :13059   Max.   :3280  
##   sugar_intake       alcohol_consumption    smoking_level    water_intake  
##  Min.   :  6.234   None        :28477    Heavy     :33208   Min.   :0.500  
##  1st Qu.: 46.579   Occasionally:42741    Light     :33437   1st Qu.:1.532  
##  Median : 60.109   Regularly   :28782    Non-smoker:33355   Median :2.001  
##  Mean   : 60.117                                            Mean   :2.006  
##  3rd Qu.: 73.476                                            3rd Qu.:2.473  
##  Max.   :113.822                                            Max.   :3.885  
##   screen_time      stress_level    mental_health_score mental_health_support
##  Min.   : 0.000   Min.   : 0.000   Min.   : 0.000      No :50104            
##  1st Qu.: 3.971   1st Qu.: 2.000   1st Qu.: 2.000      Yes:49896            
##  Median : 5.991   Median : 5.000   Median : 5.000                           
##  Mean   : 6.019   Mean   : 4.992   Mean   : 5.005                           
##  3rd Qu.: 8.024   3rd Qu.: 8.000   3rd Qu.: 8.000                           
##  Max.   :14.104   Max.   :10.000   Max.   :10.000                           
##     education_level        job_type        occupation        income    
##  Bachelor   :25363   Healthcare:16546   Artist  :16657   Min.   : 500  
##  High School:25028   Labor     :16777   Doctor  :16927   1st Qu.:2796  
##  Master     :24992   Office    :16704   Driver  :16562   Median :4005  
##  PhD        :24617   Service   :16571   Engineer:16474   Mean   :4031  
##                      Tech      :16691   Farmer  :16719   3rd Qu.:5219  
##                      Unemployed:16711   Teacher :16661   Max.   :8854  
##       diet_type      exercise_type     device_usage   healthcare_access
##  Keto      :24764   Cardio  :24988   High    :33562   Good    :33428   
##  Omnivore  :25089   Mixed   :24778   Low     :33197   Moderate:33295   
##  Vegan     :25122   None    :24969   Moderate:33241   Poor    :33277   
##  Vegetarian:25025   Strength:25265                                     
##                                                                        
##                                                                        
##  insurance   sunlight_exposure meals_per_day   caffeine_intake  family_history
##  No :49879   High    :33081    Min.   :1.000   High    :33368   No :49945     
##  Yes:50121   Low     :33468    1st Qu.:2.000   Moderate:33371   Yes:50055     
##              Moderate:33451    Median :3.000   None    :33261                 
##                                Mean   :2.999                                  
##                                3rd Qu.:4.000                                  
##                                Max.   :5.000                                  
##  pet_owner        target     
##  No :50153   diseased:29903  
##  Yes:49847   healthy :70097  
##                              
##                              
##                              
##

Analicemos nuevamente:

Ya no existen valores faltantes ya que estos fueron tratados, y los valores negativos irreales fueron tratados también.
Se nota un claro desbalance en la variable objetivo

Análisis univariado

Veamos la distribución de la variable objetivo.

ggplot(imp_df, aes(x = target, fill = target)) +
  geom_bar(aes(y = ..count..)) +
  theme_minimal() +
  ylab("count")

## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Podemos ver un claro desbalance en la variable target, que podría presentar problemas al momento de implementar modelos predictivos.

Veamos ahora la distribución de cada variable numérica por medio de histogramas:

numeric_vars<-names(imp_df)[sapply(imp_df, is.numeric)]

for (var in numeric_vars) {
  hist(imp_df[[var]],
       main = paste("Histograma de", var),
       xlab = var,
       col = "skyblue",
       border = "white")
}

Algunas variables como survey_code, la cual solo tiene números de identificación; stress_level, mental_health_score y meals_per_day, las cuales se miden con números enteros; son variables discretas, por lo que un histograma no nos da mucha información de las mismas.
Gran parte de los histogramas se encuentran sesgados a la derecha.
Solo pocas variables como height , waist_size, blood_pressure, cholesterol, glucose, insulin, calorie_intake, work_hours, sugar_intake, parecen seguir una distribución normal.

Para no saturar tanto el análisis con gráficas, veremos las variables categóricas directamente comparadas con la variable objetivo.

Análisis bivariado

Comparemos ahora las variables numéricas y categóricas con el target.

imp_df %>%
  pivot_longer(cols = numeric_vars, names_to = "variable", values_to = "valor") %>%
  ggplot(aes(x = target, y = valor, fill = target)) +
  geom_boxplot() +
  facet_wrap(~ variable, scales = "free_y") +
  theme_minimal()

## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(numeric_vars)
## 
##   # Now:
##   data %>% select(all_of(numeric_vars))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Aunque el gráfico no es tan agradable a la vista, lo que si nos permite ver es que no parece existir diferencia significativa entre los valores registrados para el grupo de enfermos y el grupo de sanos, lo cual podría ser un problema luego para la predicción, ya que no parece haber relación alguna entre los predictores y la variable objetivo.

Continuemos con las variables categóricas.

categoricas<-c()
cont=1
for (i in 1: length(names)){
  if(is.factor(imp_df[[names[i]]]) && names[i]!="target"){
    categoricas[cont]<-names[i]
    cont=cont+1
  }
}

# Nombre exacto de tu columna target y vector de variables categóricas
target <- "target"                # ej.: "Target" con niveles "diseased"/"healthy"

# (Opcional) ordena los niveles del target
imp_df[[target]] <- factor(imp_df[[target]], levels = c("diseased","healthy"))

# Layout para varios gráficos

for (var in categoricas) {
  # Filas = target (diseased/healthy), Columnas = CATEGORÍAS
  conteos <- table(imp_df[[target]], imp_df[[var]], useNA = "ifany")

  barplot(conteos,
          beside = TRUE,                 # barras lado a lado por categoría
          col = c("tomato", "skyblue"),
          main = paste(var, "vs", target),
          ylab = "Frecuencia",
          xlab = "",
          las = 2,                       # gira etiquetas del eje X
          cex.names = 0.85,              # tamaño de etiquetas
          legend = TRUE)                 # usa los nombres de filas (target)
}

Al estar las clases desbalanceadas en la variable objetivo, se ve como en cada gráfica predominan los registros de los usuarios sanos. Además, podemos darnos cuenta de que no existe una diferencia tan marcada en el número de registros por categoría dependiendo de si estas enfermo o no, lo cual puede representar un problema a la hora de predecir la variable objetivo.

Análisis multivariado

Veamos ahora la matriz de correlación para las variables numéricas, con el fin de verificar si existen relaciones entre ellas.

df_num <- imp_df[sapply(imp_df, is.numeric)]
mat_cor <- cor(df_num, use = "pairwise.complete.obs")
ggcorrplot(mat_cor,
           method = "square",    
           type = "lower",       
           lab = TRUE,           
           lab_size = 2.5,
           colors = c("blue", "white", "red"),
           title = "Mapa de Correlación de Variables Numéricas",
           tl.cex = 10,
           tl.srt = 45)

Por la cantidad de variables, no se logra apreciar bien la matriz, por lo que decidimos hacerla en python con la librería seaborn y este fue el resultado

Podemos ver que las variables numéricas practicamente no tienen ninguna relación entre sí, lo cual evita problemas de multicolinealidad más adelante.

Conclusiones

Con este EDA aprendimos la importancia de realizarlo correctamente, ya que con este nos damos cuenta de cosas como los datos faltantes, los valores atípicos y datos mal registrados. A su vez pudimos ver el claro desbalance en la variable objetivo, cosa la cual debe ser tratada con cuidado, y que las variables numéricas no estan correlacionadas, cosa evitaría eliminar variables que estén correlacionadas entre sí.

Análisis exploratorio de datos del proyecto final

Hector Sanjuan y Miguel Lugo

2025-08-14

Importación de la base de datos

Análisis numérico y de datos faltantes

Tratamiento de datos faltantes

Imputación de variables numéricas

`blood_pressure`:

`heart_rate`:

`insulin`:

`daily_steps`:

`income`:

`sugar_intake:`

`daily_supplement_dosage`:

Variable categórica

alcohol_consumption

Valores atípicos

Análisis exploratorio de datos (EDA)

Análisis univariado

Análisis bivariado

Análisis multivariado

Conclusiones

Análisis exploratorio de datos del proyecto final

Hector Sanjuan y Miguel Lugo

2025-08-14

Importación de la base de datos

Análisis numérico y de datos faltantes

Tratamiento de datos faltantes

Imputación de variables numéricas

blood_pressure:

heart_rate:

insulin:

daily_steps:

income:

sugar_intake:

daily_supplement_dosage:

Variable categórica

alcohol_consumption

Valores atípicos

Análisis exploratorio de datos (EDA)

Análisis univariado

Análisis bivariado

Análisis multivariado

Conclusiones

`blood_pressure`:

`heart_rate`:

`insulin`:

`daily_steps`:

`income`:

`sugar_intake:`

`daily_supplement_dosage`: