Evolution with differential survival and random mating.
One locus, two allele model.

Assume that in the parent generation, the frequencies of the A and B alleles are \(p_A\) and \(p_B\), respectively. Then, under the random mating assumption, the genotype frequencies in the offspring are \[\begin{gathered} f_{AA} = p_A^2, & f_{AB} = 2\,p_A\,p_B, & f_{BB} = p_B^2. \end{gathered}\]

Suppose that the probabilities that the AA, AB, and BB genotypes survive to reproductive age are \(s_{AA}\), \(s_{AB}\), \(s_{BB}\), respectively. Then the genotype frequencies of reproductives in the second generation are \[\begin{aligned} g_{AA} &= \frac{s_{AA}\,p_A^2}{s_{AA}\,p_A^2 + 2\,s_{AB}\,p_A\,p_B + s_{BB}\,p_B^2}, \\ g_{AB} &= \frac{2\,s_{AB}\,p_A\,p_B}{s_{AA}\,p_A^2 + 2\,s_{AB}\,p_A\,p_B + s_{BB}\,p_B^2}, \\ g_{BB} &= \frac{s_{BB}\,p_B^2}{s_{AA}\,p_A^2 + 2\,s_{AB}\,p_A\,p_B + s_{BB}\,p_B^2}. \\ \end{aligned}\] The allele frequencies in the next generation are therefore \[\begin{gathered} p_A^\prime=g_{AA}+\tfrac{1}{2}\,g_{AB}=p_A\,\frac{s_{AA}\,p_A + s_{AB}\,p_B}{s_{AA}\,p_A^2 + 2\,s_{AB}\,p_A\,p_B + s_{BB}\,p_B^2}, \\ p_B^\prime=g_{BB}+\tfrac{1}{2}\,g_{AB}=p_B\,\frac{s_{AB}\,p_A + s_{BB}\,p_B}{s_{AA}\,p_A^2 + 2\,s_{AB}\,p_A\,p_B + s_{BB}\,p_B^2}. \end{gathered}\]

We can now explore what happens to the allele frequencies as we vary the survival probabilities and the initial allele frequencies. The following codes are in an R script that is available to download.

library(manipulate)
library(ggplot2)
library(reshape2)
library(magrittr)

manipulate({
  pA <- seq(from=0,to=1,by=0.05)
  pB <- 1-pA
  t <- seq(from=0,to=tmax,by=1)
  X <- array(dim=c(length(pA),2,length(t)),
             dimnames=list(realization=seq_along(pA),
                           allele=c("A","B"),
                           generation=t))
  X[,"A",1] <- pA
  X[,"B",1] <- pB
  for (n in seq(from=2,to=length(t),by=1)) {
    pAnew <- pA*(sAA*pA+sAB*pB)/(sAA*pA*pA+2*sAB*pA*pB+sBB*pB*pB)
    pB <- pB*(sAB*pA+sBB*pB)/(sAA*pA*pA+2*sAB*pA*pB+sBB*pB*pB)
    pA <- pAnew
    X[,"A",n] <- pA
    X[,"B",n] <- pB
  }

  ggplot(data=melt(X),
         mapping=aes(x=generation,y=value,
                     color=realization,
                     group=realization))+
    geom_line()+
    facet_grid(~allele,labeller=label_both)+
    labs(y="allele frequency")
},
sAA=slider(min=0,max=1,init=1,step=0.001),
sAB=slider(min=0,max=1,init=1,step=0.001),
sBB=slider(min=0,max=1,init=1,step=0.001),
tmax=slider(min=0,max=300,init=10,step=10)
)

The three equilibria are at \[\begin{gathered} p_A=1 \qquad p_B=0,\\ p_A=0 \qquad p_B=1,\\ \text{and}\\ p_A=\frac{s_{AA}-s_{AB}}{s_{AA}-2\,s_{AB}+s_{BB}} \qquad p_B=\frac{s_{BB}-s_{AB}}{s_{AA}-2\,s_{AB}+s_{BB}}. \end{gathered}\]

---

Back to course schedule

---