Untitled
Ivan Malagon
2026-01-14
# Preparación del entorno
if(!require(dplyr)) install.packages("dplyr")## Cargando paquete requerido: dplyr## Warning: package 'dplyr' was built under R version 4.4.3##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionif(!require(car)) install.packages("car")## Cargando paquete requerido: car## Warning: package 'car' was built under R version 4.4.3## Cargando paquete requerido: carData## Warning: package 'carData' was built under R version 4.4.3##
## Adjuntando el paquete: 'car'## The following object is masked from 'package:dplyr':
##
## recodeif(!require(nortest)) install.packages("nortest")## Cargando paquete requerido: nortestif(!require(ggplot2)) install.packages("ggplot2")## Cargando paquete requerido: ggplot2## Warning: package 'ggplot2' was built under R version 4.4.3if(!require(caret)) install.packages("caret")## Cargando paquete requerido: caret## Warning: package 'caret' was built under R version 4.4.3## Cargando paquete requerido: latticelibrary(dplyr)
library(car)
library(nortest)
library(ggplot2)
library(caret)
library(nortest)1. PREPROCESAMIENTO
##1.1 Carga y limpieza de nombres
1.1.1 Carga y visualizacion de variables y su tipo
# 1.1.1 Carga y comprobacion de typo por variable
datos <- read.csv("Findata.csv", stringsAsFactors = TRUE)
print("Estructura inicial de los datos:")## [1] "Estructura inicial de los datos:"sapply(datos, class)## X Age
## "integer" "numeric"
## Gender Weight..kg.
## "factor" "factor"
## Height..m. Max_BPM
## "factor" "numeric"
## Avg_BPM Resting_BPM
## "numeric" "numeric"
## Session_Duration..hours. Calories_Burned
## "numeric" "numeric"
## Workout_Type Fat_Percentage
## "factor" "numeric"
## Water_Intake..liters. Workout_Frequency..days.week.
## "numeric" "numeric"
## Experience_Level BMI
## "integer" "numeric"
## Daily.meals.frequency Physical.exercise
## "numeric" "numeric"
## Carbs Proteins
## "numeric" "numeric"
## Fats Calories
## "numeric" "integer"
## meal_name meal_type
## "factor" "factor"
## diet_type sugar_g
## "factor" "numeric"
## sodium_mg cholesterol_mg
## "numeric" "numeric"
## serving_size_g cooking_method
## "numeric" "factor"
## prep_time_min cook_time_min
## "numeric" "numeric"
## rating Name.of.Exercise
## "numeric" "factor"
## Sets Reps
## "numeric" "numeric"
## Benefit Burns.Calories..per.30.min.
## "factor" "numeric"
## Target.Muscle.Group Equipment.Needed
## "factor" "factor"
## Difficulty.Level Body.Part
## "factor" "factor"
## Type.of.Muscle Workout
## "factor" "factor"
## BMI_calc cal_from_macros
## "numeric" "numeric"
## pct_carbs protein_per_kg
## "numeric" "numeric"
## pct_HRR pct_maxHR
## "numeric" "numeric"
## cal_balance lean_mass_kg
## "numeric" "numeric"
## expected_burn Burns.Calories..per.30.min._bc
## "numeric" "numeric"
## Burns_Calories_Bin
## "factor"1.1.2 Limpieza de nombre de variables
nombres_org <- names(datos)
# Quitar puntos al final
nombres_limpios <- gsub("\\.+$", "", nombres_org)
# Cambiar puntos por guiones bajos
nombres_limpios <- gsub("\\.+", "_", nombres_limpios)
# Quitar guiones bajos dobles
nombres_limpios <- gsub("__+", "_", nombres_limpios)
# Asignar los nombres limpios al data frame
names(datos) <- nombres_limpios
print("Nombres de columnas normalizados:")## [1] "Nombres de columnas normalizados:"print(names(datos))## [1] "X" "Age"
## [3] "Gender" "Weight_kg"
## [5] "Height_m" "Max_BPM"
## [7] "Avg_BPM" "Resting_BPM"
## [9] "Session_Duration_hours" "Calories_Burned"
## [11] "Workout_Type" "Fat_Percentage"
## [13] "Water_Intake_liters" "Workout_Frequency_days_week"
## [15] "Experience_Level" "BMI"
## [17] "Daily_meals_frequency" "Physical_exercise"
## [19] "Carbs" "Proteins"
## [21] "Fats" "Calories"
## [23] "meal_name" "meal_type"
## [25] "diet_type" "sugar_g"
## [27] "sodium_mg" "cholesterol_mg"
## [29] "serving_size_g" "cooking_method"
## [31] "prep_time_min" "cook_time_min"
## [33] "rating" "Name_of_Exercise"
## [35] "Sets" "Reps"
## [37] "Benefit" "Burns_Calories_per_30_min"
## [39] "Target_Muscle_Group" "Equipment_Needed"
## [41] "Difficulty_Level" "Body_Part"
## [43] "Type_of_Muscle" "Workout"
## [45] "BMI_calc" "cal_from_macros"
## [47] "pct_carbs" "protein_per_kg"
## [49] "pct_HRR" "pct_maxHR"
## [51] "cal_balance" "lean_mass_kg"
## [53] "expected_burn" "Burns_Calories_per_30_min_bc"
## [55] "Burns_Calories_Bin"1.2 Variables Weight_kg y Height_m
# 1.2. Variables Weight_kg y Height_m
# Corrección de unidades (libras a kg y pies a metros si aplica)
# Nota: Ajustamos segun los factores de conversión: 1kg=2.20lb, 1m=39.37in
# Convertir factores a numéricos antes de usar mutate
datos$Weight_kg <- as.numeric(as.character(datos$Weight_kg)) ## Warning: NAs introducidos por coercióndatos$Height_m <- as.numeric(as.character(datos$Height_m))## Warning: NAs introducidos por coercióndatos <- mutate(
datos,
Weight_kg = ifelse(Weight_kg > 200, Weight_kg / 2.20, Weight_kg),
Height_m = ifelse(Height_m > 3, Height_m / 3.281, Height_m),
Weight_kg = as.numeric(Weight_kg),
Height_m = as.numeric(Height_m) )1.3 Valores ausentes y atipicos
1.3.1 Valores problematicos
# Variables a analizar
vars_objetivo <- c("Weight_kg", "Height_m")
# Conteos por tipo SOLO para esas variables
na_reales <- colSums(is.na(datos[, vars_objetivo]))
null_texto <- colSums(datos[, vars_objetivo] == "null", na.rm = TRUE)
vacios <- colSums(datos[, vars_objetivo] == "", na.rm = TRUE)
espacios <- colSums(datos[, vars_objetivo] == " ", na.rm = TRUE)
# Total de filas
n_filas <- nrow(datos)
# Crear resumen
resumen_problemas <- data.frame(
Variable = vars_objetivo,
NA_reales = na_reales,
null_texto = null_texto,
vacios = vacios,
espacios = espacios
)
# Total de problemas por variable
resumen_problemas$Total_problemas <- rowSums(resumen_problemas[, 2:5])
# Porcentaje respecto al total de filas
resumen_problemas$Porcentaje <- round((resumen_problemas$Total_problemas / n_filas) * 100, 2)
# Ordenar por número de problemas
resumen_problemas <- resumen_problemas[order(-resumen_problemas$Total_problemas), ]
print("---- Resumen de valores problemáticos (solo Weight_kg y Height_m) ----")## [1] "---- Resumen de valores problemáticos (solo Weight_kg y Height_m) ----"print(resumen_problemas)## Variable NA_reales null_texto vacios espacios Total_problemas
## Weight_kg Weight_kg 10 0 0 0 10
## Height_m Height_m 10 0 0 0 10
## Porcentaje
## Weight_kg 0.05
## Height_m 0.051.3.2 Lipieza de variables Weight_kg y Height_m y visualizacion de valores atipicos
### 1.3.2. ELIMINAR FILAS CON NA EN VARIABLES CRÍTICAS ###
vars_criticas <- c("Weight_kg", "Height_m")
datos_clean <- datos[complete.cases(datos[, vars_criticas]), ]
### 1.3.3. DETECCIÓN VISUAL DE OUTLIERS ###
boxplot(datos_clean$Weight_kg,
main = "Distribución de Peso (kg)",
col = "orange")
boxplot(datos_clean$Height_m,
main = "Distribución de Altura (m)",
col = "green")
2. Estadística Inferencial
2.1 Contraste de Hipótesis: ¿Queman más calorias los hombres?
2.1.1. Hipotesis Nula (H0):
“Los hombres no queman más calorías que las mujeres en promedio”, Hipotesis alternativa (H1): “Los hombres sí queman más calorías que las mujeres en promedio”
2.1.2 Justificación del test a aplicar:
Se elige la versión de Welch porque no asumimos que las varianzas de los dos grupos sean iguales (homocedasticidad). Dado el gran tamaño de la muestra (df approx 20,000), el test es extremadamente robusto. Nivel de significancia: 0.025 (correspondiente al 97.5 de confianza solicitado).
2.1.3 Resultados:
# 1. LIMPIEZA DE VALORES PROBLEMÁTICOS SOLO PARA Calories_Burned
# Contar valores problemáticos ANTES de limpiar
null_texto <- sum(datos$Calories_Burned == "null", na.rm = TRUE)
vacios <- sum(datos$Calories_Burned == "", na.rm = TRUE)
espacios <- sum(datos$Calories_Burned == " ", na.rm = TRUE)
na_original <- sum(is.na(datos$Calories_Burned))
# Convertir valores problemáticos a NA
datos$Calories_Burned[datos$Calories_Burned == "null"] <- NA
datos$Calories_Burned[datos$Calories_Burned == ""] <- NA
datos$Calories_Burned[datos$Calories_Burned == " "] <- NA
# Convertir a numérico si quedó como texto
datos$Calories_Burned <- as.numeric(datos$Calories_Burned)
# Contar NA después de limpiar
na_post <- sum(is.na(datos$Calories_Burned))
#TABLA RESUMEN DE LA LIMPIEZA
tabla_resumen <- data.frame(
Categoria = c("NA originales",
"Valores 'null'",
"Valores vacíos \"\"",
"Valores con espacio \" \"",
"NA después de limpieza"),
Conteo = c(na_original,
null_texto,
vacios,
espacios,
na_post)
)
cat("\n Resumen de limpieza de la variable = Calories_Burned \n")##
## Resumen de limpieza de la variable = Calories_Burnedprint(tabla_resumen)## Categoria Conteo
## 1 NA originales 0
## 2 Valores 'null' 0
## 3 Valores vacíos "" 0
## 4 Valores con espacio " " 0
## 5 NA después de limpieza 0# 2. ELIMINAR FILAS CON NA EN VARIABLES NECESARIAS PARA EL TEST
vars_criticas <- c("Calories_Burned", "Gender")
n_filas_antes <- nrow(datos)
datos_clean <- datos[complete.cases(datos[, vars_criticas]), ]
n_filas_despues <- nrow(datos_clean)
cat("\nFilas antes de limpieza final:", n_filas_antes, "\n")##
## Filas antes de limpieza final: 20000cat("Filas después de eliminar NA críticos:", n_filas_despues, "\n")## Filas después de eliminar NA críticos: 20000cat("Filas eliminadas:", n_filas_antes - n_filas_despues, "\n\n")## Filas eliminadas: 0# Filtrar grupos limpios en base R
hombres <- datos_clean$Calories_Burned[datos_clean$Gender == "Male"]
mujeres <- datos_clean$Calories_Burned[datos_clean$Gender == "Female"]
# Test t de Student (Welch por defecto)
test_genero <- t.test(hombres, mujeres, alternative = "greater", conf.level = 0.975)
print(test_genero)##
## Welch Two Sample t-test
##
## data: hombres and mujeres
## t = 0.14819, df = 19980, p-value = 0.4411
## alternative hypothesis: true difference in means is greater than 0
## 97.5 percent confidence interval:
## -12.87038 Inf
## sample estimates:
## mean of x mean of y
## 1280.637 1279.5852.1.4 Interpretación del test:
A pesar de que en la muestra los hombres presentan un promedio ligeramente superior, la diferencia no es estadísticamente significativa. Por lo tanto, no podemos afirmar que los hombres quemen más calorías que las mujeres en esta población de datos, bajo un nivel de confianza del 97.5 porciento.
3. Modelo de Regresion
3.1. Regresión Lineal Múltiple
# LIMPIEZA DE Session_Duration_hours
# 1. Contar valores problemáticos ANTES de limpiar
null_texto_SD <- sum(datos$Session_Duration_hours == "null", na.rm = TRUE)
vacios_SD <- sum(datos$Session_Duration_hours == "", na.rm = TRUE)
espacios_SD <- sum(datos$Session_Duration_hours == " ", na.rm = TRUE)
na_original_SD <- sum(is.na(datos$Session_Duration_hours))
# 2. Convertir valores problemáticos a NA
datos$Session_Duration_hours[datos$Session_Duration_hours == "null"] <- NA
datos$Session_Duration_hours[datos$Session_Duration_hours == ""] <- NA
datos$Session_Duration_hours[datos$Session_Duration_hours == " "] <- NA
# 3. Convertir a numérico si quedó como texto
datos$Session_Duration_hours <- as.numeric(datos$Session_Duration_hours)
# 4. Contar NA después de limpiar
na_post_SD <- sum(is.na(datos$Session_Duration_hours))
# TABLA RESUMEN DE LA LIMPIEZA
tabla_resumen_SD <- data.frame(
Categoria = c("NA originales",
"Valores 'null'",
"Valores vacíos \"\"",
"Valores con espacio \" \"",
"NA después de limpieza"),
Conteo = c(na_original_SD,
null_texto_SD,
vacios_SD,
espacios_SD,
na_post_SD)
)
cat("\n Resumen de limpieza de Session_Duration_hours \n")##
## Resumen de limpieza de Session_Duration_hoursprint(tabla_resumen_SD)## Categoria Conteo
## 1 NA originales 0
## 2 Valores 'null' 0
## 3 Valores vacíos "" 0
## 4 Valores con espacio " " 0
## 5 NA después de limpieza 0# Ajuste del modelo lineal múltiple
modelo_lineal <- lm(
Calories_Burned ~ Session_Duration_hours +
Experience_Level +
Workout_Frequency_days_week +
Height_m +
Weight_kg +
Gender +
Workout_Type,
data = datos
)
# Visualización del resumen del modelo
summary(modelo_lineal)##
## Call:
## lm(formula = Calories_Burned ~ Session_Duration_hours + Experience_Level +
## Workout_Frequency_days_week + Height_m + Weight_kg + Gender +
## Workout_Type, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -272.47 -49.98 -9.90 43.31 372.89
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -365.97605 9.81055 -37.304 <2e-16 ***
## Session_Duration_hours 1052.80104 2.79188 377.094 <2e-16 ***
## Experience_Level 59.08707 1.46902 40.222 <2e-16 ***
## Workout_Frequency_days_week 37.06538 1.10275 33.612 <2e-16 ***
## Height_m 14.47159 5.71143 2.534 0.0113 *
## Weight_kg 0.03329 0.03428 0.971 0.3314
## GenderMale 0.67259 1.35735 0.496 0.6202
## Workout_TypeHIIT 451.93307 1.92975 234.193 <2e-16 ***
## Workout_TypeStrength 151.96713 1.92054 79.127 <2e-16 ***
## Workout_TypeYoga -297.31188 1.92397 -154.530 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 95.94 on 19980 degrees of freedom
## (10 observations deleted due to missingness)
## Multiple R-squared: 0.9635, Adjusted R-squared: 0.9635
## F-statistic: 5.865e+04 on 9 and 19980 DF, p-value: < 2.2e-16Interpretación del modelo lineal ajustado
El modelo presenta un R2 de 0.9635 y un R2 ajustado de 0.9635. Esto indica que aproximadamente el 96 por ciento de la variabilidad en las calorías quemadas se explica por las variables incluidas en el modelo. Por tanto, la calidad del ajuste es muy alta.
El estadístico F del modelo es significativo con un p valor menor que 0.001, lo que confirma que el conjunto de predictores explica de forma conjunta una parte importante de la variabilidad de la variable dependiente.
El error estándar residual es de aproximadamente 96 calorías, lo que indica el nivel medio de desviación entre los valores observados y los valores predichos por el modelo.
Contribución de la variable Experience_Level
El coeficiente estimado para Experience_Level es aproximadamente 59. Esto significa que, manteniendo constantes el resto de variables del modelo, por cada incremento de una unidad en el nivel de experiencia se queman en promedio 59 calorías adicionales.
El efecto es estadísticamente significativo, ya que su p valor es menor que 0.001. Esto indica que Experience_Level es un predictor relevante y con impacto claro sobre las calorías quemadas.
3.2. Multicolinealidad
vif(modelo_lineal)## GVIF Df GVIF^(1/(2*Df))
## Session_Duration_hours 1.972358 1 1.404406
## Experience_Level 2.282787 1 1.510889
## Workout_Frequency_days_week 2.192822 1 1.480818
## Height_m 1.143293 1 1.069249
## Weight_kg 1.144164 1 1.069656
## Gender 1.000394 1 1.000197
## Workout_Type 1.001225 3 1.000204Interpretacion:
No se detectan problemas de multicolinealidad en el modelo.
Las variables Session_Duration_hours, Experience_Level y Workout_Frequency_days_week presentan los VIF más altos, pero siguen estando en niveles totalmente aceptables o normales.
Las variables Height_m, Weight_kg, Gender y Workout_Type muestran valores muy bajos, lo que indica independencia casi total respecto al resto de predictores o variables.
En conclusion: En conclusión, no se observan problemas de multicolinealidad en el modelo. Las variables no están lo suficientemente correlacionadas como para afectar los resultados, así que las estimaciones obtenidas se pueden interpretar con tranquilidad.
3.3. Análisis Visual de los Residuos
plot(modelo_lineal)
### Diagnóstico del modelo Residuals vs Fitted: Se observa una ligera
curvatura, lo que indica que la relación no es completamente lineal y el
modelo podría mejorarse.
Normal Q-Q: Los residuos siguen la línea central, aunque se desvían en los extremos. Esto sugiere una leve falta de normalidad, lo cual es habitual en muestras grandes.
Scale-Location: La dispersión aumenta con los valores ajustados, señal de heterocedasticidad. La varianza no es totalmente constante.
Residuals vs Leverage: Aparecen algunos puntos influyentes, pero no parecen comprometer el modelo.
3.4 Regresion logistica
# 1. Crear la variable binaria (1 si es Beginner, 0 si es Intermedio/Avanzado)
datos$is_beginner <- ifelse(datos$Experience_Level == 1, 1, 0)
# 2. Ajustar el modelo logístico
# Predecimos ser principiante en función de variables clave
modelo_log <- glm(is_beginner ~ Calories_Burned + Session_Duration_hours +
Workout_Frequency_days_week + Weight_kg + Height_m + Workout_Type + Gender,
data = datos, family = binomial)
# 3. Ver resultados
summary(modelo_log)##
## Call:
## glm(formula = is_beginner ~ Calories_Burned + Session_Duration_hours +
## Workout_Frequency_days_week + Weight_kg + Height_m + Workout_Type +
## Gender, family = binomial, data = datos)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 8.2915206 0.3346476 24.777 < 2e-16 ***
## Calories_Burned -0.0147163 0.0004180 -35.210 < 2e-16 ***
## Session_Duration_hours 11.2066561 0.3902563 28.716 < 2e-16 ***
## Workout_Frequency_days_week -1.3011762 0.0358506 -36.294 < 2e-16 ***
## Weight_kg -0.0034714 0.0009797 -3.543 0.000395 ***
## Height_m -0.0604846 0.1769843 -0.342 0.732538
## Workout_TypeHIIT 6.3659900 0.1938530 32.839 < 2e-16 ***
## Workout_TypeStrength 2.1266060 0.0862556 24.655 < 2e-16 ***
## Workout_TypeYoga -4.1654373 0.1297897 -32.094 < 2e-16 ***
## GenderMale -0.0035505 0.0418738 -0.085 0.932427
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 27565 on 19989 degrees of freedom
## Residual deviance: 14144 on 19980 degrees of freedom
## (10 observations deleted due to missingness)
## AIC: 14164
##
## Number of Fisher Scoring iterations: 6Interpretación del modelo logístico
Variables significativas
El modelo identifica varias variables con un efecto estadísticamente significativo sobre la probabilidad de ser principiante (p < 0.05):
Calories_Burned: coeficiente negativo. A mayor
cantidad de calorías quemadas, menor probabilidad de ser
principiante.
Session_Duration_hours: coeficiente positivo. Sesiones
más largas aumentan la probabilidad de ser principiante.
Workout_Frequency_days_week: coeficiente negativo.
Entrenar más días por semana reduce la probabilidad de ser
principiante.
Weight_kg: efecto pequeño pero significativo, asociado
a una ligera reducción en la probabilidad de ser principiante.
Workout_Type (HIIT, Strength, Yoga): todos los tipos
son significativos respecto a la categoría base. HIIT y Strength
aumentan la probabilidad de ser principiante, mientras que Yoga la
reduce.
Las variables Height_m y Gender no son significativas, por lo que no aportan información relevante para predecir si una persona es principiante.
Calidad del modelo
El modelo muestra una reducción importante en la deviance:
- Null deviance: 27565
- Residual deviance: 14144
Esta disminución indica que el modelo explica una parte sustancial de la variabilidad respecto al modelo sin predictores. Además, el AIC = 14164 sugiere un ajuste adecuado para el tamaño de la muestra.
Conclusión
El modelo logístico presenta un buen desempeño general y varias variables influyen de forma clara y significativa en la probabilidad de ser principiante. Aunque no todas las variables aportan información útil, el modelo en conjunto ofrece una capacidad explicativa sólida.
3.5. Matriz de confusión
# Filtrar datos completos
datos_filtrado <- datos[complete.cases(datos[, c(
"Calories_Burned",
"Session_Duration_hours",
"Workout_Frequency_days_week",
"Weight_kg",
"Height_m",
"Workout_Type",
"Gender",
"is_beginner"
)]), ]
# Predicciones del modelo logístico
pred_prob <- predict(modelo_log,
newdata = datos_filtrado,
type = "response")
# Convertir probabilidades en clases (umbral 0.5)
predicciones <- ifelse(pred_prob >= 0.5, 1, 0)
# Crear factores
actual <- factor(datos_filtrado$is_beginner)
predicho <- factor(predicciones)
# Matriz de confusión
library(caret)
matriz <- confusionMatrix(predicho, actual, positive = "1")
print(matriz)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 7215 1896
## 1 1922 8957
##
## Accuracy : 0.809
## 95% CI : (0.8035, 0.8144)
## No Information Rate : 0.5429
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.6151
##
## Mcnemar's Test P-Value : 0.6858
##
## Sensitivity : 0.8253
## Specificity : 0.7896
## Pos Pred Value : 0.8233
## Neg Pred Value : 0.7919
## Prevalence : 0.5429
## Detection Rate : 0.4481
## Detection Prevalence : 0.5442
## Balanced Accuracy : 0.8075
##
## 'Positive' Class : 1
## Conclusiones
El modelo logístico muestra un rendimiento solido en la clasificación de usuarios principiantes y no principiantes. La sensibilidad es 0.8253, lo que indica que el modelo identifica correctamente al 82.5 % de los principiantes reales. Por otro lado, la especificidad es 0.7896, lo que significa que clasifica correctamente al 78.9 % de los usuarios que no son principiantes.
La exactitud global del modelo es 0.809, lo que refleja un desempeño estable y equilibrado. Además, el valor de Kappa (0.6151) sugiere un acuerdo sustancial entre las predicciones y los valores reales, más allá del azar. La balanced accuracy (0.8075) confirma que el modelo mantiene un buen equilibrio entre sensibilidad y especificidad.
En General, el modelo ofrece una capacidad predictiva acertada y consistente, siendo útil para distinguir entre usuarios principiantes y no principiantes dentro del conjunto de datos analizado.
4 Análisis de la varianza (ANOVA) de un factor
En este apartado analizaremos si existen diferencias significativas en la variable Calories_Burned en función del tipo de entrenamiento (Workout_Type).
4.1. Visualizar los datos por tipo de entrenamiento con un boxplot
ggplot(datos, aes(x = Workout_Type, y = Calories_Burned, fill = Workout_Type)) +
geom_boxplot() +
labs(title = "Distribución de Calorías por Tipo de Entrenamiento",
x = "Tipo de Entrenamiento", y = "Calorías") +
theme_minimal()
4.2 Hipotesis nula y alternativa
Hipótesis del ANOVA
Hipótesis nula (H0):
Las medias de calorías quemadas son iguales en todos los tipos de
entrenamiento. Es decir, no hay diferencias entre HIIT, Strength, Yoga,
etc.
Hipótesis alternativa (H1):
Al menos un tipo de entrenamiento tiene una media de calorías quemadas
diferente a los demás.
4.3 Modelo ANOVA
# Ajuste del modelo ANOVA
anova_modelo <- aov(Calories_Burned ~ Workout_Type, data = datos)
# Ver la tabla ANOVA
summary(anova_modelo)## Df Sum Sq Mean Sq F value Pr(>F)
## Workout_Type 3 1.485e+09 494905823 2780 <2e-16 ***
## Residuals 19996 3.560e+09 178021
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Interpretación del ANOVA
El análisis ANOVA muestra que el tipo de entrenamiento tiene un efecto significativo sobre las calorías quemadas. La suma de cuadrados del factor (Sum Sq = 1.485e+09) es elevada, lo que indica que una parte importante de la variabilidad total se explica por las diferencias entre tipos de entrenamiento. El cuadrado medio del factor (Mean Sq = 494905823) es muy superior al del error (178021), lo que sugiere que las diferencias entre grupos son mucho mayores que la variabilidad dentro de cada grupo.
El estadístico F toma un valor muy alto (2780), lo que refuerza la evidencia de que los grupos no tienen medias iguales. Finalmente, el p‑valor (< 2e‑16) es extremadamente pequeño, por lo que se rechaza la hipótesis nula. Esto confirma que existen diferencias significativas en las calorías quemadas según el tipo de entrenamiento.
4.6. Adecuación del modelo
plot(anova_modelo)
homogeneidad de varianzas
leveneTest(Calories_Burned ~ Workout_Type, data = datos)## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 3 407.77 < 2.2e-16 ***
## 19996
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Conclusion
Al tener un p < 0.05 para este caso es p= 2.2e-16, asumimos que hay heterocedasticidad por lo que a continuacion vamos a usar la prueba T2 de Tamhane.
Tamhane T2
# Instalar si no la tienes: install.packages("PMCMRplus")
library(PMCMRplus)## Warning: package 'PMCMRplus' was built under R version 4.4.3# Tamhane T2 requiere la variable de grupo como factor
post_hoc_tamhane <- tamhaneT2Test(Calories_Burned ~ Workout_Type, data = datos)
print(post_hoc_tamhane)##
## Pairwise comparisons using Tamhane's T2-test for unequal variances## data: Calories_Burned by Workout_Type## Cardio HIIT Strength
## HIIT <2e-16 - -
## Strength <2e-16 <2e-16 -
## Yoga <2e-16 <2e-16 <2e-16##
## P value adjustment method: T2 (Sidak)## alternative hypothesis: two.sidedConclusión
El test Tamhane T2 confirma que todos los tipos de entrenamiento difieren significativamente entre sí en cuanto a calorías quemadas. Esto complementa el resultado del ANOVA y permite concluir que cada modalidad de entrenamiento presenta un nivel de gasto calórico claramente distinto.
4.6.1 Normalidad de los residuos
Hipótesis del test de normalidad
Para comprobar si los residuos del modelo siguen una distribución normal, se plantea el siguiente contraste:
Hipótesis nula (H0):
Los residuos siguen una distribución normal.
Hipótesis alternativa (H1):
Los residuos no siguen una distribución normal.
Análisis Visual (Gráfico Q-Q)
# Extraer los residuos del modelo ANOVA del punto 4.3
residuos_anova <- residuals(anova_modelo)
# Crear el gráfico Q-Q
qqnorm(residuos_anova, main = "Gráfico Q-Q de los Residuos del ANOVA")
qqline(residuos_anova, col = "red", lwd = 2)
Contraste Estadístico (Test de Anderson-Darling)
# Cargar la librería necesaria
if(!require(nortest)) install.packages("nortest")
library(nortest)
# Ejecutar el test
test_norm_ad <- ad.test(residuos_anova)
print(test_norm_ad)##
## Anderson-Darling normality test
##
## data: residuos_anova
## A = 199.49, p-value < 2.2e-16Conlcusion 4.6.1
Aunque el test de Anderson-Darling indica que los residuos no siguen una distribución normal (p-value < 2.2e-16), el tamaño muestral es lo suficientemente grande como para que el Teorema del Límite Central garantice que las medias de los grupos se aproximen a la normalidad. Por ello, el ANOVA sigue siendo válido y sus resultados pueden interpretarse con confianza.
4.6.2 Homocedasticidad de los residuos
Hipótesis del Test de Levene
Para comprobar si las varianzas son iguales entre los distintos tipos de entrenamiento, se plantea el siguiente contraste:
Hipótesis nula (H0):
Las varianzas son iguales en todos los grupos.
Hipótesis alternativa (H1):
Al menos un grupo presenta una varianza diferente.
Prueba de contraste con el test de levene
library(car)
# Ejecutar el test de Levene para el factor Workout_Type
test_levene <- leveneTest(Calories_Burned ~ Workout_Type, data = datos)
print(test_levene)## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 3 407.77 < 2.2e-16 ***
## 19996
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1El test de Levene
Nos muestra un p‑valor < 2.2e‑16, lo que implica rechazar la hipótesis nula de igualdad de varianzas entre los grupos. Por tanto, no existe homogeneidad de varianzas en los tipos de entrenamiento analizados. Dado que este supuesto no se cumple, en el apartado 4.6 ya se aplicó correctamente la prueba T2 de Tamhane, que es el método post‑hoc adecuado para escenarios con varianzas desiguales y garantiza la robustez del análisis comparativo entre grupos.
###Conlcuion general apra ANOVA El gráfico Q‑Q y el test de normalidad confirman que los residuos del ANOVA no siguen una distribución normal. Además, el test de Levene indica que las varianzas no son homogéneas. Debido a estas violaciones de supuestos, se recomienda utilizar la ANOVA de Welch, que ofrece un análisis más robusto en presencia de varianzas desiguales.
ANOVA de Wekch
Hipótesis del contraste (ANOVA de Welch)
Hipótesis nula (H0):
Las medias de calorías quemadas son iguales en todos los tipos de
entrenamiento.
Hipótesis alternativa (H1):
Al menos un tipo de entrenamiento presenta una media de calorías
quemadas diferente.
welch_anova <- oneway.test(Calories_Burned ~ Workout_Type,
data = datos,
var.equal = FALSE)
welch_anova##
## One-way analysis of means (not assuming equal variances)
##
## data: Calories_Burned and Workout_Type
## F = 3158.2, num df = 3, denom df = 10844, p-value < 2.2e-16###Conclusión del ANOVA de Welch Para evaluar si el ANOVA clásico era adecuado, se comprobó primero el supuesto de homogeneidad de varianzas mediante el test de Levene. El resultado obtenido (F = 407.77, p‑valor < 2.2e‑16) llevó a rechazar la hipótesis nula, concluyendo que las varianzas no son iguales entre los tipos de entrenamiento. Esta falta de homocedasticidad invalida el uso del ANOVA tradicional, que requiere varianzas homogéneas para garantizar la fiabilidad del estadístico F.
Dado que este supuesto no se cumple, se aplicó la ANOVA de Welch, una alternativa robusta que no asume igualdad de varianzas y ajusta los grados de libertad para obtener un contraste válido. Los resultados de Welch (F = 3158.2, gl1 = 3, gl2 = 10844, p‑valor < 2.2e‑16) muestran diferencias altamente significativas entre los tipos de entrenamiento.
En conjunto, la evidencia estadística confirma que existen diferencias claras en las calorías quemadas según el tipo de entrenamiento, y que la ANOVA de Welch es el método adecuado para este análisis debido a la heterogeneidad de varianzas detectada.
5. ANOVA multifactorial
5.1. Creación de la variable BMI_bin
Primero, clasificamos a los usuarios según su indice de masa corporal, (un IMB mayor a 25 se considera sobrepeso según la OMS).
# Crear la variable binaria segun el enunciado
datos$BMI_bin <- ifelse(datos$BMI > 25, "Alto", "Normal_Bajo")
# Convertir a factor para que R lo trate como variable categórica
datos$BMI_bin <- as.factor(datos$BMI_bin)
# Verificar la distribución
table(datos$BMI_bin)##
## Alto Normal_Bajo
## 8890 111105.2. Análisis visual de interacción
El gráfico de interaccion es la herramienta clave para decidir si el modelo debe incluir el término de interacción o no.
# Gráfico de interacción (líneas)
interaction.plot(x.factor = datos$Workout_Type,
trace.factor = datos$BMI_bin,
response = datos$Calories_Burned,
fun = mean,
type = "b",
col = c("red", "blue"),
pch = c(19, 17),
fixed = TRUE,
xlab = "Tipo de Entrenamiento",
ylab = "Media de Calorías Quemadas",
trace.label = "BMI")
5.3. Hipótesis nula y alternativa
Hipotesis nula para el tipo de entrenamiento: “Las medias de calorías quemadas son iguales en todos los tipos de entrenamiento”.
Hipotesis nula para el BMI: ” No hay diferencia en el gasto calórico entre personas con BMI alto y normal bajo”.
Hipotesis nula para la interacción: ” No existe interacción entre el tipo de ejercicio (workout_Type) y el Indice de masa corporal (BMI_bin)”
5.4 Cálculo del modelo
5.4.1 Cálculo del modelo de interacción
# Modelo con interaccion
modelo_multi <- aov(Calories_Burned ~ Workout_Type * BMI_bin, data = datos)
# Ver tabla ANOVA
summary(modelo_multi)## Df Sum Sq Mean Sq F value Pr(>F)
## Workout_Type 3 1.485e+09 494905823 2779.974 <2e-16 ***
## BMI_bin 1 5.695e+05 569544 3.199 0.0737 .
## Workout_Type:BMI_bin 3 5.761e+04 19205 0.108 0.9555
## Residuals 19992 3.559e+09 178025
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Efecto del Tipo de Entrenamiento (Workout_Type) F = 2779.974, p < 2e‑16 Resultado: Efecto altamente significativo Interpretación: Las calorías quemadas varían claramente según el tipo de entrenamiento.
Efecto del BMI (BMI_bin) F = 3.199, p = 0.0737 Resultado: No significativo (aunque cercano al 0.10) Interpretación: No se detectan diferencias estadísticamente claras en calorías quemadas entre BMI Normal_Bajo y Alto.
Interacción Entrenamiento × BMI F = 0.108, p = 0.9555 Resultado: No significativo Interpretación: El efecto del tipo de entrenamiento es el mismo para ambos niveles de BMI; no hay interacción.
Conclusión:
El tipo de entrenamiento es el único factor con un efecto fuerte y significativo sobre las calorías quemadas. El BMI no influye significativamente en el gasto calórico dentro del modelo. No existe interacción, por lo que ambos grupos de BMI siguen el mismo patrón de respuesta ante los distintos entrenamientos.
5.4.2 Adecuación del modelo ahora sin interacción
Siguiendo las instrucciones del enunciado: “Si no existiera interacción entre los factores, se debe crear un modelo sin interacción”. Dado que el p-valor de interacción es 0.9555, debemos recalcular el ANOVA eliminando ese término para ganar precisión en los efectos principales.
# Nuevo modelo aditivo (sin interacción)
modelo_multi_final <- aov(Calories_Burned ~ Workout_Type + BMI_bin, data = datos)
# Ver los nuevos resultados
summary(modelo_multi_final)## Df Sum Sq Mean Sq F value Pr(>F)
## Workout_Type 3 1.485e+09 494905823 2780.3 <2e-16 ***
## BMI_bin 1 5.695e+05 569544 3.2 0.0737 .
## Residuals 19995 3.559e+09 178001
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Interpretación de Resultados
Tras eliminar la interacción —que no resultó significativa— el modelo final se centra en los efectos principales.
Workout_Type (p < 0.0001):
El tipo de entrenamiento sigue siendo claramente significativo. Este
factor explica la mayor parte de las diferencias en las calorías
quemadas entre actividades como HIIT, Yoga, Fuerza o Cardio.
BMI_bin (p = 0.0737):
El nivel de IMC continúa sin ser significativo con un nivel de confianza
del 95 %. Aunque el valor es algo menor que en el modelo con
interacción, no hay evidencia suficiente para afirmar que el IMC influya
por sí solo en las calorías quemadas.
Conclusión del modelo
El modelo final muestra que el gasto calórico depende casi por completo del tipo de actividad realizada, mientras que el IMC no produce diferencias estadísticamente claras entre personas con IMC Alto y Normal/Bajo.
5.5. Adecuación del modelo
Graficos
# Residuos y valores ajustados
res <- residuals(modelo_multi_final)
fit <- fitted(modelo_multi_final)
# Histograma de residuos
hist(res, main = "Histograma de los residuos", xlab = "Residuos")
# Gráfico Q-Q
qqnorm(res)
qqline(res, col = "red")
# Residuos vs valores ajustados (homocedasticidad)
plot(fit, res,
main = "Residuos vs Valores Ajustados",
xlab = "Valores Ajustados",
ylab = "Residuos")
abline(h = 0, col = "red")
# Boxplot de residuos por tipo de entrenamiento
boxplot(res ~ Workout_Type,
data = datos,
main = "Residuos por tipo de entrenamiento",
xlab = "Tipo de entrenamiento",
ylab = "Residuos")
Normalidad de los residuos (Anderson-Darling)
# Test Anderson-Darling para Normalidad de los residuos
residuos_final <- residuals(modelo_multi_final)
ad.test(residuos_final) ##
## Anderson-Darling normality test
##
## data: residuos_final
## A = 197.85, p-value < 2.2e-16Homocedasticidad (Levene)
leveneTest(Calories_Burned ~ Workout_Type * BMI_bin, data = datos)## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 7 178.94 < 2.2e-16 ***
## 19992
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 15.6 Interpretación de los resultados
Los resultados obtenidos son: F = 178.94 p‑valor < 0.0001 Grupos evaluados: 8 niveles en total (Df = 7)
Conclusión El p‑valor es extremadamente pequeño, por lo que se rechaza la hipótesis nula de igualdad de varianzas. Esto significa que: Las varianzas no son homogéneas entre los grupos. El supuesto de homocedasticidad no se cumple en los datos. El ANOVA clásico no es adecuado, ya que requiere varianzas iguales.