NHANES III (1988–94) gave a Simple Reaction Time Test to a half-sample of adults aged ~20–59 as part of its neurobehavioral module. Unlike the published summaries, the raw file stores every one of the 50 trials per person, so we can characterise each person’s reaction-time distribution — not just their average — and ask how those distributions differ across the survey’s race/ethnicity groups (White, Black, Mexican-American, Other).
We keep all 50 trials (dropping only the
8888 missing-data code — no warm-up trimming and no
validity window) as the main specification, and treat the conventional
exclusion rules as a robustness check. A few complex cognitive tests
(adults and children) are added at the end for context.
The exam file is a fixed-width record; the trial RTs and covariates are read straight from documented byte positions.
pos <- tibble::tribble(
~name,~s,~e,
"SEQN",1,5,"DMARETHN",12,12,"HSSEX",15,15,"HSAITMOR",19,22,
"CNPTEMP",5513,5515,"CNPLANG",5512,5512,
"WWPMRSR",4421,4423,"WWPRRSR",4424,4426,"WWPBSCSR",4437,4438,"WWPDSCSR",4439,4440,
"CNPCBEST",5982,5986,"CNPTTSCR",5998,5999) |>
bind_rows(tibble(name = sprintf("CNPRT%02d", 1:50), s = 5522 + (0:49)*4, e = 5525 + (0:49)*4)) |>
arrange(s)
raw <- read_fwf("data/III/exam.dat", fwf_positions(pos$s, pos$e, pos$name),
col_types = cols(.default = "c"), na = c("", "."))
num <- raw |> mutate(across(everything(), ~ suppressWarnings(as.numeric(.x))))
nif <- function(x, codes) ifelse(x %in% codes, NA, x)
base <- num |> transmute(
SEQN,
age = ifelse(HSAITMOR <= 1079, HSAITMOR/12, NA_real_),
sex = factor(HSSEX, 1:2, c("Male","Female")),
race = relevel(factor(DMARETHN, 1:4, c("White","Black","MexAm","Other")), "White"),
temp = nif(CNPTEMP, 888),
cns_lang = dplyr::case_when(CNPLANG == 1 ~ "English", CNPLANG == 2 ~ "Spanish", TRUE ~ NA_character_),
sdst = nif(CNPCBEST, 88888), sdlt = nif(CNPTTSCR, 88),
wrat_math = nif(WWPMRSR, 888), wrat_read = nif(WWPRRSR, 888),
block = nif(WWPBSCSR, 88), dspan = nif(WWPDSCSR, 88))
trials <- num |> dplyr::select(SEQN, dplyr::all_of(sprintf("CNPRT%02d", 1:50)))
For every person we compute eight summaries of their own 50 trials: the mean, median, slowest-20% mean, fastest-20% mean, between-trial SD, MAD, coefficient of variation (CV = SD/mean, ×100), and the ex-Gaussian τ (a moment-based estimate of the slow tail).
mom_tau <- function(x){ s <- sd(x); g <- mean((x-mean(x))^3)/s^3
if (is.na(g) || g <= 0) return(NA_real_); s*(g/2)^(1/3) }
metms <- trials |>
pivot_longer(-SEQN, names_to = "tr", values_to = "rt") |>
dplyr::filter(rt != 8888, !is.na(rt)) |>
group_by(SEQN) |> dplyr::filter(n() >= 40) |>
summarise(mean = mean(rt), median = median(rt),
slow20 = mean(rt[rt >= quantile(rt, .8)]),
fast20 = mean(rt[rt <= quantile(rt, .2)]),
SD = sd(rt), MAD = mad(rt), CV = 100*sd(rt)/mean(rt),
tau = mom_tau(rt), .groups = "drop")
D <- base |> inner_join(metms, "SEQN") |>
dplyr::filter(!is.na(race), age >= 20, age < 60)
mets <- c("mean","median","slow20","fast20","SD","MAD","CV","tau")
mklab <- c(mean="Mean RT", median="Median RT", slow20="Slowest-20% mean",
fast20="Fastest-20% mean", SD="Between-trial SD", MAD="MAD",
CV="CV", tau="ex-Gaussian tau")
unit <- c(mean="ms",median="ms",slow20="ms",fast20="ms",SD="ms",MAD="ms",CV="%",tau="ms")
Sample sizes (adults 20–59 with valid reaction-time data):
D |> count(race) |> flextable() |> autofit()
race | n |
|---|---|
White | 1,818 |
Black | 1,606 |
MexAm | 1,529 |
Other | 185 |
Each person is really a distribution of reaction times, and that distribution is right-skewed: most responses cluster tightly, with an occasional slow “lapse” trailing off to the right. That skew is why the mean sits above the median.
complete <- trials$SEQN[apply(as.matrix(trials[,-1]), 1,
function(r) all(!is.na(r)) & all(r != 8888) & all(r < 3000))]
sj <- 45363
v <- as.numeric(trials[trials$SEQN == sj, -1]); v <- v[v != 8888]
mu <- mean(v); md <- median(v); q80 <- as.numeric(quantile(v, .8)); mx <- max(v)
ggplot(data.frame(rt = v), aes(rt)) +
annotate("rect", xmin = q80, xmax = mx+22, ymin = 0, ymax = Inf, fill = "#eb6834", alpha = .10) +
annotate("text", x = (q80+mx)/2+6, y = Inf, vjust = 1.6, label = "slowest 20%", colour = "#c2531f", size = 3.2) +
geom_histogram(binwidth = 25, boundary = 0, fill = "#2a78d6", colour = "white", alpha = .85) +
geom_rug(sides = "b", colour = "#1a1a1a", alpha = .55, length = unit(.035, "npc")) +
geom_vline(xintercept = md, colour = "#111", linewidth = .7) +
geom_vline(xintercept = mu, colour = "#c0392b", linewidth = .7, linetype = "22") +
annotate("text", x = md-8, y = Inf, vjust = 2, hjust = 1, label = sprintf("median %d ms", round(md)), size = 3.3) +
annotate("text", x = mu+8, y = Inf, vjust = 2, hjust = 0, label = sprintf("mean %d ms", round(mu)), size = 3.3) +
labs(x = "Reaction time (ms) — all 50 trials, no exclusions", y = "Number of trials",
title = "One person's simple reaction time: 50 trials",
subtitle = "Black solid = median, red dashed = mean. A slow lapse (~1000 ms) pulls the mean above the median.")
Nine people at once — note how much they differ in speed, spread, skew, and in whether they throw the odd very-slow lapse:
first9 <- head(complete, 9)
d9 <- trials[trials$SEQN %in% first9, ] |>
pivot_longer(-SEQN, values_to = "rt") |> dplyr::filter(rt != 8888) |> dplyr::select(SEQN, rt)
d9$SEQN <- factor(d9$SEQN, levels = first9)
st <- d9 |> group_by(SEQN) |> summarise(mean = mean(rt), median = median(rt), .groups = "drop")
lab9 <- setNames(sprintf("subj %s mean %d · median %d", st$SEQN, round(st$mean), round(st$median)), st$SEQN)
ggplot(d9, aes(rt)) +
geom_histogram(binwidth = 25, boundary = 0, fill = "#2a78d6", colour = "white", alpha = .85) +
geom_rug(sides = "b", colour = "#1a1a1a", alpha = .5, length = unit(.05, "npc")) +
geom_vline(data = st, aes(xintercept = median), colour = "#111", linewidth = .6) +
geom_vline(data = st, aes(xintercept = mean), colour = "#c0392b", linewidth = .6, linetype = "22") +
facet_wrap(~SEQN, ncol = 3, scales = "free", labeller = labeller(SEQN = lab9)) +
labs(x = "Reaction time (ms) — all 50 trials", y = "Number of trials",
title = "Nine people's reaction time distributions (50 trials each)",
subtitle = "Black solid = median, red dashed = mean; each panel has its own x-scale.")
People start slower and speed up over the first ~10 trials, then plateau — a warm-up effect. This is exactly what the conventional scoring throws away by dropping the first ten trials; we keep them. Not everyone improves (some drift slower), and the size of the warm-up varies a lot.
d9t <- trials[trials$SEQN %in% first9, ] |>
pivot_longer(-SEQN, names_to = "tr", values_to = "rt") |>
mutate(trial = as.integer(sub("CNPRT","",tr))) |>
dplyr::filter(rt != 8888) |> dplyr::select(SEQN, trial, rt)
d9t$SEQN <- factor(d9t$SEQN, levels = first9)
imp <- d9t |> group_by(SEQN) |>
summarise(pct = round((1 - exp(coef(lm(log(rt) ~ trial))[2] * 49)) * 100, 0), .groups = "drop")
labL <- setNames(sprintf("subj %s %+0.0f%% faster (trial 1->50)", imp$SEQN, imp$pct), imp$SEQN)
ggplot(d9t, aes(trial, rt)) +
geom_line(colour = "#bcd3ee", linewidth = .4) +
geom_point(colour = "#2a78d6", size = 1.1, alpha = .85) +
geom_smooth(method = "loess", span = .9, se = FALSE, colour = "#c0392b", linewidth = .9) +
facet_wrap(~SEQN, ncol = 3, scales = "free_y", labeller = labeller(SEQN = labL)) +
scale_x_continuous(breaks = c(1,10,20,30,40,50)) +
labs(x = "Trial number (1-50, in order taken)", y = "Reaction time (ms)",
title = "Learning within one session: reaction time across 50 trials",
subtitle = "Dots = trials in order; red line = smoothed trend. Most speed up over the first ~10 trials.")
DL <- D |> dplyr::filter(race != "Other") |>
dplyr::select(race, all_of(mets)) |>
pivot_longer(-race, names_to = "metric", values_to = "val")
labs8 <- setNames(paste0(mklab, " (", unit, ")"), mets)
DL$metric <- factor(DL$metric, levels = mets, labels = labs8)
ggplot(DL, aes(val, colour = race, fill = race)) +
geom_density(alpha = .12, linewidth = .8, na.rm = TRUE) +
facet_wrap(~metric, scales = "free", ncol = 4) +
scale_colour_manual(values = pal, name = NULL, aesthetics = c("colour","fill")) +
labs(x = NULL, y = "density",
title = "Simple reaction time — distributions by race (adults 20-59, all 50 trials)") +
theme(legend.position = "top", strip.text = element_text(face = "bold", size = 9.5))
On every metric the White distribution sits to the left (faster) and is tighter; the Black and Mexican-American distributions shift right and spread, most on the dispersion metrics.
For each metric we report the group mean (the between-person average of each person’s own metric), then the gap versus White in raw units and in White-SD units (Cohen’s d, with White between-person SD as the standardiser; +d = slower / more variable).
rmu <- function(g, m) mean(D[[m]][D$race == g], na.rm = TRUE)
wsd <- sapply(mets, function(m) sd(D[[m]][D$race == "White"], na.rm = TRUE))
gap_rows <- lapply(mets, function(m){
w <- rmu("White", m); b <- rmu("Black", m); x <- rmu("MexAm", m)
data.frame(Metric = paste0(mklab[m], " (", unit[m], ")"),
White = round(w,1), Black = round(b,1), `Mex-Am` = round(x,1),
`Black raw` = round(b-w,1), `Black d` = round((b-w)/wsd[m],2),
`Mex-Am raw` = round(x-w,1), `Mex-Am d` = round((x-w)/wsd[m],2),
check.names = FALSE) })
gap_tab <- do.call(rbind, gap_rows)
flextable(gap_tab) |>
add_header_row(values = c("", "Metric mean by race", "Gap vs White"), colwidths = c(1,3,4)) |>
align(j = 2:8, align = "center", part = "all") |> autofit()
Metric mean by race | Gap vs White | ||||||
|---|---|---|---|---|---|---|---|
Metric | White | Black | Mex-Am | Black raw | Black d | Mex-Am raw | Mex-Am d |
Mean RT (ms) | 241.9 | 267.8 | 269.8 | 25.9 | 0.57 | 28.0 | 0.61 |
Median RT (ms) | 224.3 | 245.5 | 243.3 | 21.3 | 0.51 | 19.0 | 0.45 |
Slowest-20% mean (ms) | 339.4 | 391.8 | 408.9 | 52.4 | 0.57 | 69.5 | 0.76 |
Fastest-20% mean (ms) | 189.9 | 201.8 | 199.8 | 11.9 | 0.41 | 9.9 | 0.34 |
Between-trial SD (ms) | 74.0 | 93.4 | 103.4 | 19.3 | 0.41 | 29.3 | 0.62 |
MAD (ms) | 33.1 | 41.5 | 42.7 | 8.3 | 0.49 | 9.6 | 0.57 |
CV (%) | 29.9 | 34.3 | 37.4 | 4.4 | 0.27 | 7.5 | 0.46 |
ex-Gaussian tau (ms) | 85.2 | 105.2 | 118.3 | 20.0 | 0.31 | 33.2 | 0.52 |
The gap is ~0.5–0.6 SD on the central-tendency metrics, and it is largest on the slow tail (slowest-20%) and smallest on the fast end — the “worst-performance” pattern. The Black gap is fairly uniform across the distribution (its CV gap is small, i.e. mostly a shift), whereas the Mexican-American gap carries more genuine extra variability (see caveat below).
Does the gap survive controls? We fit, for each
metric, a model
metric ~ ns(age,3) + sex + temp + race; the
race coefficient is the adjusted gap in raw units, which we
standardise by the White residual SD of that metric.
Adjusting each metric directly (rather than residualising the raw RTs)
is necessary, because age/sex/temp are between-person and would leave
the within-person dispersion metrics unchanged.
Dm <- D |> dplyr::filter(!is.na(age), !is.na(sex), !is.na(temp))
adj_rows <- lapply(mets, function(m){
w <- Dm[[m]][Dm$race == "White"]; sdw <- sd(w, na.rm = TRUE)
rawB <- (mean(Dm[[m]][Dm$race=="Black"], na.rm=TRUE) - mean(w, na.rm=TRUE))/sdw
rawM <- (mean(Dm[[m]][Dm$race=="MexAm"], na.rm=TRUE) - mean(w, na.rm=TRUE))/sdw
f <- lm(reformulate(c("ns(age,3)","sex","temp","race"), m), Dm, na.action = na.exclude)
b <- coef(f); sdwr <- sd(residuals(f)[Dm$race == "White"], na.rm = TRUE)
data.frame(Metric = mklab[m],
`Black raw d` = round(rawB,2), `Black adj d` = round(b["raceBlack"]/sdwr,2),
`Mex-Am raw d` = round(rawM,2), `Mex-Am adj d` = round(b["raceMexAm"]/sdwr,2),
check.names = FALSE) })
flextable(do.call(rbind, adj_rows)) |>
add_header_row(values = c("", "Black", "Mexican-American"), colwidths = c(1,2,2)) |>
align(j = 2:5, align = "center", part = "all") |> autofit()
Black | Mexican-American | |||
|---|---|---|---|---|
Metric | Black raw d | Black adj d | Mex-Am raw d | Mex-Am adj d |
Mean RT | 0.55 | 0.58 | 0.57 | 0.63 |
Median RT | 0.50 | 0.51 | 0.43 | 0.47 |
Slowest-20% mean | 0.57 | 0.62 | 0.69 | 0.78 |
Fastest-20% mean | 0.40 | 0.41 | 0.34 | 0.37 |
Between-trial SD | 0.42 | 0.46 | 0.61 | 0.68 |
MAD | 0.51 | 0.53 | 0.53 | 0.59 |
CV | 0.28 | 0.31 | 0.46 | 0.52 |
ex-Gaussian tau | 0.31 | 0.35 | 0.52 | 0.57 |
Adjustment barely moves the reaction-time gaps (each metric shifts by ≤0.07 d, always slightly up because removing sex/temp shrinks the White residual SD). The gaps are not an artefact of age, sex, or testing-room temperature.
For context, the same White-referenced Cohen’s d (raw and age+sex-adjusted; +d = minority disadvantage) on every cognitive test in NHANES III — the adult neurobehavioral tests and the children’s WISC-R / WRAT battery. Simple RT uses each person’s mean over all 50 trials.
adult <- base |> dplyr::filter(age >= 20, age < 60, !is.na(race)) |>
left_join(D |> dplyr::select(SEQN, srt_mean = mean), "SEQN")
child <- base |> dplyr::filter(age >= 6, age < 17, !is.na(race))
dd <- function(df, y, dir){
df <- df[!is.na(df[[y]]) & !is.na(df$age) & !is.na(df$sex), ]
w <- df[[y]][df$race == "White"]; sdw <- sd(w)
rB <- dir*(mean(df[[y]][df$race=="Black"]) - mean(w))/sdw
rM <- dir*(mean(df[[y]][df$race=="MexAm"]) - mean(w))/sdw
f <- lm(reformulate(c("ns(age,3)","sex","race"), y), df, na.action = na.exclude); b <- coef(f)
sdwr <- sd(residuals(f)[df$race == "White"], na.rm = TRUE)
data.frame(n = nrow(df), `Black raw d` = round(rB,2), `Black adj d` = round(dir*unname(b["raceBlack"])/sdwr,2),
`Mex-Am raw d` = round(rM,2), `Mex-Am adj d` = round(dir*unname(b["raceMexAm"])/sdwr,2),
check.names = FALSE) }
tests <- list(list("Simple RT — mean (adult)", adult, "srt_mean", 1),
list("Symbol-Digit latency (adult)", adult, "sdst", 1),
list("Serial Digit Learning (adult)", adult, "sdlt", 1),
list("Digit Span (child)", child, "dspan", -1),
list("Block Design (child)", child, "block", -1),
list("WRAT Math (child)", child, "wrat_math", -1),
list("WRAT Reading (child)", child, "wrat_read", -1))
all_tab <- do.call(rbind, lapply(tests, function(t) cbind(Test = t[[1]], dd(t[[2]], t[[3]], t[[4]]))))
flextable(all_tab) |>
add_header_row(values = c("","","Black","Mexican-American"), colwidths = c(1,1,2,2)) |>
align(j = 2:6, align = "center", part = "all") |> autofit()
Black | Mexican-American | ||||
|---|---|---|---|---|---|
Test | n | Black raw d | Black adj d | Mex-Am raw d | Mex-Am adj d |
Simple RT — mean (adult) | 5,138 | 0.57 | 0.63 | 0.61 | 0.73 |
Symbol-Digit latency (adult) | 5,077 | 0.67 | 1.00 | 0.90 | 1.30 |
Serial Digit Learning (adult) | 4,962 | 0.59 | 0.70 | 0.96 | 1.12 |
Digit Span (child) | 5,031 | 0.41 | 0.41 | 0.65 | 0.66 |
Block Design (child) | 5,034 | 0.91 | 0.91 | 0.42 | 0.42 |
WRAT Math (child) | 5,079 | 0.38 | 0.58 | 0.36 | 0.50 |
WRAT Reading (child) | 5,060 | 0.44 | 0.61 | 0.47 | 0.63 |
Two things to keep in mind reading this table: (1) the adjusted d rises most for the age-sensitive tests (Symbol-Digit, Serial Learning) because removing age shrinks the White residual SD — the raw column is the cleaner cross-test comparison; and (2) the gaps grow with the cognitive complexity of the task, with simple reaction time at the low end.
About 41% of Mexican-American adults took the neurobehavioral battery in Spanish (no White or Black examinee did). Splitting the Mexican-American group by administration language — each subgroup compared to the all-English White reference, age+sex-adjusted — decomposes the gap.
adult_l <- adult |> dplyr::filter(race %in% c("White","MexAm"))
dd_lang <- function(y, dir){
df <- adult_l |> dplyr::filter(!is.na(.data[[y]]), !is.na(age), !is.na(sex)) |>
dplyr::filter(race == "White" | !is.na(cns_lang))
df$rl <- factor(dplyr::case_when(df$race == "White" ~ "White",
df$cns_lang == "English" ~ "MexAm_Eng", df$cns_lang == "Spanish" ~ "MexAm_Spa"),
levels = c("White","MexAm_Eng","MexAm_Spa"))
f <- lm(reformulate(c("ns(age,3)","sex","rl"), y), df, na.action = na.exclude); b <- coef(f)
sdwr <- sd(residuals(f)[df$rl == "White"], na.rm = TRUE)
data.frame(`English n` = sum(df$rl=="MexAm_Eng"), `English adj d` = round(dir*unname(b["rlMexAm_Eng"])/sdwr,2),
`Spanish n` = sum(df$rl=="MexAm_Spa"), `Spanish adj d` = round(dir*unname(b["rlMexAm_Spa"])/sdwr,2),
check.names = FALSE) }
lang_tab <- rbind(
cbind(Test = "Simple RT — mean", dd_lang("srt_mean", 1)),
cbind(Test = "Symbol-Digit latency", dd_lang("sdst", 1)),
cbind(Test = "Serial Digit Learning", dd_lang("sdlt", 1)))
flextable(lang_tab) |>
add_header_row(values = c("", "Mex-Am English-administered", "Mex-Am Spanish-administered"), colwidths = c(1,2,2)) |>
align(j = 2:5, align = "center", part = "all") |> autofit()
Mex-Am English-administered | Mex-Am Spanish-administered | |||
|---|---|---|---|---|
Test | English n | English adj d | Spanish n | Spanish adj d |
Simple RT — mean | 905 | 0.39 | 621 | 1.19 |
Symbol-Digit latency | 896 | 0.66 | 601 | 2.20 |
Serial Digit Learning | 867 | 0.70 | 564 | 1.75 |
The Spanish-administered subgroup carries almost the entire Mexican-American gap (roughly 2.5–3× the English-administered gap on every test). This holds even on Simple Reaction Time, which requires no language at all. Language of administration is itself partly a consequence of nativity / acculturation / SES, so this is a descriptive decomposition rather than a clean adjustment; readers can draw their own conclusions.
sessionInfo()
## R version 4.6.1 (2026-06-24)
## Platform: x86_64-pc-linux-gnu
## Running under: Linux Mint 22.3
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.12.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.12.0 LAPACK version 3.12.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=en_DK.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=en_DK.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_DK.UTF-8 LC_IDENTIFICATION=C
##
## time zone: Europe/Copenhagen
## tzcode source: system (glibc)
##
## attached base packages:
## [1] grid splines stats graphics grDevices utils datasets
## [8] methods base
##
## other attached packages:
## [1] flextable_0.10.0 ggplot2_4.0.3 tidyr_1.3.2 dplyr_1.2.1
## [5] readr_2.2.0
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.10 generics_0.1.4 fontLiberation_0.1.0
## [4] xml2_1.5.2 lattice_0.22-9 hms_1.1.4
## [7] digest_0.6.39 magrittr_2.0.5 evaluate_1.0.5
## [10] RColorBrewer_1.1-3 fastmap_1.2.0 Matrix_1.7-5
## [13] jsonlite_2.0.0 zip_2.3.3 mgcv_1.9-4
## [16] purrr_1.2.2 scales_1.4.0 fontBitstreamVera_0.1.1
## [19] codetools_0.2-20 textshaping_1.0.5 jquerylib_0.1.4
## [22] cli_3.6.6 crayon_1.5.3 rlang_1.2.0
## [25] fontquiver_0.2.1 bit64_4.8.2 withr_3.0.2
## [28] cachem_1.1.0 yaml_2.3.12 otel_0.2.0
## [31] gdtools_0.5.1 parallel_4.6.1 tools_4.6.1
## [34] officer_0.7.6 tzdb_0.5.0 uuid_1.2-2
## [37] vctrs_0.7.3 R6_2.6.1 lifecycle_1.0.5
## [40] bit_4.6.0 vroom_1.7.1 ragg_1.5.2
## [43] pkgconfig_2.0.3 pillar_1.11.1 bslib_0.11.0
## [46] gtable_0.3.6 glue_1.8.1 data.table_1.18.4
## [49] Rcpp_1.1.1-1.1 systemfonts_1.3.2 xfun_0.57
## [52] tibble_3.3.1 tidyselect_1.2.1 knitr_1.51
## [55] farver_2.1.2 nlme_3.1-170 patchwork_1.3.2
## [58] htmltools_0.5.9 labeling_0.4.3 rmarkdown_2.31
## [61] compiler_4.6.1 S7_0.2.2 askpass_1.2.1
## [64] openssl_2.4.1