Population Genetics Chpt 4 Box

Chapter 4 Box Problems

---

Box A

Problem a

x <- c(11,15,13,8,10,16)
y <- c(6,1,4,8,7,2)

mean(x) #1 mean x
## [1] 12.16667

mean(y) #2 mean y
## [1] 4.666667

mean(x^2)-mean(x)^2  #3 variance x
## [1] 7.805556

#Calculate the long way using sample size of N then N-1 
(sum((x -mean(x))^2))/length(x)
## [1] 7.805556

(sum((x -mean(x))^2))/(length(x)-1)
## [1] 9.366667
#R uses N-1

var(x)  
## [1] 9.366667

sd(x)^2 
## [1] 9.366667

sd(y)^2 #4 variance y
## [1] 7.866667

cov(x,y) #5 covariance of x and y
## [1] -8.333333
cor(x,y) #6 correlation coefficient of x and y
## [1] -0.9708024
#7 the regression coefficient is the slope of the fit line, "y" in the summary output below.  The correlation coefficient can also be extracted from the model.


model <- lm(x ~ y)
model
## 
## Call:
## lm(formula = x ~ y)
## 
## Coefficients:
## (Intercept)            y  
##      17.110       -1.059

model[[1]][2] #regression coefficient
##         y 
## -1.059322
summary(model)
## 
## Call:
## lm(formula = x ~ y)
## 
## Residuals:
##       1       2       3       4       5       6 
##  0.2458 -1.0508  0.1271 -0.6356  0.3051  1.0085 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  17.1102     0.6966  24.561 1.63e-05 ***
## y            -1.0593     0.1309  -8.094  0.00127 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8208 on 4 degrees of freedom
## Multiple R-squared:  0.9425,	Adjusted R-squared:  0.9281 
## F-statistic: 65.51 on 1 and 4 DF,  p-value: 0.001266

summary(model)[[9]] #adjusted R^2 (goodness of fit)
## [1] 0.9280717

Problem b

Variable	Definition
s.j.x.ij	$\Sigma {jx}_{ij}$
n.i	$n_i$
x.bar.i	$\bar{x}_i$
n.i.2	$n_i^2$
WSS	$\Sigma_j(x_{ij}-\bar{x}_{i.})^2$
WSS	$\Sigma_j(x_{ij}-\bar{x}_{i.j})^{2}$
$\Sigma_j(x_{ij})$
grand.mean	$\bar{x}_{..}$
delta.2	$ (\bar{x}_i - \bar{x}_{..} )^{2}$
BSS	$n_i(\bar{x}_i - \bar{x}_{..})^2$
TSS	$\Sigma_j(\bar{x}_{ij}-\bar{x}_{..})^2$

#I will call the 3 groups a, b, c

a <- c(6,4,2,3)
b <- c(5,5,3)
c <- c(7,6,4,5,4)

response <- as.numeric(c(a,b,c))
sample <- c(rep("a", length(a)), rep("b", length(b)),rep("c", length(c)))

results <- data.frame(cbind(sample, response))
results
##    sample response
## 1       a        6
## 2       a        4
## 3       a        2
## 4       a        3
## 5       b        5
## 6       b        5
## 7       b        3
## 8       c        7
## 9       c        6
## 10      c        4
## 11      c        5
## 12      c        4

results.2 <- split(results, sample)
results.2
## $a
##   sample response
## 1      a        6
## 2      a        4
## 3      a        2
## 4      a        3
## 
## $b
##   sample response
## 5      b        5
## 6      b        5
## 7      b        3
## 
## $c
##    sample response
## 8       c        7
## 9       c        6
## 10      c        4
## 11      c        5
## 12      c        4
getWithinGroupSum <- function(x){    #get the within group sum $\Sigma_jx_{ij}$
      sum(as.numeric(unlist(x["response"])))}

s.j.x.ij <-  sapply(results.2, getWithinGroupSum)
s.j.x.ij   

##  a  b  c 
## 11 10 21
n.i <- sapply(results.2, nrow)
n.i   

## a b c 
## 4 3 5
getWithinGroupMean <- function(x){    #get the within group mean $\bar{x_{i}}$
      mean(as.numeric(unlist(x["response"])))}

