Quantitative Genetics, Homework #3

This work was completed for Dr Wu's Quantitative Genetics Class, Feb. 24, 2014 by Matt Curcio

The general formula for kinship coefficients: \( F_X = \sum \left(\frac{1}{2}\right)^n (1 + F_A)\ \)

Question #1

Find the kinship coefficients between:
Where: \( F_A = 0 \)
a) Grandfather & Granddaughter, where n = 3:

\( F_X = \left(\frac{1}{2}\right)^2 \) = 0.125

b) Uncle & Nephew, where n = 3:

\( F_X = \left(\frac{1}{2}\right)^2 \) = 0.125

c) Children of a pair of identical twins married to unrelated individuals, where n = 3:

\( F_X = \left(\frac{1}{2}\right)^{4} + \left(\frac{1}{2}\right)^{4} \) = 0.125

Question #2

For the following family structure, assume individuals not showing connections are independent.
Find the breeding coefficients of individuals X.

Pathway:
1. pjekq Where: \( F_A = 0 \) ; \( F_1 = \left(\frac{1}{2}\right)^5 \ \) = 0.0312
2. pjfkq Where: \( F_A = 0 \) ; \( F_2 = \left(\frac{1}{2}\right)^5 \ \) = 0.0312
3. pjebfkq Where: \( F_A = 0 \) ; \( F_3 = \left(\frac{1}{2}\right)^7 \ \) = 0.0078
4. pjebglq Where: \( F_A = 0 \) ; \( F_4 = \left(\frac{1}{2}\right)^7 \ \) = 0.0078
5. pjfbglq Where: \( F_A = 0 \) ; \( F_5 = \left(\frac{1}{2}\right)^7 \ \) = 0.0078

Therefore \( F_{total} = \sum_{i=1}^{5} F_X = \) 0.0859

Question #3

Consider Genotypes: “AA”,“Aa”,“aa”

Gtype <- c("AA", "Aa", "aa")
AA.v = 122
Aa.v = 154
aa.v = 188
v = c(AA.v, Aa.v, aa.v)

q = 0.2
p = 1 - q

AA.f = p^2
Aa.f = 2 * p * q
aa.f = q^2
f <- c(AA.f, Aa.f, aa.f)

## Population Mean = sum of [frequency]*[values]
PopMean <- function() {
    PMean <<- AA.v * p^2 + Aa.v * 2 * p * q + aa.v * q^2
}

## Genotype Value = Deviation from Population Mean
GenotypeValue <- function() {
    AA.gv <<- AA.v - PMean
    Aa.gv <<- Aa.v - PMean
    aa.gv <<- aa.v - PMean
    gv <<- c(AA.gv, Aa.gv, aa.gv)
}

## Inbreeding Value = sum of average effect of alleles
BreedingValue <- function() {
    A.avg <<- AA.gv * p + Aa.gv * q
    a.avg <<- Aa.gv * p + aa.gv * q
    AA.bv <<- 2 * A.avg
    Aa.bv <<- A.avg + a.avg
    aa.bv <<- 2 * a.avg
    bv <<- c(AA.bv, Aa.bv, aa.bv)
}

## Avg Effect of Gene Substitution = [AvgEffect.A1]-[AvgEffect.A2]
AEGeneSub <- function() {
    AEGS <<- A.avg - a.avg
}

## Dominanace Deviation = [Genotype Value]-[Breeding Value]
DominanceDeviation <- function() {
    AA.dd <<- AA.gv - AA.bv
    Aa.dd <<- Aa.gv - Aa.bv
    aa.dd <<- aa.gv - aa.bv
    dd <<- c(AA.dd, Aa.dd, aa.dd)
}

AnswerPrint <- function() {
    PopMean()
    GenotypeValue()
    BreedingValue()
    AEGeneSub()
    DominanceDeviation()

    Answers <<- data.frame(Gtype, v, f, gv, bv, dd, check.rows = TRUE)
    c <- c("Genotype", "Genotype Activity", "Genotype Freq", "Genotype Value", 
        "Inbreeding Value", "Dominance Deviance")
    names(Answers) <- c

    cat("Population Mean: ", PMean, "\n")
    cat("Average Effect of A: ", A.avg, "\n")
    cat("Average Effect of a: ", a.avg, "\n")
    print(Answers, check.rows = TRUE)
}

AnswerPrint()

## Population Mean:  134.9 
## Average Effect of A:  -6.48 
## Average Effect of a:  25.92 
##   Genotype Genotype Activity Genotype Freq Genotype Value Inbreeding Value
## 1       AA               122          0.64         -12.88           -12.96
## 2       Aa               154          0.32          19.12            19.44
## 3       aa               188          0.04          53.12            51.84
##   Dominance Deviance
## 1               0.08
## 2              -0.32
## 3               1.28

End of file