population genetics

Population Genetics Chpt 5 Box

Chapter 5 Box Problems

Box A

(a)

$$\displaystyle W_{BB}=p^2_1(1-2 \alpha + 2 \epsilon) + 2p_1q_1(1-\alpha+\epsilon) + q^2_1$$

$$ = p^2_1 - 2p^2_1 \alpha + 2p^2_1 \epsilon + 2p_1q_1 - 2p_1q_1 \alpha + q^2_1 + 2p_1q_1 \epsilon$$

$$\displaystyle = p^2_1 - 2p_1q_1 + q^2_1 + 2p_1[ -p_1 \alpha + p_1 \epsilon - q_1 \alpha + q_1 \epsilon]$$

$$\displaystyle = (p+q)^2 + 2p_1[ -\alpha + p_1 \epsilon]$$

$$\displaystyle = 1 - 2p_1[p_1 \alpha - p_1\epsilon + q_1 \alpha - q_1 \epsilon]$$

$$\displaystyle = 1 - 2p_1[(p_1+q_1)\alpha - (p_1+q_1)\epsilon]$$

$$\displaystyle = 1 - 2p_1( \alpha - \epsilon)$$

(b)

$$\displaystyle W_{Bb} = p^2_1 (1-\alpha+2\epsilon) + 2p_1q_1(1+ \epsilon) +q^2_1(1-\alpha)$$

$$\displaystyle = p^2_1 -p^2_1\alpha+2p^2_1\epsilon + 2p_1q_1 + 2p_1q_1\epsilon +q^2_1 - q^2_1\alpha$$

$$\displaystyle = p^2_1 + 2p_1q_1 +q^2_1 -(p^2_1\alpha +q^2_1\alpha)+2p^2_1\epsilon + 2p_1q_1\epsilon$$

$$\displaystyle = 1-\alpha(p^2+q^2) + 2p_1\epsilon(p_1+q_1)$$

$$\displaystyle = 1-(p^2+q^2)\alpha + 2p_1\epsilon$$

(c)

$$\displaystyle W_{bb} = p^2_1(1+2\epsilon)+2p_1q_1(1-\alpha+\epsilon)+q^2_1(1-2\alpha)$$

$$\displaystyle = p^2_1 +2p^2_1\epsilon +2p_1q_1 - 2p_1q_1\alpha + 2p_1q_1\epsilon +q^2_1 -2q^2_1\alpha$$

$$\displaystyle = p^2_1 + 2p_1q_1 +q^2_1 + 2p^2_1\epsilon + 2p_1q_1\epsilon - 2p_1q_1\alpha - 2q^2_1\alpha$$

$$\displaystyle = 1 + 2p_1\epsilon(p_1+q_1) - 2q_1\alpha(p_1+q_1)$$

$$\displaystyle = 1 +2p_1\epsilon -2q_1\alpha$$

(d)

Extract expressions for alpha and epsilon from Table 1 page 330

$$\displaystyle W_{AA}=p^2_2(1-2\alpha+2\epsilon)+2p_2q_2(1-\alpha+2\epsilon)+q^2_2(1+2\epsilon)$$

$$\displaystyle = p^2_2 - p^2_2\alpha + p^2_2\epsilon + 2p_2q_2 - 2p_2q_2\alpha + 4p_2q_2\epsilon + q^2_2 +2q^2_2\epsilon$$

$$\displaystyle = p^2_2 + 2p_2q_2 +q^2_2 +2\epsilon(p^2_2 + 2p_2q_2 +q^2_2)-2p_2\alpha(p_2+q_2)$$

$$\displaystyle = 1+2\epsilon - 2p_2\alpha$$

(e)

$$\displaystyle W_{Aa}= p^2_2(1-\alpha+\epsilon)+2p_2q_2(1+\epsilon)+q^2_2(1-\alpha+\epsilon)$$

$$\displaystyle = p^2_2 -p^2_2\alpha +p^2_2\epsilon +2p_2q_2 +2p_2q_2\epsilon+ q^2_2 - q^2_2\alpha + q^2_2\epsilon$$

