Preliminary Analysis: Income and BMI Patterns

Question

How does mean BMI differ across income groups among adults age 20-80 in the prepared NHANES Health Equity classroom dataset?

Setup

library(tidyverse)
library(knitr)

nhanes <- read_csv("data/nhanes_equity_v6.csv", show_col_types = FALSE)

Cohort

We restricted the prepared file to records with age from 20 through 80, inclusive. Missing BMI and income group were counted before complete-case rows were selected for the grouped results.

adult_cohort <- nhanes |>
  filter(Age >= 20, Age <= 80)

cohort_counts <- tibble(
  step = c("Prepared file", "After age 20-80 restriction"),
  n = c(nrow(nhanes), nrow(adult_cohort))
)

kable(cohort_counts)

step	n
Prepared file	105626
After age 20-80 restriction	57137

Missingness

key_vars <- c("BMI", "Age", "IncomeGroup", "Gender", "Race", "Cycle")

missingness <- tibble(variable = key_vars) |>
  mutate(
    missing_n = vapply(
      adult_cohort[key_vars],
      function(x) sum(is.na(x)),
      numeric(1)
    ),
    missing_percent = round(100 * missing_n / nrow(adult_cohort), 1)
  )

write_csv(
  missingness,
  "milestones/m2-preliminary-analysis/submission/missingness-summary.csv"
)

kable(missingness)

variable	missing_n	missing_percent
BMI	1009	1.8
Age	0	0.0
IncomeGroup	5395	9.4
Gender	0	0.0
Race	0	0.0
Cycle	0	0.0

Table 1-style summary

For a consistent denominator, the table uses rows with non-missing age, BMI, and income group after the age restriction.

complete_analysis <- adult_cohort |>
  filter(!is.na(Age), !is.na(BMI), !is.na(IncomeGroup))

table1 <- complete_analysis |>
  group_by(IncomeGroup) |>
  summarise(
    N = n(),
    `BMI, mean (SD)` = sprintf("%.1f (%.1f)", mean(BMI), sd(BMI)),
    `Age, mean (SD)` = sprintf("%.1f (%.1f)", mean(Age), sd(Age)),
    .groups = "drop"
  )

write_csv(
  table1,
  "milestones/m2-preliminary-analysis/submission/table1.csv"
)

kable(table1)

IncomeGroup	N	BMI, mean (SD)	Age, mean (SD)
High Income (>3.5)	16330	28.6 (6.3)	49.6 (15.9)
Low Income (<1.3)	15293	29.4 (7.5)	47.2 (18.1)
Middle Income	19228	29.3 (7.0)	49.8 (18.3)

Preliminary figure

cycle_summary <- complete_analysis |>
  filter(!is.na(Cycle)) |>
  group_by(Cycle, IncomeGroup) |>
  summarise(
    n = n(),
    mean_bmi = mean(BMI),
    .groups = "drop"
  ) |>
  filter(n >= 30)

ggplot(
  cycle_summary,
  aes(x = Cycle, y = mean_bmi, color = IncomeGroup, group = IncomeGroup)
) +
  geom_line(linewidth = 0.9) +
  geom_point(size = 2) +
  scale_color_brewer(palette = "Dark2") +
  expand_limits(y = 0) +
  labs(
    title = "Mean BMI by income group across NHANES cycle",
    subtitle = "Adults age 20-80; prepared classroom data",
    x = "NHANES cycle",
    y = "Mean BMI (kg/m²)",
    color = "Income group"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "bottom"
  )

Mean BMI by income group across available NHANES cycles among complete adult records. Values are unweighted and descriptive.

Interpretation

Mean BMI is slightly lower in the high-income group than in the low- and middle-income groups in this prepared dataset. The cycle-specific summaries vary, but this early figure is mainly useful for checking whether the overall comparison is plausible and worth communicating.

What this analysis cannot claim

The summaries are descriptive and unweighted. They do not account for the NHANES survey design, do not estimate the US adult population, and do not show that income causes BMI differences. Missing BMI or income-group records are not included in the grouped results.