At the end of the last lesson we tested how well our prediction method worked when we tried adding in a different group. That is what we are going to explore here.
We are going to graph the same kinds of data, slightly differently. For this first graph we are going to explore how our mean changes as we accumulate more data.
From last time, the average was the best single number for predicting a new observation from the same population. We are going to see how adding more data influences how well that single number predicts, and how much error it leaves.
# 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")
At the end of Lesson 1 we applied our one number — the mean — to predict new outcomes, and found that our error had a structure to it: we consistently overestimated the new observations.
We are going to explore something similar with the graph from Part A. This time you will watch the mean change, and at some point the population is going to change too. You will keep tracking the mean, and see how it shifts as the new population begins to outnumber the starting one.
Pay particular attention to the shape of the mean as you accumulate more data.
# 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
nh <- read.csv("data/clean/nhanes_adults.csv")$Heightnba <- read.csv("data/clean/nba_players.csv")$height_in * 2.54# the height where the two crowds are equally densecut <- optimize(function(h) abs(mean(nh > h) - mean(nba < h)), c(150, 220))$minimum# calling every person by that one cut-off(mean(nba > cut) + mean(nh < cut)) / 2
You probably did pretty well at telling basketball players from ordinary adults by height. The difference between them is extremely clear. You likely made one or two errors, but for the most part you got them right — by height alone, the difference is clear.
Now a similar problem. What if the two groups are still clearly different, but the difference is smaller? Here it is the heights of males and females, and based only on height you are trying to predict which an individual is.
Once again there is a solid black line. Once again the two groups have a clear difference in height. And once again you are going to try to call it correctly. The idea is to compare how often you are right assigning male or female by height alone against how often you were right assigning NBA player or not.
nh <- read.csv("data/clean/nhanes_adults.csv")men <- nh$Height[nh$Gender == "male"]women <- nh$Height[nh$Gender == "female"]cut <- optimize(function(h) abs(mean(women > h) - mean(men < h)), c(150, 190))$minimum(mean(men > cut) + mean(women < cut)) / 2# how far apart the crowds sit, in units of their own spread(mean(men) - mean(women)) / sd(nh$Height)
These are two distributions representing the home fans and the away fans from that basketball game.
Look at the graph: the two distributions do not overlap perfectly. There are differences. Look at the R code and you can see that this is mechanically true — the two distributions are different. They are truly different. They are not the same data. But the difference between them is quite small.
So, based only on height, tell me whether each black line is a home fan or an away fan.
The two groups — away fans and home fans — are truly different, just by a small amount. Males and females truly differ in their average height by a somewhat larger amount. NBA players truly differ from ordinary adults by a large amount. All of these are real differences. But your ability to tell them apart differs with the size of the difference.
# two made-up crowds, a hair apartset.seed(1)home <- rnorm(5000, mean = 176.0, sd = 7.5)away <- rnorm(5000, mean = 177.6, sd = 7.5)# the gap, in units of the spread the crowds already have(mean(away) - mean(home)) / sd(c(home, away))# the best any cut-off can docut <- optimize(function(h) abs(mean(home > h) - mean(away < h)), c(150, 210))$minimum(mean(away > cut) + mean(home < cut)) / 2