$$\displaystyle = p^2_2 + 2p_2q_2 + q^2_2 + \epsilon(p^2_2 + 2p_2q_2 + q^2_2)-\alpha(p^2_2-q^2_2)$$

$$\displaystyle = 1 + \epsilon - \alpha(p^2_2+q^2_2)$$

(f)

$$\displaystyle W_{aa}= p^2_2(1) + 2p_2q_2(1-\alpha)+q^2_2(1-2\alpha)$$

$$\displaystyle = p^2_2 + 2p_2q_2 - 2p_2q_2\alpha + q^2_2 - 2q^2_2\alpha$$

$$\displaystyle = p^2_2 + 2p_2q_2 + q^2_2 - 2q_2\alpha(p_2+q_2)$$

$$\displaystyle = 1-2q_2\alpha$$

(g)

$$\displaystyle \bar{w} = p^2_2W_{BB} + 2p_2q_2W_{Bb}+q^2_2W_{bb}$$

$$\displaystyle = p^2_2[1-2p_1(\alpha-\epsilon)]+2p_2q_2[1-(p^2_1+q^2_1)\alpha+2p_1\epsilon]+q^2_2(1-2q_1\alpha+2p_1\epsilon)$$

$$\displaystyle = p^2_2-2p_1p^2_2(\alpha-\epsilon)+2p_2q_2-2p_2q_2(p^2_1+q^2_1)\alpha + 2p_1p_2q_2\epsilon+q^2_2-2q_1q^2_2\alpha+2p_1q^2_2\epsilon$$

$$\displaystyle = p^2_2-2p_1p^2_2\alpha + 2p_1p^2_2\epsilon +2p_2q_2-2p^2_1p_2q_2\alpha - 2p_2q^2_1q_2\alpha+2p_1p_2q_2\epsilon + q^2_2-2q_1q^2_2\alpha+2p_1q^2_2\epsilon$$

Rearrange into 3 sections collecting similar variables


Section 1 - terms without alpha or epsilon:

$$\displaystyle = p^2_2 + 2p_2q_2 + q^2 = 1$$

Section 2 - terms with alpha:

$$\displaystyle = -2p_1p^2_2\alpha - 2p^2_1p_2q_2\alpha-2p_2q^2_1q_2\alpha-2q_1q^2_2\alpha$$

$$\displaystyle = -2\alpha[p_1p^2_2+p^2_1p_2q_2+p_2q^2_1q_2+q_1q^2_2]$$

$$\displaystyle = -2\alpha[ p_1p_2(p_2+p_1q_2)+q_1q_2(q_1p_2+q_2)]$$

Substitute \(p_1=1-q_1\) and \(q_1=1-p_1\)

$$\displaystyle = -2\alpha[p_1p_2(p_2+(1-q_1)q_2)+q_1q_2((1-p_1)p_2+q_2) ]$$

$$\displaystyle = -2\alpha[p_1p_2(p_2+q_2-q_1q_2)+ q_1q_2(p_2-p_1p_2+q_2) ]$$

$$\displaystyle = -2\alpha[p_1p_2(1-q_1q_2)+q_1q_2(1-p_1p_2)]$$

$$\displaystyle = -2\alpha[p_1p_2-p_1p_2q_1q_2+q_1q_2-p_1p_2q_1q_2]$$

$$\displaystyle = -2\alpha[p_1p_2+q_1q_2-2p_1p_2q_1q_2]$$

Substitute \(q_1=1-p_1\) and \( q_2=1-p_2\)

$$\displaystyle = -2\alpha[ p_1p_2+(1-p_1)(1-p_2)-2p_1p_2(1-p_1)(1-p_2)]$$

$$\displaystyle = -2\alpha[ p_1p_2 + 1-p_1-p_2+p_1p_2-2p_1p_2(1-p_1-p_2+p_1p_2)]$$

$$\displaystyle = -2\alpha[p_1p_2 + 1-p_1-p_2 +p_1p_2 -2p_1p_2+2p_1p^2_2+2p^2_1p_2-2p^2_1p^2_2 ]$$