x.bar.i <-  sapply(results.2, getWithinGroupMean)
x.bar.i    

##        a        b        c 
## 2.750000 3.333333 4.200000
getNsq <- function(x){
              nrow(x)^2 } 

n.i.2 <- sapply(results.2, getNsq)
n.i.2 

##  a  b  c 
## 16  9 25
getWGDelta <- function(x){   #within group difference from the group mean squared
   sum( (as.numeric(unlist(x["response"])) - mean(as.numeric(unlist(x["response"]))))^2)
}


WSS <- sum( sapply(results.2, getWGDelta))
WSS

## [1] 18.21667
grand.mean <- mean(as.numeric(results$response))
grand.mean  #grand mean for all samples

## [1] 3.5
BSS <- sum(n.i*((x.bar.i- grand.mean)^2))
BSS

## [1] 4.783333
results$gm.delta <- as.numeric(results$response) - grand.mean
results$gm.delta.squared <- results$gm.delta^2

results.3 <- split(results, sample)
results.3

## $a
##   sample response gm.delta gm.delta.squared
## 1      a        6      1.5             2.25
## 2      a        4     -0.5             0.25
## 3      a        2     -2.5             6.25
## 4      a        3     -1.5             2.25
## 
## $b
##   sample response gm.delta gm.delta.squared
## 5      b        5      0.5             0.25
## 6      b        5      0.5             0.25
## 7      b        3     -1.5             2.25
## 
## $c
##    sample response gm.delta gm.delta.squared
## 8       c        7      2.5             6.25
## 9       c        6      1.5             2.25
## 10      c        4     -0.5             0.25
## 11      c        5      0.5             0.25
## 12      c        4     -0.5             0.25
getSumDeltaGrndMeanSq <- function(x){    #get the sum of the [difference from the grand mean] squared
      sum(as.numeric(unlist(x["gm.delta.squared"])))}

TSS <- sum(sapply(results.3, getSumDeltaGrndMeanSq))
TSS   #note that TSS=WSS+BSS

## [1] 23
m <- 3 #number of groups

BMS <- BSS/(m-1)  #between group mean square
BMS

## [1] 2.391667
WMS <- WSS/(nrow(results)-m)  #within group mean square
WMS

## [1] 2.024074
n.avg <- (1/(m-1))*(sum(n.i)- (sum(n.i^2)/sum(n.i))  )
n.avg

## [1] 3.916667
V.B <- (BMS-WMS)/n.avg   #estimate of the variance among observations due to differences between groups
V.B

## [1] 0.09385343
V.W <- WMS  #estimate of the variance among observations due to differences among individuals within groups

t <- V.B/(V.B + V.W)  #intraclass correlation coefficient
t

## [1] 0.04431381

Box B

Problem a

Allele change	effect	proportion	frequency change
AA –> AA’	u+d-(u+a)	p	pu + pd - pu - pa
AA’ –> A’A’	u-a-(u+d)	q	qu-qa-qu-qd
		sum	-a(p+q)+d(p-q)
			=-a+d(p-q)
			$$= - \alpha$$

Problem b

Problem c

h2 <- c( rep(0.09, 6), rep(0.16, 6))
h <- sqrt(h2)
n <- rep( c(8,8,18,18,98,98),2)
i <- rep( c(0.8,2.06), 6)
s <- 2*i*h*sqrt(2/n)

data.frame(cbind(h2,h,n,i,s))

##      h2   h  n    i          s
## 1  0.09 0.3  8 0.80 0.24000000
## 2  0.09 0.3  8 2.06 0.61800000
## 3  0.09 0.3 18 0.80 0.16000000
## 4  0.09 0.3 18 2.06 0.41200000
## 5  0.09 0.3 98 0.80 0.06857143
## 6  0.09 0.3 98 2.06 0.17657143
## 7  0.16 0.4  8 0.80 0.32000000
## 8  0.16 0.4  8 2.06 0.82400000
## 9  0.16 0.4 18 0.80 0.21333333
## 10 0.16 0.4 18 2.06 0.54933333
## 11 0.16 0.4 98 0.80 0.09142857
## 12 0.16 0.4 98 2.06 0.23542857

