Trabajo Final
Bárbara Santana Rodríguez, Fernanda Pérez, Vanessa Moreta, Alberto Sandoval
2023-12-20
library(ggplot2)
library(readxl)
library(readr)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(rpart)
library(ROSE)## Warning: package 'ROSE' was built under R version 4.3.2## Loaded ROSE 0.0-4library(caret)## Warning: package 'caret' was built under R version 4.3.2## Loading required package: latticelibrary(mltools)## Warning: package 'mltools' was built under R version 4.3.2library(e1071)## Warning: package 'e1071' was built under R version 4.3.2##
## Attaching package: 'e1071'## The following object is masked from 'package:mltools':
##
## skewnesssetwd("~/01_Master-BigData/A03_Tec-AnalisisDatos/00_TrabajoFinal")1. Análisis exploratorio
Carga de datos
obesidad = read.csv("ObesityDataSet_raw_and_data_sinthetic.csv")
#obesidad <- read.csv('ObesityDataSet_raw_and_data_sinthetic.csv')
head(obesidad)## 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
## 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
## NObeyesdad
## 1 Normal_Weight
## 2 Normal_Weight
## 3 Normal_Weight
## 4 Overweight_Level_I
## 5 Overweight_Level_II
## 6 Normal_WeightDetalle de la base de datos
Esta base de datos contiene datos para la estimación de los niveles de obesidad en personas de los países de México, Perú y Colombia, con edades entre 14 y 61 años y diversos hábitos alimenticios y condición física.
Las variables incluidas de origen son:
Atributos relacionados con los hábitos alimenticios
- FAVC: Consumo frecuente de alimentos altamente calóricos
- FCVC: Frecuencia de consumo de verduras
- NCP: Número de comidas principales
- CAEC: Consumo de alimentos entre comidas
- CH20: Consumo diario de agua
- CALC: Consumo de alcohol
Atributos relacionados con la condición física
- SCC: Monitoreo del consumo de calorías
- FAF: Frecuencia de actividad física
- TUE: Tiempo de uso de dispositivos tecnológicos
- MTRANS: Transporte utilizado
Otras variables
- Género
- Edad
- Altura
- Peso
Variable de clase
- NObeyesdad: Insuficiencia de peso, Peso normal, Sobrepeso Nivel I, Sobrepeso Nivel II, Obesidad Tipo I, Obesidad Tipo II y Obesidad Tipo III
Por nuestra parte hemos usado la ecuación del Índice de Masa Corporal para incluir la variable IMC en la columna obesidad_imc, ya que consideramos que nos ayudará a la construcción del modelo requerido.
summary(obesidad)## 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
##
##
## Verificación de datos faltantes
colSums(is.na(obesidad))## Gender Age
## 0 0
## Height Weight
## 0 0
## family_history_with_overweight FAVC
## 0 0
## FCVC NCP
## 0 0
## CAEC SMOKE
## 0 0
## CH2O SCC
## 0 0
## FAF TUE
## 0 0
## CALC MTRANS
## 0 0
## NObeyesdad
## 0colSums(obesidad=="")## Gender Age
## 0 0
## Height Weight
## 0 0
## family_history_with_overweight FAVC
## 0 0
## FCVC NCP
## 0 0
## CAEC SMOKE
## 0 0
## CH2O SCC
## 0 0
## FAF TUE
## 0 0
## CALC MTRANS
## 0 0
## NObeyesdad
## 0La base de datos no presenta faltantes.
Observación de variables de interés
Observamos que tan solo el 2,08% de la poblacion que conforma la muestra es fumadora, por lo que, más adelante en el análisis, se deberá proceder a técnicas de oversampling que permitan ampliar el número de registros de las personas que fuman a través de métodos estadisticos.
Sucederá lo mismo con la población que cuenta las calorías, ya que tan solo un 4,54% de la muestra declara contarlas.
# Calcular las frecuencias de 'si' y 'no'
frecuencias_fuma <- table(obesidad$SMOKE)
print(frecuencias_fuma)##
## no yes
## 2067 44# Calcular los porcentajes
porcentajes_fuma <- prop.table(frecuencias_fuma) * 100
print(porcentajes_fuma)##
## no yes
## 97.91568 2.08432# Crear un gráfico de barras
barplot(porcentajes_fuma, main = "% de personas que fuman",
names.arg = c("No", "Sí"),
ylab = "Porcentaje",
col = c("red", "green"))
# Calcular las frecuencias de 'si' y 'no'
frecuencias_calorias <- table(obesidad$SCC)
print(frecuencias_calorias)##
## no yes
## 2015 96# Calcular los porcentajes
porcentajes_calorias <- prop.table(frecuencias_calorias) * 100
print(porcentajes_calorias)##
## no yes
## 95.452392 4.547608# Crear un gráfico de barras
barplot(porcentajes_calorias, main = "% de personas que cuentan calorias",
names.arg = c("No", "Sí"),
ylab = "Porcentaje",
col = c("red", "green"))
Nueva variable: IMC
Dado que contamos con datos de altura y peso, crearemos una nueva variable para conocer el IMC de cada una de las personas que componen la muestra por si puede ser de interés en algunos de los puntos.
# Crear una nueva columna 'IMC'
obesidad$IMC <- obesidad$Weight / ((obesidad$Height)^2)Transformaciones, escalado y normalización
Dado que se trata de una base de datos relacionada con la obesidad y tenemos a mano el peso y la altura, crearemos la variable IMC (Índice de Masa Corporal), para apoyar nuestro modelo.
Variables numéricas
Observamos que las variables como ‘Age’, ‘Height’, ‘Weight’, ‘NCP’, ‘TUE’, ‘CH2O’ y ‘IMC’ tienen escalas numéricas diferentes. Esta diferencia de escalas puede influir en el modelo de aprendizaje automático, dando más peso a las variables con valores más grandes.
Variables categóricas
La base de datos también contiene variables categóricas como ‘Gender’, ‘family_history_with_overweight’, ‘FAVC’, ‘FCVC’, ‘CAEC’, ‘SMOKE’, ‘SCC’, ‘FAF’, ‘MTRANS’, y ‘NObeyesdad’. Estas variables no tienen un orden natural, por lo que el modelo de aprendizaje automático no las interpretará correctamente sin una transformación adecuada.
Al escalar y normalizar las variables pretendemos:
- Mejorar la precisión del modelo: Al tener todas las variables en una escala similar, el modelo puede ajustar mejor los pesos de cada variable y obtener una predicción más precisa.
- Evitar el sesgo: Las variables con escalas más grandes no tendrán un peso desproporcionado en el modelo.
- Facilitar la comparación de variables: Permite comparar el impacto de diferentes variables en el modelo, independientemente de su escala original.
2. Modelos predictivos
Antes de comenzar con los modelos predictivos es necesario preparar nuestra base de datos.
Las variables que son categorias ordinales se transforman a dicotómicas (0/1) para poder tratarlas en nuestro análisis. Sin embargo, podría ser interesante pasar a numericas las variables categóricas nominales, como son las relacionadas con la frecuencia o el grado de obesidad, ya que claramente se puede observar un orden entre cada categoria y va de menos a más.
Factores
obesidad$Gender =factor(obesidad$Gender)
obesidad$family_history_with_overweight=factor(obesidad$family_history_with_overweight)
obesidad$FAVC=factor(obesidad$FAVC)
obesidad$SMOKE=factor(obesidad$SMOKE)
obesidad$SCC=factor(obesidad$SCC)
obesidad$MTRANS=factor(obesidad$MTRANS)Escalado
library("scales")##
## Attaching package: 'scales'## The following object is masked from 'package:readr':
##
## col_factor"Escalado Age"## [1] "Escalado Age"obesidad$Age <- rescale(obesidad$Age)
"Escalado Height"## [1] "Escalado Height"obesidad$Height <- rescale(obesidad$Height)
"Escalado Weight"## [1] "Escalado Weight"obesidad$Weight <- rescale(obesidad$Weight)
"Escalado NCP"## [1] "Escalado NCP"obesidad$NCP <- rescale(obesidad$NCP)
"Escalado TUE"## [1] "Escalado TUE"obesidad$TUE <- rescale(obesidad$TUE)
"Escalado CH2O"## [1] "Escalado CH2O"obesidad$CH2O <- rescale(obesidad$CH2O)
"Escalado obesidad_imc"## [1] "Escalado obesidad_imc"obesidad$IMC <- (rescale(obesidad$obesidad_imc))Una vez tenemos transformadas nuestras variables procedemos a realizar one hot encoding para realizar esa transformación a dictomicas.
library(mltools)
library(data.table)##
## Attaching package: 'data.table'## The following objects are masked from 'package:dplyr':
##
## between, first, last#Creamos una nueva base de datos con las variables recodificadas en dictotómicas (0/1) para conservar la base original.
obesidad_cod <- one_hot(as.data.table(obesidad))Lo que ahora debemos hacer es recodificar las categoricas que no pasamos a factor a valor numerico, como comentamos anteriormente.
# Codificamos
obesidad_cod$CAEC <- ifelse(obesidad_cod$CAEC == "no", 1,
ifelse(obesidad_cod$CAEC == "Sometimes", 2,
ifelse(obesidad_cod$CAEC == "Frequently", 3,
ifelse(obesidad_cod$CAEC == "Always", 4, NA))))#Codificamos
obesidad_cod$CALC <- ifelse(obesidad_cod$CALC == "no", 1,
ifelse(obesidad_cod$CALC == "Sometimes", 2,
ifelse(obesidad_cod$CALC == "Frequently", 3,
ifelse(obesidad_cod$CALC == "Always", 4, NA))))str(obesidad_cod)## Classes 'data.table' and 'data.frame': 2111 obs. of 26 variables:
## $ Gender_Female : int 1 1 0 0 0 0 1 0 0 0 ...
## $ Gender_Male : int 0 0 1 1 1 1 0 1 1 1 ...
## $ Age : num 0.149 0.149 0.191 0.277 0.17 ...
## $ Height : num 0.321 0.132 0.66 0.66 0.623 ...
## $ Weight : num 0.187 0.127 0.284 0.358 0.379 ...
## $ family_history_with_overweight_no : int 0 0 0 1 1 1 0 1 0 0 ...
## $ family_history_with_overweight_yes: int 1 1 1 0 0 0 1 0 1 1 ...
## $ FAVC_no : int 1 1 1 1 1 0 0 1 0 0 ...
## $ FAVC_yes : int 0 0 0 0 0 1 1 0 1 1 ...
## $ FCVC : num 2 3 2 3 2 2 3 2 3 2 ...
## $ NCP : num 0.667 0.667 0.667 0.667 0 ...
## $ CAEC : num 2 2 2 2 2 2 2 2 2 2 ...
## $ SMOKE_no : int 1 0 1 1 1 1 1 1 1 1 ...
## $ SMOKE_yes : int 0 1 0 0 0 0 0 0 0 0 ...
## $ CH2O : num 0.5 1 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...
## $ SCC_no : int 1 0 1 1 1 1 1 1 1 1 ...
## $ SCC_yes : int 0 1 0 0 0 0 0 0 0 0 ...
## $ FAF : num 0 3 2 2 0 0 1 3 1 1 ...
## $ TUE : num 0.5 0 0.5 0 0 0 0 0 0.5 0.5 ...
## $ CALC : num 1 2 3 3 2 2 2 2 3 1 ...
## $ MTRANS_Automobile : int 0 0 0 0 0 1 0 0 0 0 ...
## $ MTRANS_Bike : int 0 0 0 0 0 0 0 0 0 0 ...
## $ MTRANS_Motorbike : int 0 0 0 0 0 0 1 0 0 0 ...
## $ MTRANS_Public_Transportation : int 1 1 1 0 1 0 0 1 1 1 ...
## $ MTRANS_Walking : int 0 0 0 1 0 0 0 0 0 0 ...
## $ NObeyesdad : chr "Normal_Weight" "Normal_Weight" "Normal_Weight" "Overweight_Level_I" ...
## - attr(*, ".internal.selfref")=<externalptr>unique(obesidad_cod$NObeyesdad)## [1] "Normal_Weight" "Overweight_Level_I" "Overweight_Level_II"
## [4] "Obesity_Type_I" "Insufficient_Weight" "Obesity_Type_II"
## [7] "Obesity_Type_III"#Codificamos
obesidad_cod$NObeyesdad <- ifelse(obesidad_cod$NObeyesdad == "Insufficient_Weight", 1,
ifelse(obesidad_cod$NObeyesdad == "Normal_Weight", 2,
ifelse(obesidad_cod$NObeyesdad == "Overweight_Level_I", 3,
ifelse(obesidad_cod$NObeyesdad == "Overweight_Level_II", 4,
ifelse(obesidad_cod$NObeyesdad == "Obesity_Type_I", 5,
ifelse(obesidad_cod$NObeyesdad == "Obesity_Type_II", 6,
ifelse(obesidad_cod$NObeyesdad == "Obesity_Type_III", 7,NA)))))))2.1 Modelo que detecte si un usuario es fumador o no.
Oversampling en función de los usuarios que sí fuman
# Aplicar la transformación a factores a todas las variables en obesidad_cod
obesidad_cod <- data.frame(lapply(obesidad_cod, as.factor))
str(obesidad_cod)## 'data.frame': 2111 obs. of 26 variables:
## $ Gender_Female : Factor w/ 2 levels "0","1": 2 2 1 1 1 1 2 1 1 1 ...
## $ Gender_Male : Factor w/ 2 levels "0","1": 1 1 2 2 2 2 1 2 2 2 ...
## $ Age : Factor w/ 1402 levels "0","0.0212765957446809",..: 405 405 702 1022 579 1062 702 579 777 579 ...
## $ Height : Factor w/ 1574 levels "0","0.0119735849056603",..: 296 29 1307 1307 1203 296 10 408 1203 839 ...
## $ Weight : Factor w/ 1525 levels "0","0.00075973880597014",..: 246 174 383 644 693 142 160 142 246 288 ...
## $ family_history_with_overweight_no : Factor w/ 2 levels "0","1": 1 1 1 2 2 2 1 2 1 1 ...
## $ family_history_with_overweight_yes: Factor w/ 2 levels "0","1": 2 2 2 1 1 1 2 1 2 2 ...
## $ FAVC_no : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 2 1 1 ...
## $ FAVC_yes : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 2 1 2 2 ...
## $ FCVC : Factor w/ 810 levels "1","1.003566",..: 171 810 171 810 171 171 810 171 810 171 ...
## $ NCP : Factor w/ 635 levels "0","9.43333333333444e-05",..: 478 478 478 478 1 478 478 478 478 478 ...
## $ CAEC : Factor w/ 4 levels "1","2","3","4": 2 2 2 2 2 2 2 2 2 2 ...
## $ SMOKE_no : Factor w/ 2 levels "0","1": 2 1 2 2 2 2 2 2 2 2 ...
## $ SMOKE_yes : Factor w/ 2 levels "0","1": 1 2 1 1 1 1 1 1 1 1 ...
## $ CH2O : Factor w/ 1268 levels "0","0.000231500000000051",..: 550 1268 550 550 550 550 550 550 550 550 ...
## $ SCC_no : Factor w/ 2 levels "0","1": 2 1 2 2 2 2 2 2 2 2 ...
## $ SCC_yes : Factor w/ 2 levels "0","1": 1 2 1 1 1 1 1 1 1 1 ...
## $ FAF : Factor w/ 1190 levels "0","9.6e-05",..: 1 1190 1072 1072 1 1 590 1190 590 590 ...
## $ TUE : Factor w/ 1129 levels "0","3.65e-05",..: 841 1 841 1 1 1 1 1 841 841 ...
## $ CALC : Factor w/ 4 levels "1","2","3","4": 1 2 3 3 2 2 2 2 3 1 ...
## $ MTRANS_Automobile : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 1 ...
## $ MTRANS_Bike : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ MTRANS_Motorbike : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 1 ...
## $ MTRANS_Public_Transportation : Factor w/ 2 levels "0","1": 2 2 2 1 2 1 1 2 2 2 ...
## $ MTRANS_Walking : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 1 1 1 1 ...
## $ NObeyesdad : Factor w/ 7 levels "1","2","3","4",..: 2 2 2 3 4 2 2 2 2 2 ...#install.packages("ROSE")
# Carga el paquete
library(ROSE)
library(caret)
# Aplica SMOTE para el sobremuestreo
obesidad_over <- ROSE(SMOKE_yes ~ ., data = obesidad_cod, seed = 100, p = 0.3)$dataSplit de base de datos: train y test
# Fijar semilla para reproducibilidad
set.seed(100)
# Crear un índice para la división de datos
index <- createDataPartition(obesidad_over$SMOKE_yes, p = 0.7, list = FALSE, times = 1)
# Crear conjuntos de entrenamiento y prueba
obesidad_over_train <- obesidad_over[index, ]
obesidad_over_test <- obesidad_over[-index, ]# Fijar semilla para reproducibilidad
set.seed(100)
# Crear un índice para la división de datos
index <- createDataPartition(obesidad_cod$SMOKE_yes, p = 0.7, list = FALSE, times = 1)
# Crear conjuntos de entrenamiento y prueba
obesidad_train <- obesidad_over[index, ]
obesidad_test <- obesidad_over[-index, ]Modelo de regresión logistica con el dataset de entrenamiento
# Convertir variables a numéricas o enteras según la estructura actual
obesidad_over_train$Age <- as.numeric(obesidad_over_train$Age)
obesidad_over_train$Height <- as.numeric(obesidad_over_train$Height)
obesidad_over_train$Weight <- as.numeric(obesidad_over_train$Weight)
obesidad_over_train$FCVC <- as.numeric(obesidad_over_train$FCVC)
obesidad_over_train$NCP <- as.numeric(obesidad_over_train$NCP)
obesidad_over_train$CH2O <- as.numeric(obesidad_over_train$CH2O)
obesidad_over_train$FAF <- as.numeric(obesidad_over_train$FAF)
obesidad_over_train$TUE <- as.numeric(obesidad_over_train$TUE)
obesidad_over_train$CALC <- as.numeric(obesidad_over_train$CALC)
#y para el test
obesidad_over_test$Age <- as.numeric(obesidad_over_test$Age)
obesidad_over_test$Height <- as.numeric(obesidad_over_test$Height)
obesidad_over_test$Weight <- as.numeric(obesidad_over_test$Weight)
obesidad_over_test$FCVC <- as.numeric(obesidad_over_test$FCVC)
obesidad_over_test$NCP <- as.numeric(obesidad_over_test$NCP)
obesidad_over_test$CH2O <- as.numeric(obesidad_over_test$CH2O)
obesidad_over_test$FAF <- as.numeric(obesidad_over_test$FAF)
obesidad_over_test$TUE <- as.numeric(obesidad_over_test$TUE)
obesidad_over_test$CALC <- as.numeric(obesidad_over_test$CALC)
# Verifica la estructura actualizada
str(obesidad_over_train)## 'data.frame': 1479 obs. of 26 variables:
## $ Gender_Female : Factor w/ 2 levels "0","1": 2 2 1 1 1 1 1 2 2 2 ...
## $ Gender_Male : Factor w/ 2 levels "0","1": 1 1 2 2 2 2 2 1 1 1 ...
## $ Age : num 345 674 1394 685 76 ...
## $ Height : num 44 315 956 1386 705 ...
## $ Weight : num 8 512 520 735 91 ...
## $ family_history_with_overweight_no : Factor w/ 2 levels "0","1": 2 1 1 1 2 1 1 1 2 1 ...
## $ family_history_with_overweight_yes: Factor w/ 2 levels "0","1": 1 2 2 2 1 2 2 2 1 2 ...
## $ FAVC_no : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 1 ...
## $ FAVC_yes : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 2 2 2 2 ...
## $ FCVC : num 584 109 171 133 1 810 171 810 2 171 ...
## $ NCP : num 402 1 478 70 478 1 478 478 517 302 ...
## $ CAEC : Factor w/ 4 levels "1","2","3","4": 2 2 2 2 3 3 2 2 3 2 ...
## $ SMOKE_no : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
## $ SMOKE_yes : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ CH2O : num 247 550 409 550 1 ...
## $ SCC_no : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
## $ SCC_yes : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ FAF : num 127 1 536 1 1072 ...
## $ TUE : num 257 241 1 1008 841 ...
## $ CALC : num 2 1 1 2 2 3 1 2 2 2 ...
## $ MTRANS_Automobile : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 1 1 1 2 ...
## $ MTRANS_Bike : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ MTRANS_Motorbike : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ MTRANS_Public_Transportation : Factor w/ 2 levels "0","1": 2 2 1 2 2 2 2 2 2 1 ...
## $ MTRANS_Walking : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ NObeyesdad : Factor w/ 7 levels "1","2","3","4",..: 1 5 4 4 1 2 5 7 1 5 ...# Ahora, ajustamos tel modelo con la nueva base de datos balanceada (obesidad_over)
modelo_rl_over <- glm(SMOKE_yes ~ FAVC_yes + FCVC + NCP + CAEC + CH2O + SCC_yes + FAVC_yes + TUE + CALC + MTRANS_Public_Transportation + MTRANS_Motorbike + MTRANS_Bike + MTRANS_Walking + family_history_with_overweight_yes + Age + NObeyesdad + Gender_Male + Gender_Female, family = "binomial"(link='logit'), data = obesidad_over_train)
# Muestra un resumen del modelo
summary(modelo_rl_over)##
## Call:
## glm(formula = SMOKE_yes ~ FAVC_yes + FCVC + NCP + CAEC + CH2O +
## SCC_yes + FAVC_yes + TUE + CALC + MTRANS_Public_Transportation +
## MTRANS_Motorbike + MTRANS_Bike + MTRANS_Walking + family_history_with_overweight_yes +
## Age + NObeyesdad + Gender_Male + Gender_Female, family = binomial(link = "logit"),
## data = obesidad_over_train)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -6.954e+00 9.845e-01 -7.064 1.62e-12 ***
## FAVC_yes1 -1.304e+00 2.206e-01 -5.909 3.45e-09 ***
## FCVC 8.215e-04 3.014e-04 2.725 0.006421 **
## NCP -4.114e-05 4.554e-04 -0.090 0.928010
## CAEC2 -2.636e-01 7.887e-01 -0.334 0.738228
## CAEC3 1.124e+00 8.128e-01 1.383 0.166774
## CAEC4 1.333e+00 8.538e-01 1.561 0.118582
## CH2O -8.126e-04 2.013e-04 -4.038 5.40e-05 ***
## SCC_yes1 6.631e-01 3.372e-01 1.966 0.049249 *
## TUE 1.039e-03 1.910e-04 5.438 5.39e-08 ***
## CALC 1.635e+00 1.541e-01 10.615 < 2e-16 ***
## MTRANS_Public_Transportation1 4.943e-01 2.155e-01 2.294 0.021811 *
## MTRANS_Motorbike1 3.776e+00 7.731e-01 4.884 1.04e-06 ***
## MTRANS_Bike1 -8.023e+00 5.354e+02 -0.015 0.988044
## MTRANS_Walking1 1.185e+00 3.979e-01 2.980 0.002887 **
## family_history_with_overweight_yes1 1.643e-01 2.594e-01 0.633 0.526631
## Age 2.550e-03 2.882e-04 8.849 < 2e-16 ***
## NObeyesdad2 2.511e+00 4.006e-01 6.268 3.66e-10 ***
## NObeyesdad3 3.656e-01 4.715e-01 0.775 0.438131
## NObeyesdad4 1.260e+00 4.633e-01 2.720 0.006522 **
## NObeyesdad5 1.575e+00 4.662e-01 3.378 0.000729 ***
## NObeyesdad6 2.422e+00 4.971e-01 4.871 1.11e-06 ***
## NObeyesdad7 -1.204e+00 5.955e-01 -2.022 0.043212 *
## Gender_Male1 -6.989e-01 2.084e-01 -3.353 0.000799 ***
## Gender_Female1 NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1836.9 on 1478 degrees of freedom
## Residual deviance: 1196.0 on 1455 degrees of freedom
## AIC: 1244
##
## Number of Fisher Scoring iterations: 12Hemos bajado el umbral de la predicción a 0,3 ya que el nivel de especificidad era muy bajo, y lo que nos interesa es elevar este parámetro para asegurarnos una mayor adecuación del modelo a la hora de predecir si una persona es fumadora. Aunque esto hace que podamos estar detectando a personas como fumadoras cuando en la realidad no lo son. Sin embargo, consideramos más importante ser estrictos en intentar no perder a ninguna persona fumadora ya que este criterio podría ser relevante, por ejemplo, en sanidad, para campañas de concienciación.
De esta manera, obtenemos un accuracy del 84,3%, es decir, casi un 85% de predicciones correctas.
Vamos a conocer un poco más en detalle que métricas devuelve nuestro modelo:
La sensibilidad es la proporción de verdaderos positivos respecto al total de casos positivos reales. En este caso, el modelo identifica correctamente al 91,5% de las personas no fumadoras.
La especificidad es la proporción de verdaderos negativos respecto al total de casos negativos reales. En este caso, el modelo identifica correctamente al 68,5% de las personas no fumadoras.
Pos pred value representa la proporción de verdaderos positivos respecto al total de predicciones positivas. En este caso, el 86,4% de las personas predichas como fumadoras son realmente fumadoras.
Neg pred value representa la proporción de verdaderos negativos respecto al total de predicciones negativas. En este caso, el 78,4% de las personas predichas como no fumadoras son realmente no fumadoras.
Y finalmente, el balanced Accuracy es la media aritmética de la sensibilidad y la especificidad. Representa un resumen general del rendimiento del modelo, lo que nos da un 79,9%.
pred.train <- predict(modelo_rl_over,obesidad_over_train)## Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == :
## prediction from rank-deficient fit; attr(*, "non-estim") has doubtful casespred.train <- ifelse(pred.train > 0.1,1,0)
# Convertir la variable dependiente a factor con los mismos niveles que la predicción
obesidad_over_train$SMOKE_yes <- factor(obesidad_over_train$SMOKE_yes, levels = levels(factor(pred.train)))
# Matriz de confusión
conf_matrix <- confusionMatrix(factor(pred.train), obesidad_over_train$SMOKE_yes)
print(conf_matrix)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 930 146
## 1 87 316
##
## Accuracy : 0.8425
## 95% CI : (0.8229, 0.8607)
## No Information Rate : 0.6876
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.62
##
## Mcnemar's Test P-Value : 0.0001449
##
## Sensitivity : 0.9145
## Specificity : 0.6840
## Pos Pred Value : 0.8643
## Neg Pred Value : 0.7841
## Prevalence : 0.6876
## Detection Rate : 0.6288
## Detection Prevalence : 0.7275
## Balanced Accuracy : 0.7992
##
## 'Positive' Class : 0
## Y ahora vamos a ponerlo a prueba con el dataset de test (over), para comprobar que los resultados se asemejan a los del train.
Observamos que el nivel de precisión es algo menor, pero que sigue siendo muy elevado (81,5% concretamente). Con un balanced accuracy del 75,5% en el test frente al 79,9% del train. Por lo que seguimos considerando el modelo como óptimo.
# Predicción en la base de datos de prueba
pred.test <- predict(modelo_rl_over, obesidad_over_test)## Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == :
## prediction from rank-deficient fit; attr(*, "non-estim") has doubtful casespred.test <- ifelse(pred.test > 0.1, 1, 0)
# Convertir la variable dependiente a factor con los mismos niveles que la predicción
obesidad_over_test$SMOKE_yes <- factor(obesidad_over_test$SMOKE_yes, levels = levels(factor(pred.test)))
# Matriz de confusión en la base de datos de prueba
conf_matrix_test <- confusionMatrix(factor(pred.test), obesidad_over_test$SMOKE_yes)
print(conf_matrix_test)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 397 79
## 1 38 118
##
## Accuracy : 0.8149
## 95% CI : (0.7824, 0.8444)
## No Information Rate : 0.6883
## P-Value [Acc > NIR] : 4.21e-13
##
## Kappa : 0.5425
##
## Mcnemar's Test P-Value : 0.0002173
##
## Sensitivity : 0.9126
## Specificity : 0.5990
## Pos Pred Value : 0.8340
## Neg Pred Value : 0.7564
## Prevalence : 0.6883
## Detection Rate : 0.6282
## Detection Prevalence : 0.7532
## Balanced Accuracy : 0.7558
##
## 'Positive' Class : 0
## Finalmente, podemos ver la matriz de confusión pintada para el test.
# Crear la matriz de confusión
conf_matrix_df <- as.data.frame(as.table(conf_matrix_test$table))
colnames(conf_matrix_df) <- c("Predicción", "Valor Real", "Conteo")
conf_matrix_df$Predicción <- factor(conf_matrix_df$Predicción, levels = c("0", "1"))
conf_matrix_df$`Valor Real` <- factor(conf_matrix_df$`Valor Real`, levels = c("0", "1"))
# Visualizar la matriz de confusión con ggplot2
ggplot(conf_matrix_df, aes(x = Predicción, y = `Valor Real`, fill = Conteo)) +
geom_tile(color = "white") +
scale_fill_gradient(low = "white", high = "steelblue") +
geom_text(aes(label = Conteo), vjust = 1) +
theme_minimal() +
labs(title = "Matriz de Confusión",
x = "Predicción",
y = "Valor Real")
2.2 Modelo que detecte si un usuario controla o no las calorías.
# Aquí también usamos el paquete ROSE cargada con anticipación, por lo que ya se debe de encontrar instalado y llamado con la función library.
# Aplica SMOTE para el sobremuestreo
obesidad_over <- ROSE(SCC_yes ~ ., data = obesidad_cod, seed = 100, p = 0.5)$data# Fijar semilla para reproducibilidad
set.seed(100)
# Crear un índice para la división de datos
index <- createDataPartition(obesidad_over$SMOKE_yes, p = 0.7, list = FALSE, times = 1)
# Crear conjuntos de entrenamiento y prueba
obesidad_over_train <- obesidad_over[index, ]
obesidad_over_test <- obesidad_over[-index, ]# Fijar semilla para reproducibilidad
set.seed(100)
# Crear un índice para la división de datos
index <- createDataPartition(obesidad_cod$SMOKE_yes, p = 0.7, list = FALSE, times = 1)
# Crear conjuntos de entrenamiento y prueba
obesidad_train <- obesidad_over[index, ]
obesidad_test <- obesidad_over[-index, ]Y ya realizamos el modelo de regresión logistica con el dataset de entrenamiento
# Convertir variables a numéricas o enteras según la estructura actual
obesidad_over_train$Age <- as.numeric(obesidad_over_train$Age)
obesidad_over_train$Height <- as.numeric(obesidad_over_train$Height)
obesidad_over_train$Weight <- as.numeric(obesidad_over_train$Weight)
obesidad_over_train$FCVC <- as.numeric(obesidad_over_train$FCVC)
obesidad_over_train$NCP <- as.numeric(obesidad_over_train$NCP)
obesidad_over_train$CH2O <- as.numeric(obesidad_over_train$CH2O)
obesidad_over_train$FAF <- as.numeric(obesidad_over_train$FAF)
obesidad_over_train$TUE <- as.numeric(obesidad_over_train$TUE)
obesidad_over_train$CALC <- as.numeric(obesidad_over_train$CALC)
#y para el test
obesidad_over_test$Age <- as.numeric(obesidad_over_test$Age)
obesidad_over_test$Height <- as.numeric(obesidad_over_test$Height)
obesidad_over_test$Weight <- as.numeric(obesidad_over_test$Weight)
obesidad_over_test$FCVC <- as.numeric(obesidad_over_test$FCVC)
obesidad_over_test$NCP <- as.numeric(obesidad_over_test$NCP)
obesidad_over_test$CH2O <- as.numeric(obesidad_over_test$CH2O)
obesidad_over_test$FAF <- as.numeric(obesidad_over_test$FAF)
obesidad_over_test$TUE <- as.numeric(obesidad_over_test$TUE)
obesidad_over_test$CALC <- as.numeric(obesidad_over_test$CALC)
# Verifica la estructura actualizada
str(obesidad_over_train)## 'data.frame': 1478 obs. of 26 variables:
## $ Gender_Female : Factor w/ 2 levels "0","1": 1 2 2 2 1 1 1 2 2 2 ...
## $ Gender_Male : Factor w/ 2 levels "0","1": 2 1 1 1 2 2 2 1 1 1 ...
## $ Age : num 910 304 662 486 315 ...
## $ Height : num 1363 480 558 588 467 ...
## $ Weight : num 1007 64 615 1342 183 ...
## $ family_history_with_overweight_no : Factor w/ 2 levels "0","1": 1 2 1 1 2 1 1 1 1 2 ...
## $ family_history_with_overweight_yes: Factor w/ 2 levels "0","1": 2 1 2 2 1 2 2 2 2 1 ...
## $ FAVC_no : Factor w/ 2 levels "0","1": 1 2 1 1 1 1 1 1 2 1 ...
## $ FAVC_yes : Factor w/ 2 levels "0","1": 2 1 2 2 2 2 2 2 1 2 ...
## $ FCVC : num 737 490 243 810 171 171 171 810 810 240 ...
## $ NCP : num 478 478 156 478 478 192 1 478 478 1 ...
## $ CAEC : Factor w/ 4 levels "1","2","3","4": 2 2 2 2 2 2 3 2 2 2 ...
## $ SMOKE_no : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
## $ SMOKE_yes : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ CH2O : num 1198 514 875 263 550 ...
## $ SCC_no : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
## $ SCC_yes : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ FAF : num 154 1072 45 409 1190 ...
## $ TUE : num 120 841 841 472 841 ...
## $ CALC : num 2 2 1 2 2 2 1 1 2 2 ...
## $ MTRANS_Automobile : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 1 ...
## $ MTRANS_Bike : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ MTRANS_Motorbike : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ MTRANS_Public_Transportation : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 2 2 1 2 ...
## $ MTRANS_Walking : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 2 1 ...
## $ NObeyesdad : Factor w/ 7 levels "1","2","3","4",..: 5 1 5 7 2 4 1 5 2 1 ...# Ahora, ajustamos tel modelo con la nueva base de datos balanceada (obesidad_over)
modelo_rl_over <- glm(SCC_yes ~ FAVC_yes + FCVC + NCP + CAEC + CH2O + SMOKE_yes + FAVC_yes + TUE + CALC + MTRANS_Walking + family_history_with_overweight_yes + Age + NObeyesdad + Gender_Male + Gender_Female, family = "binomial"(link='logit'), data = obesidad_over_train)
# Muestra un resumen del modelo
summary(modelo_rl_over)##
## Call:
## glm(formula = SCC_yes ~ FAVC_yes + FCVC + NCP + CAEC + CH2O +
## SMOKE_yes + FAVC_yes + TUE + CALC + MTRANS_Walking + family_history_with_overweight_yes +
## Age + NObeyesdad + Gender_Male + Gender_Female, family = binomial(link = "logit"),
## data = obesidad_over_train)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.645e+00 5.798e-01 2.838 0.004542 **
## FAVC_yes1 -1.179e+00 2.014e-01 -5.852 4.86e-09 ***
## FCVC 2.493e-03 2.927e-04 8.516 < 2e-16 ***
## NCP 1.958e-03 4.372e-04 4.477 7.56e-06 ***
## CAEC2 -1.359e+00 3.520e-01 -3.862 0.000113 ***
## CAEC3 -6.644e-01 3.712e-01 -1.790 0.073437 .
## CAEC4 -4.073e-02 5.131e-01 -0.079 0.936727
## CH2O 5.554e-04 2.112e-04 2.630 0.008546 **
## SMOKE_yes1 2.305e+00 5.811e-01 3.966 7.31e-05 ***
## TUE -8.919e-04 2.053e-04 -4.345 1.39e-05 ***
## CALC -4.078e-01 1.563e-01 -2.609 0.009091 **
## MTRANS_Walking1 1.618e-01 3.297e-01 0.491 0.623518
## family_history_with_overweight_yes1 -7.631e-01 1.710e-01 -4.462 8.14e-06 ***
## Age -2.313e-03 2.810e-04 -8.231 < 2e-16 ***
## NObeyesdad2 1.799e+00 2.660e-01 6.761 1.37e-11 ***
## NObeyesdad3 2.978e+00 2.820e-01 10.561 < 2e-16 ***
## NObeyesdad4 9.674e-01 3.369e-01 2.872 0.004082 **
## NObeyesdad5 1.561e-02 4.065e-01 0.038 0.969359
## NObeyesdad6 7.807e-01 5.414e-01 1.442 0.149301
## NObeyesdad7 -1.767e+01 5.658e+02 -0.031 0.975090
## Gender_Male1 -1.495e+00 1.912e-01 -7.818 5.37e-15 ***
## Gender_Female1 NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2048.4 on 1477 degrees of freedom
## Residual deviance: 1032.3 on 1457 degrees of freedom
## AIC: 1074.3
##
## Number of Fisher Scoring iterations: 17La probabilidad para acertar si una persona cuenta calorias con nuestro modelo es del 83,1%.
Vamos a conocer un poco más en detalle que métricas devuelve nuestro modelo:
La sensibilidad es del 83,6%.
La especificidad del 82,6%
Los pos pred value es del 82,2% y los neg pred value del 83,9%.
Finalmente, nos encontramos balanced Accuracy del 83,0%. Lo que nos indica que hemos logrado un modelo muy equilibrado entre la sensibilidad y la especificidad.
pred.train <- predict(modelo_rl_over,obesidad_over_train)## Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == :
## prediction from rank-deficient fit; attr(*, "non-estim") has doubtful casespred.train <- ifelse(pred.train > 0.4,1,0)
# Convertir la variable dependiente a factor con los mismos niveles que la predicción
obesidad_over_train$SCC_yes <- factor(obesidad_over_train$SCC_yes, levels = levels(factor(pred.train)))
# Matriz de confusión
conf_matrix <- confusionMatrix(factor(pred.train), obesidad_over_train$SCC_yes)
print(conf_matrix)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 609 126
## 1 116 627
##
## Accuracy : 0.8363
## 95% CI : (0.8164, 0.8548)
## No Information Rate : 0.5095
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.6725
##
## Mcnemar's Test P-Value : 0.5629
##
## Sensitivity : 0.8400
## Specificity : 0.8327
## Pos Pred Value : 0.8286
## Neg Pred Value : 0.8439
## Prevalence : 0.4905
## Detection Rate : 0.4120
## Detection Prevalence : 0.4973
## Balanced Accuracy : 0.8363
##
## 'Positive' Class : 0
## Cuando lo probamos con el test, observamos métricas muy similares a esta, aunque ligeramente más bajas (alrededor de un 5% menos), sin embargo, seguimos obteniendo métricas muy balanceadas, lo que corrobora la adecuación de este modelo para detectar si las personas cuentan o no cuentan calorías.
# Predicción en la base de datos de prueba
pred.test <- predict(modelo_rl_over, obesidad_over_test)## Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == :
## prediction from rank-deficient fit; attr(*, "non-estim") has doubtful casespred.test <- ifelse(pred.test > 0.45, 1, 0)
# Convertir la variable dependiente a factor con los mismos niveles que la predicción
obesidad_over_test$SCC_yes <- factor(obesidad_over_test$SCC_yes, levels = levels(factor(pred.test)))
# Matriz de confusión en la base de datos de prueba
conf_matrix_test <- confusionMatrix(factor(pred.test), obesidad_over_test$SCC_yes)
print(conf_matrix_test)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 266 57
## 1 56 254
##
## Accuracy : 0.8215
## 95% CI : (0.7894, 0.8506)
## No Information Rate : 0.5087
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.6428
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.8261
## Specificity : 0.8167
## Pos Pred Value : 0.8235
## Neg Pred Value : 0.8194
## Prevalence : 0.5087
## Detection Rate : 0.4202
## Detection Prevalence : 0.5103
## Balanced Accuracy : 0.8214
##
## 'Positive' Class : 0
## # Crear la matriz de confusión
conf_matrix_df <- as.data.frame(as.table(conf_matrix_test$table))
colnames(conf_matrix_df) <- c("Predicción", "Valor Real", "Conteo")
conf_matrix_df$Predicción <- factor(conf_matrix_df$Predicción, levels = c("0", "1"))
conf_matrix_df$`Valor Real` <- factor(conf_matrix_df$`Valor Real`, levels = c("0", "1"))
# Visualizar la matriz de confusión con ggplot2
ggplot(conf_matrix_df, aes(x = Predicción, y = `Valor Real`, fill = Conteo)) +
geom_tile(color = "white") +
scale_fill_gradient(low = "white", high = "steelblue") +
geom_text(aes(label = Conteo), vjust = 1) +
theme_minimal() +
labs(title = "Matriz de Confusión",
x = "Predicción",
y = "Valor Real")
3. Modelo predictivo multiclase que obtenga el grado de obesidad
library(dplyr)
library(caret)
library(e1071)
library(randomForest)## Warning: package 'randomForest' was built under R version 4.3.2## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## margingrado_obesidad <- obesidadSeleccionando variable de clase
# Tomando la clase como factor
clase <- as.factor(grado_obesidad$NObeyesdad)
# Seleccionando variables predictoras
predictoras <- grado_obesidad[, -1]
# Creando modelo Random Forest
modelo <- randomForest(clase ~ ., data = predictoras, ntree = 500, type = "class")
# Importancia de las variables
importancia <- importance(modelo)
# Ordenando variables por importancia
importancia_ordenada <- importancia[order(importancia[, 1], decreasing = TRUE), ]
# Imprimir la estructura de importancia_ordenada
print(str(importancia_ordenada))## Named num [1:16] 803.3 415.4 122.7 89.5 85.2 ...
## - attr(*, "names")= chr [1:16] "NObeyesdad" "Weight" "FCVC" "Age" ...
## NULL# Visualizar variables
varImpPlot(modelo)
Construyendo el modelo
# Convertir variables categóricas en factores
obesidad$Gender <- as.factor(obesidad$Gender)
obesidad$family_history_with_overweight <- as.factor(obesidad$family_history_with_overweight)
obesidad$FAVC <- as.factor(obesidad$FAVC)
obesidad$CAEC <- as.factor(obesidad$CAEC)
obesidad$SMOKE <- as.factor(obesidad$SMOKE)
obesidad$SCC <- as.factor(obesidad$SCC)
obesidad$MTRANS <- as.factor(obesidad$MTRANS)
obesidad$NObeyesdad <- as.factor(obesidad$NObeyesdad)
# Dividir los datos en conjuntos de entrenamiento y prueba
set.seed(123)
indices <- sample(1:nrow(obesidad), 0.8 * nrow(obesidad))
train_data <- obesidad[indices, ]
test_data <- obesidad[-indices, ]
# Entrenar el modelo Random Forest
model_rf <- randomForest(NObeyesdad ~ ., data = train_data, ntree = 500)
# Realizar predicciones en el conjunto de prueba
predictions <- predict(model_rf, test_data)
# Evaluar el rendimiento del modelo
conf_matrix <- table(predictions, test_data$NObeyesdad)
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(conf_matrix)##
## predictions Insufficient_Weight Normal_Weight Obesity_Type_I
## Insufficient_Weight 43 2 0
## Normal_Weight 0 53 1
## Obesity_Type_I 0 0 72
## Obesity_Type_II 0 0 1
## Obesity_Type_III 0 0 0
## Overweight_Level_I 0 0 0
## Overweight_Level_II 0 0 1
##
## predictions Obesity_Type_II Obesity_Type_III Overweight_Level_I
## Insufficient_Weight 0 0 0
## Normal_Weight 0 0 5
## Obesity_Type_I 0 0 0
## Obesity_Type_II 68 1 0
## Obesity_Type_III 0 59 0
## Overweight_Level_I 0 0 50
## Overweight_Level_II 0 0 2
##
## predictions Overweight_Level_II
## Insufficient_Weight 0
## Normal_Weight 3
## Obesity_Type_I 1
## Obesity_Type_II 0
## Obesity_Type_III 0
## Overweight_Level_I 2
## Overweight_Level_II 59print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.955082742316785"4. Clustering para segmentar a la población
Procesamiento de Datos
Conversión de las variables categóricas a factores
obesidad$Gender <- as.factor(obesidad$Gender)
obesidad$family_history_with_overweight <- as.factor(obesidad$family_history_with_overweight)
obesidad$CAEC <- as.factor(obesidad$CAEC)
obesidad$NObeyesdad <- as.factor(obesidad$NObeyesdad)
obesidad$CALC <- as.factor(obesidad$CALC)
obesidad$SMOKE <- as.factor(obesidad$SMOKE)Librerías a usar en Clustering
library(randomForest)
library(caret)
library(dplyr)División datos en “factores de obesidad” y “nivel de obesidad”
Dividimos el conjunto de datos en características (factores de obesidad) y la variable objetivo (nivel de obesidad) usando “createDataPartition, para tener una distribución de 70% de entrenamiento y 30% test
Además de dividir los datos en conjuntos de entrenamiento y prueba para que poder hacer el modelo de entrenamiento y posteriormente hacer su respectiva evaluación.
factores_obesidad <- obesidad[, -which(names(obesidad) == "NObeyesdad")]
nivel_obesidad <- obesidad$NObeyesdad
set.seed(50) # Para reproducibilidad
trn_indices_obesidad <- createDataPartition(nivel_obesidad, p=.7, list = FALSE)
factores_obesidad_trn <- factores_obesidad[trn_indices_obesidad,]
nivel_obesidad_trn <- nivel_obesidad[trn_indices_obesidad]
factores_obesidad_test <- factores_obesidad[-trn_indices_obesidad,]
nivel_obesidad_test <- nivel_obesidad[-trn_indices_obesidad]Modelo de Entrenamiento
Para este conjunto de entrenamiento use el modelo “Random Forest”, la variable “objetivo” es nivel_obesidad_trn
rf_modelo <- randomForest(x= factores_obesidad_trn, y = nivel_obesidad_trn)
rf_modelo##
## Call:
## randomForest(x = factores_obesidad_trn, y = nivel_obesidad_trn)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 4
##
## OOB estimate of error rate: 4.46%
## Confusion matrix:
## Insufficient_Weight Normal_Weight Obesity_Type_I
## Insufficient_Weight 180 11 0
## Normal_Weight 3 192 0
## Obesity_Type_I 0 4 236
## Obesity_Type_II 0 1 1
## Obesity_Type_III 0 0 0
## Overweight_Level_I 0 16 0
## Overweight_Level_II 0 7 2
## Obesity_Type_II Obesity_Type_III Overweight_Level_I
## Insufficient_Weight 0 0 0
## Normal_Weight 0 0 3
## Obesity_Type_I 1 0 1
## Obesity_Type_II 205 1 0
## Obesity_Type_III 1 226 0
## Overweight_Level_I 0 0 182
## Overweight_Level_II 0 0 2
## Overweight_Level_II class.error
## Insufficient_Weight 0 0.057591623
## Normal_Weight 3 0.044776119
## Obesity_Type_I 4 0.040650407
## Obesity_Type_II 0 0.014423077
## Obesity_Type_III 0 0.004405286
## Overweight_Level_I 5 0.103448276
## Overweight_Level_II 192 0.054187192##Evaluación del Modelo
Use el conjunto de prueba, para medir la efectividad de la clasificación multiclase
predicciones <- predict(rf_modelo,factores_obesidad_test)Calcular presición del modelo
presicion <- sum(predicciones == nivel_obesidad_test)/length(nivel_obesidad_test)
presicion## [1] 0.9509494La presición del modelo es alta, esto indica que el modelo es muy efectivo para una correcta clasificación de los diferentes grados de obesidad
Reporte de clasificación
Use “confusionMatrix” para evaluar cuándo el modelo acierta o falla al predecir los diferentes tipos de obesidad, y así entender mejor cómo funciona el modelo para cada categoría de peso
confusionMatrix(predicciones, nivel_obesidad_test)## Confusion Matrix and Statistics
##
## Reference
## Prediction Insufficient_Weight Normal_Weight Obesity_Type_I
## Insufficient_Weight 79 2 0
## Normal_Weight 2 83 0
## Obesity_Type_I 0 0 102
## Obesity_Type_II 0 0 0
## Obesity_Type_III 0 0 0
## Overweight_Level_I 0 1 0
## Overweight_Level_II 0 0 3
## Reference
## Prediction Obesity_Type_II Obesity_Type_III Overweight_Level_I
## Insufficient_Weight 0 0 0
## Normal_Weight 0 0 13
## Obesity_Type_I 0 0 0
## Obesity_Type_II 89 0 0
## Obesity_Type_III 0 97 0
## Overweight_Level_I 0 0 69
## Overweight_Level_II 0 0 5
## Reference
## Prediction Overweight_Level_II
## Insufficient_Weight 0
## Normal_Weight 2
## Obesity_Type_I 1
## Obesity_Type_II 0
## Obesity_Type_III 0
## Overweight_Level_I 2
## Overweight_Level_II 82
##
## Overall Statistics
##
## Accuracy : 0.9509
## 95% CI : (0.9311, 0.9664)
## No Information Rate : 0.1661
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9427
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Insufficient_Weight Class: Normal_Weight
## Sensitivity 0.9753 0.9651
## Specificity 0.9964 0.9689
## Pos Pred Value 0.9753 0.8300
## Neg Pred Value 0.9964 0.9944
## Prevalence 0.1282 0.1361
## Detection Rate 0.1250 0.1313
## Detection Prevalence 0.1282 0.1582
## Balanced Accuracy 0.9858 0.9670
## Class: Obesity_Type_I Class: Obesity_Type_II
## Sensitivity 0.9714 1.0000
## Specificity 0.9981 1.0000
## Pos Pred Value 0.9903 1.0000
## Neg Pred Value 0.9943 1.0000
## Prevalence 0.1661 0.1408
## Detection Rate 0.1614 0.1408
## Detection Prevalence 0.1630 0.1408
## Balanced Accuracy 0.9848 1.0000
## Class: Obesity_Type_III Class: Overweight_Level_I
## Sensitivity 1.0000 0.7931
## Specificity 1.0000 0.9945
## Pos Pred Value 1.0000 0.9583
## Neg Pred Value 1.0000 0.9679
## Prevalence 0.1535 0.1377
## Detection Rate 0.1535 0.1092
## Detection Prevalence 0.1535 0.1139
## Balanced Accuracy 1.0000 0.8938
## Class: Overweight_Level_II
## Sensitivity 0.9425
## Specificity 0.9853
## Pos Pred Value 0.9111
## Neg Pred Value 0.9908
## Prevalence 0.1377
## Detection Rate 0.1297
## Detection Prevalence 0.1424
## Balanced Accuracy 0.9639Un nivel de precisión alto, como el que se logró en el modelo indica que es muy eficaz en identificar correctamente los distintos grados de obesidad. En un contexto práctico, esto quiere decir que el modelo es confiable para su uso en aplicaciones de salud, donde se requiere predicciones muy precisas para un tratamiento o diagnóstico adecuado.
Con base a la matriz de confusión, el modelo muestra un buen desempeño en la mayoría de las clases, particularmente en “Obesity_Type_II” y “obesity_Type_II” donde alcanza una gran precisión. Sin embargo, en el caso de “Overweight_Level_I” podemos ver que el rendimiento es menor lo que indica que puede ser una oportunidad de mejora para esta categoría en específico.
install.packages("ggplot2")## Warning: package 'ggplot2' is in use and will not be installedlibrary(ggplot2)Gráfico “Distribución de Niveles de Obesidad
En el siguiente gráfico se se muestra la dsitribución de las frecuencias de diferentes niveles de obesidad en un conjunto de datos. Las barras representan el número de casos en cada categoría de obesidad.
#ggplot(data, aes(x = nivel_obesidad)) +
# geom_bar() +
#theme_minimal() +
#labs(title = "Distribución de Niveles de Obesidad", x = "Niveles de Obesidad", y = "Frecuencia")