$$\displaystyle = -2\alpha[1-p_1-p_2+2p_1p_2(p_1+p_2-p_1p_2) ]$$

Section 3 - terms with epsilon:

$$\displaystyle = 2p_1p^2_2\epsilon + 2p_1p_2q_2\epsilon + 2p_1q^2_2\epsilon=2p_1\epsilon(p^2_2+p_2q_2 + q^2_2)=2p_1\epsilon$$

So finally \(\bar{w} = 1 -2\alpha[1-p_1-p_2+2p_1p_2(p_1+p_2-p_1p_2) ] +2p_1\epsilon\)

Box B

Variable Description
x trait
w fitness
\(\alpha\) average effect of an allele substitution
K response to selection
s selection differential
\(\mu’\) phenotypic mean
\(\sigma\) phenotypic standard deviation
\(\sigma^2\) variance
i intensity of selection
B proportion of a population saved for breading
T truncation point
Z height of the distribution at T
\(R_x\) phenotypic change in x in the first generation (Response)

From chapter 4 Box E p269 The fundamental theorum of natural selection:

$$\displaystyle i_w=\frac{\sigma_w}{\bar{w}}$$

From chapter 4 Box B p258

$$\displaystyle \Delta p = \frac{i_wpq\alpha_w}{\sigma_w}$$

Substitute to get: \(\Delta p=\frac{pq\alpha_w}{\bar{w}}\)

For x changing in response to selection: \(\Delta p=\frac{i_xpq\alpha_x}{\sigma_x}\)

Set the 2 equations for \(\Delta p\) equal and solve for \(i_x\)

$$\displaystyle \frac{pq\alpha_w}{\bar{w}} = \frac{i_xpq\alpha_x}{\sigma_x}$$ $$\displaystyle i_x=\frac{pq\alpha_w\sigma_x}{\bar{w}pq\alpha_x}=\frac{\sigma_x\alpha_w}{\bar{w}\alpha_x}$$ $$\displaystyle i_x=\sigma_x\frac{dln\bar{w}}{dx}$$ From chapter 4 box C: $\displaystyle R_x=i_x\sigma_xh^2_x; h^2_x=\frac{\sigma^2_{ax}}{\sigma^2_x}$ $$\displaystyle R_x=(\frac{dln\bar{w}}{dx})\sigma^2_{ax}$$

From chapter 1 Box E part b:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
K1 <- 1500  #population of interest
K2 <- 2500  #competitor population
alpha21 <- 0.25
alpha12 <- 0.5
N1 <- 1000
N2 <- 2000
r <- 0.05

#equation 1
1-(N1 + alpha21*N2)/K1
## [1] 0
#equation 2
r*(N1+alpha21*N2)/K1^2
## [1] 3.333333e-05
#equation 3
-r*N2/K1
## [1] -0.06666667

Box C

Variable Description
I Individual in question
R Relative
r probability I and R share an allele
F inbreeding coefficient
\(F_{IR}\) coefficient of kinship
\(r^*\) coefficient of relationship

$$\displaystyle r=2F_{IR}$$

Relationship \(F_{IR}\) \(2F_{IR}\)
twins 1/2 1
parent offspring 1/4 1/2
full sibs 1/4 1/2
half sibs 1/8 1/4
first cousins 1/16 1/8
uncle nephew 1/8 1/16

Box D

Only q can be calculated from the nonmelanic (aa freq=q^2) phenotype so take the melanic frequencies and subtrac from one.

Calculate p as 1-q

For Biston betularia:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
q0 <- sqrt(0.99)

q0
## [1] 0.9949874

p0 <- 1- q0  
p0
## [1] 0.005012563

qt <- sqrt(0.05)
qt
## [1] 0.2236068
pt <- 1- qt
pt
## [1] 0.7763932
N <- 50
N
## [1] 50
s <- (1/N)*(log((pt*q0)/(p0*qt)) + 1/qt - 1/q0)
s
## [1] 0.200053

For Biston cognitaria:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

q0 <- sqrt(0.99)
q0
## [1] 0.9949874

p0 <- 1- q0  
p0
## [1] 0.005012563