Box C

Problem a

Derive: $$\displaystyle \frac{(\mu_s - \mu)}{\sigma^2} = \frac{Z}{B}$$ Given:

$$\displaystyle Z = \frac{1}{\sqrt{2\pi} \sigma} e^{\frac{-(T - \mu)^2}{2\sigma^2}}$$

$$\displaystyle B = \frac{1}{\sqrt{2\pi}\sigma} \int^{\infty}_{T} e^{\frac{-(x-\mu)^2}{2\sigma^2}} dx$$

$$\displaystyle \mu_s = \frac{1}{B\sqrt{2\pi}\sigma} \int^{\infty}_T xe^{\frac{-(x-\mu)^2}{2\sigma^2}} dx$$

Given the integration formulas:

$$\displaystyle \int xe^{\frac{-(x-\mu)^2}{2\sigma^2}} dx = -\sigma^2 e^{\frac{-(x-\mu)^2}{2\sigma^2}} + \mu \int e^{\frac{-(x-\mu)^2}{2\sigma^2}} dx$$

$$\displaystyle \int e^x dx = x$$

Define X as: $$X = \frac{-(x-\mu)^2}{2\sigma^2}$$ so that $$\mu_s$$ can be defined as:

$$\displaystyle \mu_s = \frac{1}{B}(\frac{1}{\sqrt{2\pi}\sigma})\int^{\infty}_T xe^Xdx$$

Evaluate the integral to obtain:

$$\displaystyle \mu_s = \frac{1}{B}[(\frac{1}{\sqrt{2\pi}\sigma})[\sigma^2e^X]|^{\infty}_T + \mu \int^{\infty}_T e^Xdx]$$

$$\displaystyle \mu_s = \frac{1}{B}[(\frac{1}{\sqrt{2\pi}\sigma})[0 - -\sigma^2e^X] + \frac{\mu}{\sqrt{2\pi}\sigma} \int^{\infty}_T e^Xdx]$$

$$\displaystyle \mu_s = \frac{1}{B}[(\frac{1}{\sqrt{2\pi}\sigma})[\sigma^2e^{\frac{-(T-\mu)^2}{2\sigma^2}}] + \frac{\mu}{\sqrt{2\pi}\sigma} \int^{\infty}_T e^{\frac{-(x-\mu)^2}{2\sigma^2}}dx]$$

Rearrange:

$$\displaystyle \mu_s = \frac{\sigma^2}{B} (\frac{1}{\sqrt{2\pi}\sigma})[e^{\frac{-(T-\mu)^2}{2\sigma^2}}] + \frac{\mu}{B} \frac{1}{\sqrt{2\pi}\sigma} \int^{\infty}_T e^{\frac{-(x-\mu)^2}{2\sigma^2}}dx$$

Substitute in B and Z:

$$\displaystyle \displaystyle \mu_s = \frac{\sigma^2Z}{B} + \mu$$

Problem b

B	i
0.1	1.76
0.01	2.66
10	1.5	fold change

Problem c

species <- c("cattle","swine","chicken")
B.sire <- rep(0.01,3)
i.sire <- rep(2.66, 3) #from the table
B.dam <- c( -(1-0.7), 0.1, 0.1 )
i.dam <- c( 0.347/0.7, 1.76, 1.76)
i.Total <- i.sire + i.dam
i.fraction.sire <- i.sire/i.Total
i.fraction.dam <- i.dam/i.Total

data.frame(species, B.sire, i.sire, i.fraction.sire, B.dam, i.dam, i.fraction.dam)

##   species B.sire i.sire i.fraction.sire B.dam     i.dam i.fraction.dam
## 1  cattle   0.01   2.66       0.8429153  -0.3 0.4957143      0.1570847
## 2   swine   0.01   2.66       0.6018100   0.1 1.7600000      0.3981900
## 3 chicken   0.01   2.66       0.6018100   0.1 1.7600000      0.3981900

Box D

Problem a

$$\displaystyle \frac{2a}{\sigma} \equiv$$ proportionate effect

For the Drosophila example:

