Introducción

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.


Los datos

# 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.

Preparación de los datos

# 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

Estadísticas descriptivas

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

Diagramas de dispersión

# 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))


Cálculo y representación del modelo de regresión múltiple

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

Coeficientes del modelo

# 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


Visualización del modelo

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.


Cálculo de predicciones

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

Inferencia en el modelo de regresión múltiple

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 para los parámetros

# 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

Intervalos de confianza para la respuesta media

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

Tabla de análisis de la varianza

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

Diagnóstico del modelo

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))

Análisis de residuos

# 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:

Normalidad de residuos (QQ-Plot)

# 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.


Conclusiones

Resultados del modelo

## 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

Evaluación de supuestos

  • Linealidad: Los diagramas de dispersión muestran relaciones aproximadamente lineales entre las variables.
  • Homocedasticidad: El gráfico de residuos vs valores ajustados no muestra patrones sistemáticos, lo que indica varianza constante.
  • Normalidad: El gráfico Q-Q muestra que los residuos se distribuyen aproximadamente normal.
  • Independencia: Cada observación corresponde a un estado en un año específico, asumiendo independencia entre observaciones.

Recomendaciones

  1. El modelo explica el 59.95% de la variabilidad en los niveles de obesidad, lo que indica un buen ajuste.

  2. El sobrepeso es el predictor más fuerte de obesidad, con una relación positiva significativa.

  3. Los hábitos de consumo de frutas y verduras también muestran asociación con los niveles de obesidad.

  4. Este modelo puede ser útil para identificar estados o regiones con mayor riesgo de obesidad basándose en indicadores de salud poblacional.

  5. Se recomienda validar el modelo con datos de años posteriores para evaluar su capacidad predictiva a lo largo del tiempo.


Referencias