qt <- sqrt(0.20)
qt
## [1] 0.4472136

pt <- 1- qt
pt
## [1] 0.5527864

N <- 30
N
## [1] 30

s <- (1/N)*(log((pt*q0)/(p0*qt)) + 1/qt - 1/q0)
s
## [1] 0.2244583

Box E

(a)

For Biston betularia:

1
2
3
4
5
p0 <- 0.005
pt <- 0.776
C <- log(pt) - log(p0)
C
## [1] 5.044715

For Biston cognitaria:

1
2
3
4
5
p0 <- 0.01
pt <- 0.553	
C <- log(pt) - log(p0)
C
## [1] 4.012773

(b)

Given: $$\displaystyle \frac{dp}{dt}=\frac{pqs}{2\bar{w}}$$ rearrange to $$\displaystyle\frac{sq}{\bar{w}}dt=\frac{2}{p}dp$$

Given: $$\displaystyle C=\int^t_0 \frac{sq}{\bar{w}}dt$$ substitute to get $$\displaystyle C=\int^t_0 \frac{2}{p}dp = 2\int^t_0\frac{1}{p}dp=2ln(p_t)-2ln(p_0)=2[ln(p_t)-ln(p_0)]$$

(c)

Given: $$\displaystyle \frac{dp}{dt}=\frac{p^2qs}{\bar{w}}$$ rearrange to $$\displaystyle\frac{sq}{\bar{w}}dt=\frac{1}{p^2}dp$$

Given: \(\displaystyle C=\int^t_0\frac{sq(1+p)}{\bar{w}}dt=\int^t_0(1+p)\frac{sq}{\bar{w}}dt\) substitute to get

$$C=\int^t_0 \frac{(1+p)}{p^2}dp = |^t_0 -\frac{1}{p}+ln(p) = -\frac{1}{p_t}+ln(p_t)+\frac{1}{p_0}-ln(p_0)$$

(d)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
pt <- 1
p0 <- 0.01

log(pt)-log(p0)     #dominant
## [1] 4.60517
-(1+log(p0)-(1/p0)) #recessive
## [1] 103.6052
-2*log(p0)          # additive
## [1] 9.21034
p0 <- 0.001

log(pt)-log(p0)     #dominant
## [1] 6.907755
-(1+log(p0)-(1/p0)) #recessive
## [1] 1005.908
-2*log(p0)          # additive
## [1] 13.81551

(e)

For 10% selective elimination B = 0.9 (fraction retained for breeding) and the corresponding i is 0.195 (Box C chpt 4).

1
2
3
4
5
6
7
8
9
10
11
12
i <- 0.195
t <- 1    #(per generation)

n <- 10
(i/3.14159276)*sqrt(n/2)
## [1] 0.1387937
n <- 30
(i/3.14159276)*sqrt(n/2)
## [1] 0.2403977
n <- 100
(i/3.14159276)*sqrt(n/2)
## [1] 0.4389042

(f)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
subpop <- c(1,1,1,2,2,3,3)
deme <- c(1,2,3,1,2,1,2)
p <- c(0.9,0.8,0.7,0.6,0.5,0.4,0.3)
H <- c(0.18,0.32,0.42,0.48,0.50,0.48,0.42)
p2 <- p^2
d <- data.frame(cbind(subpop,deme,p,p2,H))
d
##   subpop deme   p   p2    H
## 1      1    1 0.9 0.81 0.18
## 2      1    2 0.8 0.64 0.32
## 3      1    3 0.7 0.49 0.42
## 4      2    1 0.6 0.36 0.48
## 5      2    2 0.5 0.25 0.50
## 6      3    1 0.4 0.16 0.48
## 7      3    2 0.3 0.09 0.42
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
#Calculate each summary statistic using dplyr's group_by function

Sp <- (group_by(d, subpop) %>% summarize(sum(p)))[,2] #sum of p within subpopulation
n <- (group_by(d, subpop) %>% summarize(length(p)))[,2] #count
p.bar <- (group_by(d, subpop) %>% summarize(mean(p)))[,2] #mean p
Sp2 <- (group_by(d, subpop) %>% summarize(sum(p2)))[,2] #sum p squared