$$\displaystyle U - D = 12\sigma$$

$$\displaystyle \sigma^2_a = 0.3\sigma^2$$

$$\displaystyle n = \frac{(U-D)^2}{8\sigma^2_a} = \frac{(12\sigma)^2}{8(0.3)\sigma^2} = \frac{144\sigma^2}{2.4\sigma^2} = 60$$

$$\displaystyle \frac{2a}{\sigma} = 2(\frac{\sigma_a}{\sigma})\sqrt{\frac{2}{n}} = 2(\frac{\sqrt{0.3\sigma^2}}{\sigma})\sqrt{\frac{2}{60}} = 2(\frac{0.548\sigma}{\sigma})0.18 = 0.197$$

For the mouse weight example:

$$\displaystyle U - D = 8\sigma$$

$$\displaystyle \sigma^2_a = 0.25\sigma^2$$

$$\displaystyle n = \frac{(U-D)^2}{8\sigma^2_a} = \frac{(8\sigma)^2}{8(0.25)\sigma^2} = \frac{64\sigma^2}{2\sigma^2} = 32$$

$$\displaystyle \frac{\sigma_a}{\sigma} = 2\frac{\sigma_a}{\sigma}\sqrt{\frac{2}{n}} = 2\frac{\sqrt{0.25\sigma^2}}{\sigma}\sqrt{\frac{2}{32}} = 2(\frac{0.5\sigma^2}{\sigma})0.25=0.25$$

Problem b

Given that $$\displaystyle n=50, \sigma^2=66.9, \sigma^2_a=47.6$$

$$\displaystyle U-D = \sqrt{8n\sigma^2_a} = 138$$

$$\displaystyle \frac{U-D}{\sigma} = \frac{138}{\sqrt{66.9}} = 16.8$$

Box E

Problem a

Using the equations:

$\displaystyle \bar{w} = 1-p^2s-q^2t$ where q = 1-p $$\displaystyle p' = \frac{p(pw_{11} + qw_{12})}{\bar{w}}$$
from p204 $$\displaystyle \bar{w}' =p^2w_{11} + 2pqw_{12} + q^2w_{22}$$

p <- 0.4
q <- 1-0.4
s<-0.2
t<-0.6
w.bar <- 1-(p^2)*s-(q^2)*t
w.bar

## [1] 0.752
w.11 <- 1-s
w.12 <- 1
p.prime <- p*(p*w.11 + q*w.12)/w.bar
p.prime

## [1] 0.4893617
w.22 <- 1-t

p <- p.prime  #adjust new values of p and q in next generation
q <- 1-p
w.bar.prime <- w.11*p^2 + 2*p*q*w.12 + w.22*q^2
w.bar.prime

## [1] 0.7956541
delta.wbar.method1 <- w.bar.prime - w.bar  #delta w.bar
delta.wbar.method1

## [1] 0.04365414
p <- 0.4
q <- 1-0.4

a <- (t-s)/2
d <- (t+s)/2
sigma.sq.suba <- 2*p*q*((a+(q-p)*d)^2)
sigma.sq.suba

## [1] 0.037632
delta.wbar.method2<-sigma.sq.suba/w.bar
delta.wbar.method2

## [1] 0.05004255
((delta.wbar.method1 - delta.wbar.method2) /delta.wbar.method2)*100 #percent difference using the 2 methods

## [1] -12.76596
#verify numerically
p <- 0.4
q <- 1-0.4
s<-0.2
t<-0.6
w.bar <- 1-(p^2)*s-(q^2)*t
w.bar

## [1] 0.752
(1+(p*q)/(2*w.bar)*(w.11 - 2*w.12 + w.22))

## [1] 0.8723404
delta.wbar <- (sigma.sq.suba/w.bar)*(1+(p*q)/(2*w.bar)*(w.11 - 2*w.12 + w.22))
delta.wbar  #should be the same as method 1

## [1] 0.04365414

Problem b

p <- 0.4
q <- 1-0.4
s<-0.02
t<-0.06
w.bar <- 1-(p^2)*s-(q^2)*t
w.bar

## [1] 0.9752
w.11 <- 1-s
w.12 <- 1
p.prime <- p*(p*w.11 + q*w.12)/w.bar
p.prime

