Lesson 10 — Watching alleles wander in a finite population

An allele copied at random each generation, in a population small enough that luck alone moves it. Watch where it ends up.

In the big population, one lightning strike had a 0.005% effect. The smaller population has a 0.5% effect. On its own, that one lightning strike is not going to change much. But it's not literally zero effect. And that one lightning strike is not the only random thing that's going to happen to my population of birds, whether it's 10,000 or 100. All the random effects in a generation get summed together at the next round of reproduction. Each generation doesn't start fresh. — 202_lec09_06

A — One trajectory, then 50

Locked — confirm your name above to begin.

Scenario

Each generation, sample 2N alleles with replacement from the previous generation. That is the Wright-Fisher rule. The expected next-generation frequency is the current frequency; the variance is p(1−p)/(2N).

Allele frequency over generations

N: 100  |  p₀: 0.50  |  gens: 200  |  final p (this run): —

Prediction

  1. Q1. Across 50 independent replicates with N = 100, p₀ = 0.5, after 200 generations:
Try at least 5 (N, p₀, seed) combinations to unlock Stage B. 0/5 combos

Controls

100
0.50
200
42

Click two points on the canvas to mark the upper and lower bound of where you expect most replicate trajectories to land at generation 200. Then toggle the fan to check.

R code — Wright-Fisher one trajectory

set.seed(42)N <- 100p <- 0.5gens <- 200traj <- numeric(gens + 1); traj[1] <- pfor (g in 1:gens) {  p <- rbinom(1, 2*N, p) / (2*N)  traj[g + 1] <- p}plot(traj, type = "l", ylim = c(0,1))

B — Run to fixation

Complete Stage A to unlock this section.

Scenario

500 replicates, run until each is fixed. Histogram the fixation times. The expected mean for a neutral allele at p = 0.5 is about 2.8N generations (Kimura's classical result); conditional on fixation, ~4N.

Time to fixation (across replicates)

N: 50  |  replicates: 500  |  mean time: —  |  % fixed A: —

Prediction

  1. Q1. With N = 50, p₀ = 0.5, the mean time to fixation across 500 replicates will be:
Try at least 4 N values to unlock Stage C. 0/4 N values

Controls

50
0.50
42

R code — time to fixation

set.seed(42)N <- 50; p0 <- 0.5; reps <- 500tfix <- replicate(reps, {  p <- p0; g <- 0  while (p > 0 && p < 1) { p <- rbinom(1,2*N,p)/(2*N); g <- g + 1 }  g})mean(tfix); hist(tfix)

C — Where does a wandering allele end up?

Complete Stage B to unlock this section.

Scenario

For each of 8 starting frequencies (0.1, 0.2, …, 0.9), run 300 replicates. Plot fraction that fixed the allele against p₀. The diagonal is the neutral prediction; deviation is selection (or sampling noise).

Fixation probability vs starting frequency

N: 50  |  replicates/level: 300  |  selection coeff s: 0.00  |  RMSE from p₀ line: —

Prediction

  1. Q1. With s = 0 (no selection) and N = 50, the eight points will:
Try at least 3 s values (0, weak, strong) to unlock Stage D. 0/3 s values

Controls

50
0.00
42

R code — fixation probability scan

set.seed(42)N <- 50; s <- 0; reps <- 300p0s <- seq(0.1, 0.9, 0.1)pfix <- sapply(p0s, function(p0) {  mean(replicate(reps, {    p <- p0    while (p > 0 && p < 1) {      p_sel <- p*(1+s)/(p*(1+s)+(1-p))      p <- rbinom(1,2*N,p_sel)/(2*N)    }    p == 1  }))})plot(p0s, pfix); abline(0, 1)

D — Buri 1956 — 107 fly lines

Complete Stage C to unlock this section.

Scenario

Buri's empirical trajectories overlaid with a Wright-Fisher simulation at N=16 (the actual sample size each generation). The simulation matches the observed spread — drift accounts for the variance.

Observed Buri lines vs simulated WF lines

N (per line): 16  |  gens: 19  |  observed lines fixed: —  |  predicted lines fixed: —

Prediction

  1. Q1. After 19 generations with N = 16, what fraction of the 107 Buri lines do you expect to have fixed or lost the allele?
Resimulate at least 3 times. 0/3 sims

Controls

42

R code — Buri overlay

buri <- read.csv("data/clean/buri_fly.csv")set.seed(42); N <- 16; gens <- 19; lines <- 107; p0 <- 0.5sim <- replicate(lines, {  p <- p0; traj <- p  for (g in 1:gens) { p <- rbinom(1,2*N,p)/(2*N); traj <- c(traj, p) }  traj})matplot(t(sim), type = "l", col = rgb(0,0,0,0.1))