You're outside a coffee shop, measuring each adult who walks out — watching for the moment the crowd stops being the same crowd.
Measure adults one at a time as they leave the shop. Watch the average settle.
You're standing outside a coffee shop. Adults walk out one at a time, and you measure each one's height. The blue line is your running average so far; the shaded band around it is how unsure you still are about that average.
Measure a batch, and watch what the line and the band do.
# Measure adults one at a time; track the running average# and a band showing how unsure you still are about it.set.seed(42)heights <- rnorm(400, mean = 168, sd = 10)running <- cumsum(heights) / seq_along(heights)# resample to see how far the average could still wobbleband <- sapply(seq_along(heights), function(k) { avgs <- replicate(200, mean(sample(heights[1:k], k, replace = TRUE))) diff(quantile(avgs, c(0.025, 0.975)))})plot(running, type = "l", xlab = "people measured", ylab = "running average")
Keep measuring. Somewhere in here, a whole group arrives together.
You keep measuring people as they leave. Partway through, a bus pulls up and a group gets off and files into the shop — you're not told when. You just keep measuring whoever comes out.
The faint red line marks where your average sat before anything changed. Watch the blue line and the band. Your job: notice when the crowd stops being the same crowd.
# Same stream, but partway through the crowd changes.set.seed(42)before <- rnorm(90, mean = 168, sd = 10) # the regularsafter <- rnorm(210, mean = 188, sd = 10) # the group off the busheights <- c(before, after) # you don't know where the seam isrunning <- cumsum(heights) / seq_along(heights)plot(running, type = "l", xlab = "people measured", ylab = "running average")abline(h = mean(before), col = "red", lty = 2) # where it started
Now you make the call. The more different the newcomers, the sooner you'll know.
Same coffee shop, but now you decide the moment. Pick who's on the bus, let people start coming out, and hit The crowd just changed the instant you're convinced. Call it too soon and you'll have been fooled by ordinary wobble; wait too long and you were slow.
Line up your rounds. When the bus was very different from the regulars, how many people did it take you to call it? When the difference was small? Hold onto what that says about catching a small change versus a big one.
# Let people come out; call it when the average has clearly left home.diff_cm <- 12 # how different the bus group isbefore <- rnorm(switch_at, 168, 10)after <- rnorm(200, 168 + diff_cm, 10)
For real this time. Build the two crowds yourself, one person at a time.
Real people now. The regulars are ordinary adults; the bus was a pro basketball team. Draw one of each at a time and let the two crowds build up on the plot.
nh <- read.csv("data/clean/nhanes_adults.csv")$Heightnba <- read.csv("data/clean/nba_players.csv")$height_in * 2.54mean(nba) - mean(nh) # gap between the crowdsmean(nh > median(nba)) # fraction of adults above a typical playerhist(nh, col = rgb(.5, .5, .5, .4), border = NA, xlim = c(140, 220))hist(nba, col = rgb(.18, .42, .56, .5), border = NA, add = TRUE)