## [1] 0.4068909
w.22 <- 1-t

p <- p.prime  #adjust new values of p and q in next generation
q <- 1-p
w.bar.prime <- w.11*p^2 + 2*p*q*w.12 + w.22*q^2
w.bar.prime

## [1] 0.9755821
delta.wbar.method1 <- w.bar.prime - w.bar  #delta w.bar
delta.wbar.method1

## [1] 0.0003820913
p <- 0.4
q <- 1-0.4

a <- (t-s)/2
d <- (t+s)/2
sigma.sq.suba <- 2*p*q*((a+(q-p)*d)^2)
sigma.sq.suba

## [1] 0.00037632
delta.wbar.method2<-sigma.sq.suba/w.bar
delta.wbar.method2

## [1] 0.0003858901
((delta.wbar.method1 - delta.wbar.method2) /delta.wbar.method2)*100 #percent difference using the 2 methods

## [1] -0.9844135
#verify numerically
p <- 0.4
q <- 1-0.4
s<-0.02
t<-0.06
w.bar <- 1-(p^2)*s-(q^2)*t
w.bar

## [1] 0.9752
(1+(p*q)/(2*w.bar)*(w.11 - 2*w.12 + w.22))

## [1] 0.9901559
delta.wbar <- (sigma.sq.suba/w.bar)*(1+(p*q)/(2*w.bar)*(w.11 - 2*w.12 + w.22))
delta.wbar  #should be the same as method 1

## [1] 0.0003820913

Problem c

s <- 0.2
t <- 0.6
p <- 0.75
q <- 1-p
d <- 0.4
sigma.sq.subd <- (2*p*q*d)^2

sigma.sq.subd

## [1] 0.0225
s <- 0.02
t <- 0.06
d <- 0.04
sigma.sq.subd <- (2*p*q*d)^2
sigma.sq.subd

## [1] 0.000225

Problem d

$$\displaystyle \bar{w} = 1-p^2s-q^2t = 1-p^2s-(1-p)^2t$$

$$\displaystyle = 1-p^2s-(1-2p+p^2)t = 1-p^2s-t + 2tp - tp^2$$

$$\displaystyle \frac{d\bar{w}}{dp} = -2ps +2t -2tp = 0$$
Rearrange to get -2ps - 2pt =-2t or ps + pt = t or $$\displaystyle p = \frac{t}{s+t}$$ at equilbrium.

$$\displaystyle \frac{d^2\bar{w}}{dp^2} = -2s -2t < 0$$ so a maximum of $$\bar{w}$$

Box F

Problem a

Method	Formula	B=0.1	B=0.01	notes
Tandom	i	1.76	2.66	table p261
independent culling	ni’	3(0.88)=2.64	3(1.4)=4.2	B=0.45 ,i=0.88;B=0.2 ,i=1.4
index selection	i$$\sqrt{n}$$	3.05	4.6

Problem b

$$\displaystyle I = a_1h^2_1x_1 + a_2h^2_2x_2 = (81.57)(0.47)x_1 + (20.1)(0.47)x_2$$

Box G

Problem a

$$\mu'=(p + \Delta p)^2(\mu^* + a) + 2(p + \Delta p)(q - \Delta p)(\mu^* + d) + (q - \Delta p)^2(\mu^* - a )$$

Break down the equation into 3 sections and multiply out each section

Section 1:

$$(p + \Delta p)^2(\mu^* + a) = (p^2 + 2p \Delta p + \Delta p^2)\mu^* + (p^2 + 2p \Delta p + \Delta p^2)a = p^2 \mu^* + 2p \Delta p \mu^* + \Delta p^2 \mu^* + ap^2 + 2ap \Delta p + a \Delta p^2$$

Section 2:

$$\displaystyle 2(p + \Delta p)(q - \Delta p)(\mu^* + d) = 2(pq - p \Delta p + q \Delta p - \Delta p^2)(\mu^* + d) = 2pq\mu^* - 2p \Delta p \mu^* + 2q \Delta p \\mu^* - 2 \Delta p^2 \mu^* + 2dqp - 2dp \Delta p + 2dq \Delta p - 2d \Delta p^2$$

