Realizar la exploración del dataset de los niveles de obesidad, para conocer las características de sus datos y las relaciones, e identificar cuáles son los hábitos alimentarios y el nivel de actividad física que tienen influencia con el sobrepeso y la obesidad, para que los profesionales de nutrición puedan realizar sus tratamientos preventivos.
Dado el dataset en: https://archive.ics.uci.edu/ml/datasets/Estimation+of+obesity+levels+based+on+eating+habits+and+physical+condition Comprenda las variables, y sus tipos de datos y use RStudio para carga, limpieza y análisis de datos.
Detalle y responda a los siguientes acpectos como parte de su
análisis:
1. Carga el dataset como dataframe y se muestra sus primeras filas, su
resumen estadístico y la estructura de sus columnas.
2. Cambia la columna NObeyesdad a factor.
3. Devuelve el mínimo, promedio y máximo de cada NObeyesdad.
4. Muestra Diagrama de pastel por Nivel de obesidad.
5. Devuelve promedio de variable de Hábitos alimentarios.
6. Devuelve promedio de variable de actividad física”.
7. Muestre el sumatorio de la variable peso para todos los Niveles de
obesidad.
8. Muestre un diagrama de dispersión entre altura y peso, además muestre
su recta de ajuste.
- 9. Diagrama de densidad de género.
#Instalar las librerias necesarias
options(repos = c(CRAN = "https://cloud.r-project.org/"))
install.packages("dplyr")
## Installing package into 'C:/Users/Usuario/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'dplyr' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\Usuario\AppData\Local\Temp\RtmpIfMa9w\downloaded_packages
#Cargar las librerias necesarias
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## 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
#Cargar el dataset como dataframe
bd <- read.csv("C:/Users/Usuario/Pictures/datos.csv", header = TRUE, sep = ",")
#Mostrar las primeras 10 filas
head(bd,10)
## Gender Age Height Weight family_history_with_overweight FAVC FCVC NCP
## 1 Female 21 1.62 64.0 yes no 2 3
## 2 Female 21 1.52 56.0 yes no 3 3
## 3 Male 23 1.80 77.0 yes no 2 3
## 4 Male 27 1.80 87.0 no no 3 3
## 5 Male 22 1.78 89.8 no no 2 1
## 6 Male 29 1.62 53.0 no yes 2 3
## 7 Female 23 1.50 55.0 yes yes 3 3
## 8 Male 22 1.64 53.0 no no 2 3
## 9 Male 24 1.78 64.0 yes yes 3 3
## 10 Male 22 1.72 68.0 yes yes 2 3
## CAEC SMOKE CH2O SCC FAF TUE CALC MTRANS
## 1 Sometimes no 2 no 0 1 no Public_Transportation
## 2 Sometimes yes 3 yes 3 0 Sometimes Public_Transportation
## 3 Sometimes no 2 no 2 1 Frequently Public_Transportation
## 4 Sometimes no 2 no 2 0 Frequently Walking
## 5 Sometimes no 2 no 0 0 Sometimes Public_Transportation
## 6 Sometimes no 2 no 0 0 Sometimes Automobile
## 7 Sometimes no 2 no 1 0 Sometimes Motorbike
## 8 Sometimes no 2 no 3 0 Sometimes Public_Transportation
## 9 Sometimes no 2 no 1 1 Frequently Public_Transportation
## 10 Sometimes no 2 no 1 1 no Public_Transportation
## NObeyesdad
## 1 Normal_Weight
## 2 Normal_Weight
## 3 Normal_Weight
## 4 Overweight_Level_I
## 5 Overweight_Level_II
## 6 Normal_Weight
## 7 Normal_Weight
## 8 Normal_Weight
## 9 Normal_Weight
## 10 Normal_Weight
#Mostrar el resumen estadìstico
summary(bd)
## Gender Age Height Weight
## Length:2111 Min. :14.00 Min. :1.450 Min. : 39.00
## Class :character 1st Qu.:19.95 1st Qu.:1.630 1st Qu.: 65.47
## Mode :character Median :22.78 Median :1.700 Median : 83.00
## Mean :24.31 Mean :1.702 Mean : 86.59
## 3rd Qu.:26.00 3rd Qu.:1.768 3rd Qu.:107.43
## Max. :61.00 Max. :1.980 Max. :173.00
## family_history_with_overweight FAVC FCVC
## Length:2111 Length:2111 Min. :1.000
## Class :character Class :character 1st Qu.:2.000
## Mode :character Mode :character Median :2.386
## Mean :2.419
## 3rd Qu.:3.000
## Max. :3.000
## NCP CAEC SMOKE CH2O
## Min. :1.000 Length:2111 Length:2111 Min. :1.000
## 1st Qu.:2.659 Class :character Class :character 1st Qu.:1.585
## Median :3.000 Mode :character Mode :character Median :2.000
## Mean :2.686 Mean :2.008
## 3rd Qu.:3.000 3rd Qu.:2.477
## Max. :4.000 Max. :3.000
## SCC FAF TUE CALC
## Length:2111 Min. :0.0000 Min. :0.0000 Length:2111
## Class :character 1st Qu.:0.1245 1st Qu.:0.0000 Class :character
## Mode :character Median :1.0000 Median :0.6253 Mode :character
## Mean :1.0103 Mean :0.6579
## 3rd Qu.:1.6667 3rd Qu.:1.0000
## Max. :3.0000 Max. :2.0000
## MTRANS NObeyesdad
## Length:2111 Length:2111
## Class :character Class :character
## Mode :character Mode :character
##
##
##
Luego de visualizar que no existen valores faltantes en los datos se procede a continuar con el análisis.
#Visualizar la estructura de las columnas
str(bd)
## 'data.frame': 2111 obs. of 17 variables:
## $ Gender : chr "Female" "Female" "Male" "Male" ...
## $ Age : num 21 21 23 27 22 29 23 22 24 22 ...
## $ Height : num 1.62 1.52 1.8 1.8 1.78 1.62 1.5 1.64 1.78 1.72 ...
## $ Weight : num 64 56 77 87 89.8 53 55 53 64 68 ...
## $ family_history_with_overweight: chr "yes" "yes" "yes" "no" ...
## $ FAVC : chr "no" "no" "no" "no" ...
## $ FCVC : num 2 3 2 3 2 2 3 2 3 2 ...
## $ NCP : num 3 3 3 3 1 3 3 3 3 3 ...
## $ CAEC : chr "Sometimes" "Sometimes" "Sometimes" "Sometimes" ...
## $ SMOKE : chr "no" "yes" "no" "no" ...
## $ CH2O : num 2 3 2 2 2 2 2 2 2 2 ...
## $ SCC : chr "no" "yes" "no" "no" ...
## $ FAF : num 0 3 2 2 0 0 1 3 1 1 ...
## $ TUE : num 1 0 1 0 0 0 0 0 1 1 ...
## $ CALC : chr "no" "Sometimes" "Frequently" "Frequently" ...
## $ MTRANS : chr "Public_Transportation" "Public_Transportation" "Public_Transportation" "Walking" ...
## $ NObeyesdad : chr "Normal_Weight" "Normal_Weight" "Normal_Weight" "Overweight_Level_I" ...
bd$NObeyesdad=as.factor(bd$NObeyesdad)
str(bd$NObeyesdad)
## Factor w/ 7 levels "Insufficient_Weight",..: 2 2 2 6 7 2 2 2 2 2 ...
resultados <- bd %>%
group_by(NObeyesdad) %>%
summarise(across(where(is.numeric),
list(Mínimo = min, Promedio = mean, Máximo = max)))
print(resultados)
## # A tibble: 7 × 25
## NObeyesdad Age_Mínimo Age_Promedio Age_Máximo Height_Mínimo Height_Promedio
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Insufficient… 16 19.8 39 1.52 1.69
## 2 Normal_Weight 14 21.7 61 1.5 1.68
## 3 Obesity_Type… 15 25.9 52 1.5 1.69
## 4 Obesity_Type… 20 28.2 41 1.6 1.77
## 5 Obesity_Type… 18 23.5 26 1.56 1.69
## 6 Overweight_L… 16 23.4 55 1.45 1.69
## 7 Overweight_L… 17 27.0 56 1.48 1.70
## # ℹ 19 more variables: Height_Máximo <dbl>, Weight_Mínimo <dbl>,
## # Weight_Promedio <dbl>, Weight_Máximo <dbl>, FCVC_Mínimo <dbl>,
## # FCVC_Promedio <dbl>, FCVC_Máximo <dbl>, NCP_Mínimo <dbl>,
## # NCP_Promedio <dbl>, NCP_Máximo <dbl>, CH2O_Mínimo <dbl>,
## # CH2O_Promedio <dbl>, CH2O_Máximo <dbl>, FAF_Mínimo <dbl>,
## # FAF_Promedio <dbl>, FAF_Máximo <dbl>, TUE_Mínimo <dbl>, TUE_Promedio <dbl>,
## # TUE_Máximo <dbl>
obesidad_cnts <- table(bd$NObeyesdad)
pie(obesidad_cnts,
main = "Distribución por Nivel de Obesidad",
col = rainbow(length(obesidad_cnts)),
labels = paste(names(obesidad_cnts), round(100*obesidad_cnts/sum(obesidad_cnts), 1), "%"))
bd$FAVC_num <- ifelse(bd$FAVC == "yes", 1, 0)
bd$CAEC_num <- as.numeric(factor(bd$CAEC, levels = c("Always", "Sometimes", "Frequently","no")))
bd$SMOKE_num <- ifelse(bd$SMOKE == "yes", 1, 0)
bd$CALC_num <- as.numeric(factor(bd$CALC, levels = c("Always", "Sometimes", "Frequently","no")))
bd$SCC_num <- ifelse(bd$SCC == "yes", 1, 0)
promedios_habitos <- bd %>%
summarise(
Promedio_FAVC = mean(FAVC_num, na.rm = TRUE),
Promedio_FCVC = mean(FCVC, na.rm = TRUE),
Promedio_NCP = mean(NCP, na.rm = TRUE),
Promedio_CAEC = mean(CAEC_num, na.rm = TRUE),
Promedio_SMOKE = mean(SMOKE_num, na.rm = TRUE),
Promedio_CH2O = mean(CH2O, na.rm = TRUE),
Promedio_SCC = mean(SCC_num, na.rm = TRUE),
Promedio_CALC = mean(CALC_num, na.rm = TRUE),
)
print(promedios_habitos)
## Promedio_FAVC Promedio_FCVC Promedio_NCP Promedio_CAEC Promedio_SMOKE
## 1 0.8839413 2.419043 2.685628 2.137849 0.0208432
## Promedio_CH2O Promedio_SCC Promedio_CALC
## 1 2.008011 0.04547608 2.638086
bd$MTRANS_num <- as.numeric(factor(bd$MTRANS, levels = c("Public_Transportation", "Automobile", "Motorbike","Bike","Walking")))
promedios_habitosf <- bd %>%
summarise(
Promedio_FAF = mean(FAF, na.rm = TRUE),
Promedio_TUE = mean(TUE, na.rm = TRUE),
Promedio_MTRANS = mean(MTRANS_num, na.rm = TRUE),
)
print(promedios_habitosf)
## Promedio_FAF Promedio_TUE Promedio_MTRANS
## 1 1.010298 0.6578659 1.342965
sumatorio_peso <- bd %>%
group_by(NObeyesdad) %>%
summarise(Sumatorio_Peso = sum(Weight, na.rm = TRUE))
print(sumatorio_peso)
## # A tibble: 7 × 2
## NObeyesdad Sumatorio_Peso
## <fct> <dbl>
## 1 Insufficient_Weight 13575.
## 2 Normal_Weight 17838.
## 3 Obesity_Type_I 32597.
## 4 Obesity_Type_II 34246.
## 5 Obesity_Type_III 39185.
## 6 Overweight_Level_I 21537.
## 7 Overweight_Level_II 23805.
plot(bd$Height, bd$Weight,
main = "Diagrama de dispersión entre altura y peso",
xlab = "Altura (cm)",
ylab = "Peso (kg)",
pch = 19,
col = "blue")
# Ajustar la recta de regresión lineal
modelo <- lm(Weight ~ Height, data = bd)
# Agregar la recta de ajuste al gráfico
abline(modelo, col = "red", lwd = 2)
barplot(table(bd$Gender),
main = "Distribución por género",
xlab = "Género",
ylab = "Frecuencia",
col = "lightblue",
las = 1)