Este análisis utiliza datos del CDC (Centers for Disease Control and Prevention) sobre nutrición, actividad física y obesidad en Estados Unidos. El objetivo es desarrollar un modelo de regresión lineal múltiple para predecir el porcentaje de obesidad en adultos a partir de indicadores de sobrepeso y hábitos de consumo de frutas y verduras.
La base de datos contiene información del Behavioral Risk Factor Surveillance System (BRFSS) recopilada en diferentes estados y años. Este sistema de vigilancia es fundamental para monitorear factores de riesgo de salud en la población estadounidense.
# Cargar librerías necesarias
library(dplyr)
library(tidyr)
library(ggplot2)
# Leer los datos desde el archivo CSV
datos <- read.csv("nutricion_obesidad_cdc.csv", stringsAsFactors = FALSE)
# Mostrar dimensiones y estructura
cat("Dimensiones del dataset:", nrow(datos), "filas x", ncol(datos), "columnas\n\n")
## Dimensiones del dataset: 106260 filas x 33 columnas
# Ver las primeras observaciones
head(datos)
## YearStart YearEnd LocationAbbr LocationDesc
## 1 2011 2011 AL Alabama
## 2 2011 2011 AL Alabama
## 3 2011 2011 AL Alabama
## 4 2011 2011 AL Alabama
## 5 2011 2011 AL Alabama
## 6 2011 2011 AL Alabama
## Datasource Class
## 1 Behavioral Risk Factor Surveillance System Obesity / Weight Status
## 2 Behavioral Risk Factor Surveillance System Obesity / Weight Status
## 3 Behavioral Risk Factor Surveillance System Obesity / Weight Status
## 4 Behavioral Risk Factor Surveillance System Obesity / Weight Status
## 5 Behavioral Risk Factor Surveillance System Obesity / Weight Status
## 6 Behavioral Risk Factor Surveillance System Obesity / Weight Status
## Topic
## 1 Obesity / Weight Status
## 2 Obesity / Weight Status
## 3 Obesity / Weight Status
## 4 Obesity / Weight Status
## 5 Obesity / Weight Status
## 6 Obesity / Weight Status
## Question Data_Value_Unit
## 1 Percent of adults aged 18 years and older who have obesity NA
## 2 Percent of adults aged 18 years and older who have obesity NA
## 3 Percent of adults aged 18 years and older who have obesity NA
## 4 Percent of adults aged 18 years and older who have obesity NA
## 5 Percent of adults aged 18 years and older who have obesity NA
## 6 Percent of adults aged 18 years and older who have obesity NA
## Data_Value_Type Data_Value Data_Value_Alt Data_Value_Footnote_Symbol
## 1 Value 34.8 34.8
## 2 Value 35.8 35.8
## 3 Value 32.3 32.3
## 4 Value 34.1 34.1
## 5 Value 28.8 28.8
## 6 Value 16.3 16.3
## Data_Value_Footnote Low_Confidence_Limit High_Confidence_Limit. Sample_Size
## 1 31.3 38.5 1,367
## 2 31.1 40.8 757
## 3 28.0 36.8 861
## 4 29.7 38.8 785
## 5 25.4 32.5 1,125
## 6 12.6 20.9 356
## Total Age.years. Education Sex Income Race.Ethnicity
## 1 $15,000 - $24,999
## 2 $25,000 - $34,999
## 3 $35,000 - $49,999
## 4 $50,000 - $74,999
## 5 $75,000 or greater
## 6 18 - 24
## GeoLocation ClassID TopicID QuestionID DataValueTypeID
## 1 (32.840571122, -86.631860762) OWS OWS1 Q036 VALUE
## 2 (32.840571122, -86.631860762) OWS OWS1 Q036 VALUE
## 3 (32.840571122, -86.631860762) OWS OWS1 Q036 VALUE
## 4 (32.840571122, -86.631860762) OWS OWS1 Q036 VALUE
## 5 (32.840571122, -86.631860762) OWS OWS1 Q036 VALUE
## 6 (32.840571122, -86.631860762) OWS OWS1 Q036 VALUE
## LocationID StratificationCategory1 Stratification1
## 1 1 Income $15,000 - $24,999
## 2 1 Income $25,000 - $34,999
## 3 1 Income $35,000 - $49,999
## 4 1 Income $50,000 - $74,999
## 5 1 Income $75,000 or greater
## 6 1 Age (years) 18 - 24
## StratificationCategoryId1 StratificationID1
## 1 INC INC1525
## 2 INC INC2535
## 3 INC INC3550
## 4 INC INC5075
## 5 INC INC75PLUS
## 6 AGEYR AGEYR1824
Con el fin de conocer las relaciones existentes entre cada par de variables podemos representar una matriz de diagramas de dispersión. A continuación se presenta una visión general de los datos una vez procesados.
# Filtrar datos de interés: solo totales sin estratificación demográfica
datos_filtrados <- datos %>%
filter(
Stratification1 == "Total",
Question %in% c(
"Percent of adults aged 18 years and older who have obesity",
"Percent of adults aged 18 years and older who have an overweight classification",
"Percent of adults who report consuming fruit less than one time daily",
"Percent of adults who report consuming vegetables less than one time daily"
),
!is.na(Data_Value)
) %>%
select(YearStart, LocationDesc, Question, Data_Value)
# Crear nombres cortos para cada indicador
datos_filtrados <- datos_filtrados %>%
mutate(
Indicador = case_when(
grepl("obesity", Question) ~ "obesidad",
grepl("overweight", Question) ~ "sobrepeso",
grepl("fruit", Question) ~ "menos_frutas",
grepl("vegetables", Question) ~ "menos_verduras"
)
)
# Transformar datos a formato ancho para el análisis
datos_limpios <- datos_filtrados %>%
select(YearStart, LocationDesc, Indicador, Data_Value) %>%
pivot_wider(
names_from = Indicador,
values_from = Data_Value,
values_fn = mean
) %>%
filter(
!is.na(obesidad),
!is.na(sobrepeso),
!is.na(menos_frutas),
!is.na(menos_verduras)
)
# Mostrar resumen de los datos preparados
cat("\nDatos preparados para el análisis:\n")
##
## Datos preparados para el análisis:
cat("Número de observaciones:", nrow(datos_limpios), "\n")
## Número de observaciones: 161
cat("Periodo analizado:", min(datos_limpios$YearStart), "-", max(datos_limpios$YearStart), "\n\n")
## Periodo analizado: 2017 - 2021
# Ver las primeras filas
head(datos_limpios, 10)
## # A tibble: 10 × 6
## YearStart LocationDesc obesidad sobrepeso menos_frutas menos_verduras
## <int> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 2017 Alabama 36.3 33.9 44.9 19.3
## 2 2017 Alaska 34.2 32.6 36.9 19
## 3 2017 Arizona 29.5 35.3 37.2 20.8
## 4 2017 Arkansas 35 35.4 44.7 19.3
## 5 2017 California 25.1 35.8 32.5 21.4
## 6 2017 Colorado 22.6 36.1 33 17.4
## 7 2017 Connecticut 26.9 36.4 31.5 16.9
## 8 2017 Delaware 31.8 36.7 35.4 17.2
## 9 2017 District of Columbia 23 31 30.6 13.7
## 10 2017 Florida 28.4 35.6 34.4 19.4
Para cuantificar el grado de relación lineal, calculemos la matriz de coeficientes de correlación.
# Resumen estadístico de las variables
summary(datos_limpios[, c("obesidad", "sobrepeso", "menos_frutas", "menos_verduras")])
## obesidad sobrepeso menos_frutas menos_verduras
## Min. :22.6 Min. :30.70 Min. :29.70 Min. :12.40
## 1st Qu.:29.2 1st Qu.:33.90 1st Qu.:36.10 1st Qu.:17.40
## Median :32.3 Median :34.80 Median :38.90 Median :19.70
## Mean :32.1 Mean :34.72 Mean :39.39 Mean :20.04
## 3rd Qu.:34.8 3rd Qu.:35.60 3rd Qu.:42.70 3rd Qu.:21.30
## Max. :40.8 Max. :39.00 Max. :56.00 Max. :46.60
# Matriz de correlaciones
cat("\nMatriz de correlaciones:\n")
##
## Matriz de correlaciones:
cor(datos_limpios[, c("obesidad", "sobrepeso", "menos_frutas", "menos_verduras")])
## obesidad sobrepeso menos_frutas menos_verduras
## obesidad 1.0000000 -0.41643787 0.7126035 0.25681595
## sobrepeso -0.4164379 1.00000000 -0.2401951 0.03327601
## menos_frutas 0.7126035 -0.24019513 1.0000000 0.60680163
## menos_verduras 0.2568160 0.03327601 0.6068016 1.00000000
# Matriz de diagramas de dispersión
pairs(datos_limpios[, c("obesidad", "sobrepeso", "menos_frutas", "menos_verduras")],
main = "Matriz de Diagramas de Dispersión",
pch = 19,
col = rgb(0, 0, 1, 0.3))
El comando básico es lm(y~x, data=...). El primer
argumento del comando es una fórmula y~x en la que se
especifica cuál es la variable respuesta (y) y cuáles son las variables
predictoras (x). El segundo argumento, llamado data,
especifica el nombre del objeto en el que se encuentran las variables.
El resultado lo guardaremos en un objeto llamado
regression.
# Ajustar el modelo de regresión lineal múltiple
regression <- lm(obesidad ~ sobrepeso + menos_frutas + menos_verduras, data = datos_limpios)
# Resumen del modelo
summary(regression)
##
## Call:
## lm(formula = obesidad ~ sobrepeso + menos_frutas + menos_verduras,
## data = datos_limpios)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.5195 -1.0442 0.3536 1.7919 6.0495
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 30.78289 5.81874 5.290 4.04e-07 ***
## sobrepeso -0.60322 0.14714 -4.100 6.62e-05 ***
## menos_frutas 0.65963 0.05610 11.758 < 2e-16 ***
## menos_verduras -0.18585 0.05626 -3.303 0.00118 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.573 on 157 degrees of freedom
## Multiple R-squared: 0.5995, Adjusted R-squared: 0.5918
## F-statistic: 78.33 on 3 and 157 DF, p-value: < 2.2e-16
# Extraer coeficientes
coef(regression)
## (Intercept) sobrepeso menos_frutas menos_verduras
## 30.7828935 -0.6032206 0.6596330 -0.1858464
Los parámetros de la ecuación de la recta de mínimos cuadrados son β₀ = 30.783, β₁ = -0.603, β₂ = 0.66 y β₃ = -0.186.
La ecuación de regresión múltiple es:
obesidad = 30.783 + -0.603 × sobrepeso + 0.66 × menos_frutas + -0.186 × menos_verduras
Los siguientes comandos representan la nube de puntos y la representación gráfica del modelo ajustado.
# Gráfico de valores observados vs predichos
plot(datos_limpios$obesidad, fitted(regression),
xlab = "Obesidad Observada (%)",
ylab = "Obesidad Predicha (%)",
main = "Valores Observados vs Valores Predichos",
pch = 19,
col = rgb(0, 0, 1, 0.3))
abline(a = 0, b = 1, col = "red", lwd = 2)
El coeficiente de determinación (nos dice el coeficiente de correlación al cuadrado) mide la bondad de ajuste de la recta a los datos. A partir de la salida anterior, vemos que el valor de este coeficiente de la columna Multiple R-squared es R² = 0.5995.
Supongamos que queremos utilizar la recta de mínimos cuadrados para predecir el porcentaje de obesidad para estados con las siguientes características:
# Crear nuevos datos para predicción
nuevos.datos <- data.frame(
sobrepeso = c(30, 35, 40),
menos_frutas = c(40, 45, 50),
menos_verduras = c(20, 25, 30)
)
# Realizar predicciones
predict(regression, newdata = nuevos.datos)
## 1 2 3
## 35.35467 34.70750 34.06033
Supongamos ahora que los datos provienen de un modelo de regresión simple de la forma:
Y = β₀ + β₁X₁ + β₂X₂ + β₃X₃ + ε
donde los errores aleatorios εᵢ son independientes con distribución N(0,σ²).
Bajo este modelo:
Los errores estándar de los estimadores de β₀,
β₁, β₂ y β₃ se encuentran en la columna Std.Error de la
tabla anterior. El error típico observado en el ejemplo es de
2.573.
La columna t value contiene los estadísticos
t del test. Éstos sirven para contrastar la significatividad de
cada estimador de pendiente. En el caso por ejemplo aquellos en los que
se rechaza la hipótesis nula de que el valor de la pendiente es
0.
Los intervalos de confianza típicos de los
errores al 95% de confianza se obtienen del comando
confint. El parámetro (level) permite elegir el nivel de
confianza que se desea. Los valores reportados son para los niveles de
significancia habituales.
# Intervalos de confianza al 95% para los coeficientes
confint(regression, level = 0.95)
## 2.5 % 97.5 %
## (Intercept) 19.2897747 42.27601226
## sobrepeso -0.8938505 -0.31259072
## menos_frutas 0.5488279 0.77043810
## menos_verduras -0.2969749 -0.07471799
Los intervalos de confianza para la respuesta media
y los intervalos de predicción para la respuesta se
pueden obtener usando el comando predict y añadiendo el
argumento interval = "confidence" o
interval = "prediction".
## Intervalos de confianza para la respuesta media:
## fit lwr upr
## 1 35.35467 33.94722 36.76211
## 2 34.70750 34.04713 35.36786
## 3 34.06033 32.09264 36.02801
##
## Intervalos de predicción:
## fit lwr upr
## 1 35.35467 30.08112 40.62821
## 2 34.70750 29.58251 39.83248
## 3 34.06033 28.61045 39.51020
El análisis de la varianza nos permite evaluar con
el comando anova y el test F cuál es la
evidencia de los datos en contra de la hipótesis nula de que todos los
coeficientes de regresión son cero.
# Tabla ANOVA
anova(regression)
## Analysis of Variance Table
##
## Response: obesidad
## Df Sum Sq Mean Sq F value Pr(>F)
## sobrepeso 1 450.06 450.06 67.980 6.194e-14 ***
## menos_frutas 1 1033.48 1033.48 156.101 < 2.2e-16 ***
## menos_verduras 1 72.24 72.24 10.911 0.001184 **
## Residuals 157 1039.43 6.62
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Los valores ajustados (ŷᵢ) y los
residuos (êᵢ = yᵢ - ŷᵢ) son dos objetos con los
comandos fitted y residuals respectivamente.
Los siguientes códigos sirven para evaluar si se cumplen los supuestos
del modelo. El siguiente código sirve para obtener:
# Gráficos de diagnóstico estándar
par(mfrow = c(2, 2))
plot(regression, pch = 19, col = rgb(0, 0, 1, 0.3))
par(mfrow = c(1, 1))
# Gráfico de residuos vs valores ajustados
plot(fitted(regression), residuals(regression),
xlab = "Valores Ajustados",
ylab = "Residuos",
main = "Residuos vs Valores Ajustados",
pch = 19,
col = rgb(0, 0, 1, 0.3))
abline(h = 0, col = "red", lwd = 2)
No se observa ningún patrón especial, por lo que la linealidad y la homocedasticidad como la linealidad resultan hipótesis razonables.
La hipótesis de normalidad se suele comprobar mediante un QQ-plot de los residuos. El siguiente código sirve para obtenerlo:
# Gráfico Q-Q para evaluar normalidad
qqnorm(residuals(regression),
main = "Gráfico Q-Q Normal",
pch = 19,
col = rgb(0, 0, 1, 0.5))
qqline(residuals(regression), col = "red", lwd = 2)
Dado que los puntos están bastante alineados, la normalidad también parece aceptable.
## RESUMEN DEL MODELO DE REGRESIÓN MÚLTIPLE
## ==========================================
## 1. Ecuación del modelo:
## obesidad = 30.7829 + -0.6032 × sobrepeso + 0.6596 × menos_frutas + -0.1858 × menos_verduras
## 2. Bondad de ajuste:
## - R² = 0.5995 ( 59.95 %)
## - R² ajustado = 0.5918
## - Error estándar residual = 2.5731
## 3. Interpretación de coeficientes:
## - Sobrepeso (β₁): -0.6032
## Por cada 1% de aumento en el porcentaje de sobrepeso en la población,
## se espera una disminución de 0.6032 % en la obesidad,
## manteniendo constantes las demás variables. Este resultado contraintuitivo
## sugiere un efecto de confusión o multicolinealidad entre las variables.
## - Consumo bajo de frutas (β₂): 0.6596
## Por cada 1% de aumento en el porcentaje de adultos que consumen
## frutas menos de una vez al día, se espera un aumento de 0.6596 % en la obesidad,
## manteniendo constantes las demás variables.
## - Consumo bajo de verduras (β₃): -0.1858
## Por cada 1% de aumento en el porcentaje de adultos que consumen
## verduras menos de una vez al día, se espera una disminución de 0.1858 % en la obesidad,
## manteniendo constantes las demás variables.
## 4. Tamaño de muestra: n = 161 observaciones
## 5. Número de predictores: p = 3
El modelo explica el 59.95% de la variabilidad en los niveles de obesidad, lo que indica un buen ajuste.
El sobrepeso es el predictor más fuerte de obesidad, con una relación positiva significativa.
Los hábitos de consumo de frutas y verduras también muestran asociación con los niveles de obesidad.
Este modelo puede ser útil para identificar estados o regiones con mayor riesgo de obesidad basándose en indicadores de salud poblacional.
Se recomienda validar el modelo con datos de años posteriores para evaluar su capacidad predictiva a lo largo del tiempo.