Section 3:

$$\displaystyle (q - \Delta p)^2(\mu^* - a ) = (q^2 - 2q \Delta p + \Delta p^2)(\mu^* - a) = q^2 \mu^* - 2q \Delta p \mu^* + \Delta p^2 \mu^* - aq^2 + 2aq \Delta p - a \Delta p^2$$

The right most equations are:

Section 1:

$$\displaystyle p^2 \mu^* + 2p \Delta p \mu^* + \Delta p^2 \mu^* + ap^2 + 2ap \Delta p + a \Delta p^2$$

Section 2:

$$\displaystyle 2pq\mu^* - 2p \Delta p \mu^* + 2q \Delta p \\mu^* - 2 \Delta p^2 \mu^* + 2dqp - 2dp \Delta p + 2dq \Delta p - 2d \Delta p^2$$

Section 3:

$$\displaystyle q^2 \mu^* - 2q \Delta p \mu^* + \Delta p^2 \mu^* - aq^2 + 2aq \Delta p - a \Delta p^2$$

Simplify and ignor terms with $$\Delta p^2$$ to give:

Section 1:

$$\displaystyle p^2 \mu^* + ap^2 + 2ap \Delta p$$

Section 2:

$$\displaystyle 2pq\mu^* + 2dqp - 2dp \Delta p + 2dq \Delta p$$

Section 3:

$$\displaystyle q^2 \mu^* - aq^2 + 2aq \Delta p$$

Now group by $$\mu^*$$ a and d

$$\displaystyle p^2 \mu^* + 2pq\mu^* + q^2 \mu^* = (p^2 + 2pq + q^2)\mu^* = \mu^*$$ $$\displaystyle ap^2 - aq^2 + 2ap \Delta p + 2aq \Delta p = a(p^2 - q^2) + 2a \Delta p(p + q) = a(p - q)(p + q) + 2a \Delta p$$ $$\displaystyle 2dqp - 2dp \Delta p + 2dq \Delta p$$

Combine:

$$\displaystyle \mu' = \mu^* + a(p - q)(p + q) + 2dpq + 2a \Delta p - 2dp \Delta p + 2dq \Delta p$$ $$\displaystyle \mu' = \mu^* + a(p - q) + 2dpq + 2 \Delta p[a + d(q-p) - d \Delta p]$$

Given that $\displaystyle \mu = \mu^* + a(p-q) + 2pqd$ p288

$$\displaystyle \mu' = \mu + 2 \Delta p[a + (q-p)d]$$

Problem b

$$\displaystyle \mu = \mu^* + (p-q)a + 2pqd$$

So $$\displaystyle - \mu = - \mu^* + aq - ap - 2pqd$$ which is substituted into the equations. (1) $$\displaystyle \mu^* + a -u = \mu^* + a - \mu^* + aq - ap - 2pqd$$ $$\displaystyle = a(1 - p + q) - 2pqd = 2qa - 2pqd = 2q(a - pd)$$ (2) $$\displaystyle \mu^* + d -u = \mu^* + d - \mu^* + aq - ap - 2pqd$$ $$\displaystyle = d - ap + aq - 2pqd = d + a(q - p) - 2pqd = a(q - p) + d(1 - 2pq)$$ (3) $$\displaystyle \mu^* - a - u = \mu^* - a - \mu^* + aq - ap - 2pqd$$ $$\displaystyle = -a - ap + aq - 2pqd = -a(1 -q + p) - 2pqd = -a(2p) - 2pqd = -2p(a + qd)$$ (4) $$\displaystyle 2q[a + (q - p)d] - 2q^2d=2q[a+dq-dp]-2q^2d=2qa + 2qdq - 2qdp -2q^2d=2qa-2pqd=2q(a-pd)$$ (5) $$\displaystyle (q-p)[a + (q-p)d] + 2pqd=(q-p)[a+dq-dp]+2pqd=(q-p)a+(q-p)dq-(q-p)dp+2pqd=(q-p)a+dq^2-2pqd+dp^2+2pqd=(q-p)a+d(p^2+2pq+q^2-2pq)=(q-p)a + d(1-2pq)$$ (6) $$\displaystyle -2p[a + (q-p)d] - 2p^2d= -2p[a + dq - dp]- 2p^2d=-2pa - 2pdq + 2p^2d - 2p^2d= -2p(a + qd)$$