H.bar <- (group_by(d, subpop) %>% summarize(mean(H)))[,2] #mean H
d2 <- data.frame( c(Sp, n, p.bar, H.bar, Sp2))
names(d2) <- c("Sp", "n", "p.bar", "H.bar","Sp2")
np.bar2 <- d2$n*d2$p.bar^2

d2 <- cbind(d2, np.bar2)

d2

##    Sp n p.bar     H.bar  Sp2 np.bar2
## 1 2.4 3  0.80 0.3066667 1.94   1.920
## 2 1.1 2  0.55 0.4900000 0.61   0.605
## 3 0.7 2  0.35 0.4500000 0.25   0.245

TSS <- sum(d2$Sp2) - sum(d2$n)*(mean(d2$p.bar)^2)
TSS

## [1] 0.5522222

BSS <- sum(d2$n*d2$p.bar^2) - sum(d2$n)*(mean(d2$p.bar)^2)
BSS
## [1] 0.5222222


WSS <- TSS - BSS
WSS
## [1] 0.03

sigma2.DS <- WSS/sum(d2$n)
sigma2.DS

## [1] 0.004285714

sigma2.ST <- BSS/sum(d2$n)
sigma2.ST

## [1] 0.07460317

sigma2.DT <- TSS/sum(d2$n)
sigma2.DT

## [1] 0.07888889

(a)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
d3 <- split(d, subpop)

variances <- lapply(d3, function(x){  (x$p-mean(x$p))^2    })
variances
## $`1`
## [1] 0.01 0.00 0.01
## 
## $`2`
## [1] 0.0025 0.0025
## 
## $`3`
## [1] 0.0025 0.0025
variances.avg <- sapply(variances, function(x){  mean(x)    }) #averages
variances.avg
##           1           2           3 
## 0.006666667 0.002500000 0.002500000
variances.n <- sapply(variances, function(x){ length(x)}) #counts per subpopulation
variances.n
## 1 2 3 
## 3 2 2
avg.weighted.variance <- sum(variances.avg*variances.n)/sum(variances.n )
avg.weighted.variance
## [1] 0.004285714

(b)

1
2
sum(((d2$p.bar - mean(d2$p.bar))^2)*d2$n)/sum(d2$n)
## [1] 0.0368254

(c)

1
2
sum((d$p - mean(d$p))^2)/length(d$p)
## [1] 0.04

(d)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
H.D <- sum(d$H)/nrow(d)
H.D
## [1] 0.4
H.variances.avg <- sapply(d3, function(x){ mean(x$H) }) #H averages
H.variances.avg
##         1         2         3 
## 0.3066667 0.4900000 0.4500000
H.S <- sum(H.variances.avg*variances.n)/nrow(d)
H.S
## [1] 0.4
H.T <- 2*mean(d$H)*(1-mean(d$H))  #see part c 
H.T
## [1] 0.48
H.S - H.D
## [1] 0
H.T - H.S
## [1] 0.08
H.T - H.D
## [1] 0.08

(e)

1
2
3
4
5
6
7
8
9
10
11
12
13
F.DS <- (H.S-H.D)/H.S
F.DS
## [1] 0
F.ST <- (H.T-H.S)/H.T
F.ST
## [1] 0.1666667
F.DT <- (H.T-H.D)/H.T
F.DT
## [1] 0.1666667
(1-F.DS)*(1-F.ST)
## [1] 0.8333333
(1-F.DT)
## [1] 0.8333333

(f)

I will call the quantity \(\displaystyle \frac{\Sigma n_i\bar{p}_i(1-\bar{p}_i)}{\Sigma n_i}\) “tilde.pq” in the R code.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
tilde.pq <- sum(d2$n*d2$p.bar*(1-d2$p.bar))/sum(d2$n)

tilde.pq
## [1] 0.2042857

sigma2.DS/tilde.pq
## [1] 0.02097902

sigma2.ST/tilde.pq
## [1] 0.3651904

sigma2.DT/tilde.pq
## [1] 0.3861694

Share