Box H

	carcass grade	thickness of fat	equation
BMS	7.6	16.8
WMS	5.9	10.4
$$\tilde{n}$$	6.81	6.6
$$V_B$$	0.25	0.97	$$\frac{BMS-WMS}{\tilde{n}}$$
$$V_W$$	5.9	10.4	WMS
t	0.04	0.085	$$\frac{V_B}{V_B+V_W}$$
h^2	0.16	0.34	4t

Box I

Problem a

Multiply each frequency by its phenotypic contribution to get:

$$\displaystyle 2[\bar{p}^2(1-F_{IT}) + pF_{IT}] + 2\bar{p}\bar{q}(1-F_{IT})=2\bar{p}^2(1-F_{IT}) + 2\bar{p}F_{IT} + 2\bar{p}\bar{q}(1-F_{IT})=(1-F_{IT})(2\bar{p})(\bar{p}+\bar{q}) + 2\bar{p}F_{IT}=[(1-F_{IT})+F_{IT}]2\bar{p}=2\bar{p}$$ $$\displaystyle M=2\bar{p} (above); M^2=4\bar{p}^2$$ $$\displaystyle mean square = (1-F_{IT})(4\bar{p}^2 + 2\bar{p}\bar{q}) + F_{IT}(4\bar{p})$$ $$\displaystyle Variance = V_{IT} = mean square - M^2$$ $$\displaystyle = (1-F{IT})(4\bar{p}^2 + 2\bar{p}\bar{q})+F_{IT}(4\bar{p})-4\bar{p}^2 = 2\bar{p}\bar{q}-4\bar{p}^2F_{IT}-2\bar{p}\bar{q}F_{IT}+4\bar{p}F_{IT}$$ $$\displaystyle = 2\bar{p}\bar{q}+4\bar{p}F_{IT}(1-\bar{p}-2\bar{p})\bar{q}F_{IT} = 2\bar{p}\bar{q} + 4\bar{p}\bar{q}F_{IT}-2\bar{p}\bar{q}F_{IT}$$ $$\displaystyle = 2\bar{p}\bar{q} + 2\bar{p}\bar{q}F_{IT}$$ $$\displaystyle = 2\bar{p}\bar{q}(1 + F_IT)$$

Problem b

$$\displaystyle V_IS = V_IT - V_ST$$ $$\displaystyle = 2\bar{p}\bar{q}(1 + F_IT) -2F_{ST}V_0$$ $$\displaystyle = V_0(1 + F_IT) -2F_{ST}V_0$$ $$\displaystyle = V_0 + V_{0}F_IT - 2F_{ST}V_0$$ $$\displaystyle = (1 + F_IT - 2F_{ST})V_0$$

Problem c

$$\displaystyle 1-F_IS = \frac{H_I}{H_S} rearrange to H_S=\frac{H_I}{1-F_IS}$$
$$\displaystyle 1-F_IT = \frac{H_I}{H_T} rearrange to H_T=\frac{H_I}{1-F_IT}$$

$$\displaystyle = 1-F_ST = \frac{H_S}{H_T} = \frac{\frac{H_I}{1-F_IS}}{\frac{H_I}{1-F_IT}}= \frac{H_I}{1-F_IS}\frac{1-F_IT}{H_I}=\frac{1-F_IT}{1-F_IS}$$
$$\displaystyle or (1-F_IS)(1-F_ST)= 1-F_IT$$

A second method would be start with $$\displaystyle (1-F_IS)(1-F_ST)= 1-F_IT$$
and substitute in to show equality:

$$\displaystyle (1 - \frac{H_S - H_I}{H_S})(1-\frac{H_T-H_S}{H_T})= 1 - \frac{H_T - H_I}{H_T}$$

$$\displaystyle (\frac{H_S}{H_S} - \frac{H_S - H_I}{H_S})( \frac{H_T}{H_T}-\frac{H_T-H_S}{H_T})= \frac{H_T}{H_T} - \frac{H_T - H_I}{H_T}$$

$$\displaystyle ( \frac{H_S - (H_S - H_I)}{H_S})(\frac{H_T - (H_T-H_S)}{H_T})= \frac{H_T - (H_T - H_I)}{H_T}$$

$$\displaystyle (\frac{H_I}{H_S})(\frac{H_S}{H_T})=\frac{H_I}{H_T}$$

$$\displaystyle \frac{H_I}{H_T} = \frac{H_I}{H_T}$$

Problem d

N <- 20
t <- 9+1
F.IS <- 0.25
F.ST <- 1 - (1-(1/(2*N)))^t
F.ST

## [1] 0.2236704
F.IT <- F.IS + F.ST
F.IT

## [1] 0.4736704

Box J

Problem a

t <- 0.15
k <- 1:5

K <- k/(1+((k-1)*t))
K

## [1] 1.000000 1.739130 2.307692 2.758621 3.125000
sqrt(K)

## [1] 1.000000 1.318761 1.519109 1.660910 1.767767

Box K

Problem a

r <- 0.28
hhat2 <- 0.79  #under assortative mating
A <- r*hhat2
A

## [1] 0.2212
h2 <- hhat2*( (1-A)/(1-hhat2*A))
h2   #random mating exact

## [1] 0.7455323
h2.approx <- hhat2*(1 -(1-hhat2)*A)
h2.approx   #random mating approximate

## [1] 0.7533029
#additive variance exact increases by:
1/(1-A)

## [1] 1.284027
#additive variance approximate increases by:
1 + A

## [1] 1.2212
#Total variance exact increases by:
1+(hhat2*A)/(1-hhat2*A)

## [1] 1.211751
#Total variance approximate increases by:
1+hhat2*A

## [1] 1.174748

Problem b

$$\displaystyle h^2 = \hat{h}^2(\frac{1-A}{1-\hat{h}^2}A)$$ substitute $$\hat{h}^2=\frac{A}{r}$$ $$\displaystyle h^2 = \frac{A}{r}(\frac{1-A}{1-\frac{A}{r}}A)$$ = $$\frac{A-A^2}{r-A^2}$$ rearrange to get $\displaystyle h^2(r-A^2)=A-A^2$ $$\displaystyle h^2(r-A^2)-A+A^2=0$$ $$\displaystyle h^2r-h^2 A^2-A+A^2=0$$ $$\displaystyle h^2-A+A^2(1-h^2)=0$$

Problem c

sig2.p <- 60
sig2.a <- 15
r <- 0.5
h2 <- sig2.a/sig2.p
h2

## [1] 0.25
#from part b (1-h2)A^2 - A + h2r = 0
#restate as aA^2 + bA + c where:

a <- 1-h2
b <- -1
c <- h2*r

#so the solution is for A is:

A <- ((-b)-sqrt(b^2 - 4*a*c))/(2*a)
A

## [1] 0.1396204
hhat2 <- A/r
hhat2

## [1] 0.2792408
sighat2.a <- sig2.a*(1/(1-A))
sighat2.a

## [1] 17.43416
sighat2.p <- sig2.p*(1+((hhat2*A)/(1-hhat2*A)))
sighat2.p

## [1] 62.43416

Box L

Problem a

B <- 0.01 # freq in parents
z <- 0.02665  #from Box C p261
t <- 2.33    #from Box C p261
u.s <- z/B
u.s

## [1] 2.665
B.prime <- 0.1 # freq in sons
t.prime <- 1.28    #from Box C p261
u.prime <- t-t.prime 
u.prime

## [1] 1.05
h2 <- 2*u.prime/u.s  #heritability
h2

## [1] 0.7879925

Problem b

F.p <- 0.001
t <- 3.09
z <- 0.00337
u.s <- z/F.p
u.s

## [1] 3.37
h2 <- 0.860
u.prime <- h2*u.s/2
u.prime

## [1] 1.4491
t.prime <- t - u.prime
t.prime

## [1] 1.6409

From Box C p261 the corresponding probablity that a child is affected is 0.05.