knitr::opts_chunk$set(echo = FALSE, results = 'asis')

Problem 1: Prediction of Breeding Value and Reliability

y <- 320
mu <- 250
h2 <- 0.45

Heifer Elsa has a weaning weight of $r y$ kg. The population mean of the same trait is at $r mu$ kg.The heritability ($h^2$) of the trait weaning weight is assumed to be $r h2$.

a) What is the predicted breeding value $\hat{u_i}$ for Elsa for weaning weight? b) Compute the reliability of $\hat{u_i}$ from 1a)

### # Compute predicted breeding value in R
hat_a_el <- h2*(y-mu)

Solution

a) The predicted breeding value based on a single own performance record is

\begin{equation} \hat{u} = h^2(y - \mu) \notag \end{equation}

Plug-in the computed values into the equation.

\begin{equation} \hat{u} = h^2(y - \mu) = r h2 * (r y\ \text{kg} - r mu\ \text{kg}) = r hat_a_el\ \text{kg} \notag \end{equation}

b) The reliability corresponds to the squared correlation between the true breeding value and the selection criterion.

\begin{equation} B = r_{u,y}^2 = h^2 = r h2\notag \end{equation}

Problem 2: Breeding Value Prediction Based on Repeated Observations

geb_gew <- 52
mu2 <- 170
rep <- 0.65

Besides the weaning weight Elsa has also an observation for her birth weight ($r geb_gew$ kg) and some more repeated measures for her weight. We assume the heritability ($h^2 = r h2$) to be the same as in Problem 1. The population mean for the repeated observations of the weight is $r mu2$ kg. The repeatability of the weight measurements is $t = r rep$.

The following tables contains all observed values for the weight.

nr_measure <- 10
wean_weight <- y
slope <- (wean_weight-geb_gew)/(nr_measure-1)
measure <- c(1:nr_measure)
weight <- round(slope*(measure-1) + geb_gew, digits = 0)
mean_weight <- mean(weight)
dfWeightTable <- data.frame(Measurement = measure, Weight = weight)
knitr::kable(dfWeightTable)

a) Predict the breeding value for Elsa based on the repeated weight records. b) What is the reliability for the predicted breeding value from 2a)? c) Compare the reliability from 2b) with the reliability from Problem 1.

Solution

a) The predicted breeding value based on repeated records is

hat_a_rep_meas <- round((nr_measure * h2)/(1+(nr_measure - 1)*rep)*(mean_weight - mu2), digits = 2)

$$\hat{u}_i = \frac{nh^2}{1+(n-1)t}(\bar{y}_i - \mu) = \frac{r nr_measurer h2}{1+(r nr_measure-1r rep)}(r mean_weight - r mu2) = r hat_a_rep_meas$$

b) The reliability for the predicted breeding value from 2a) is

rel_rep_rec <- (nr_measure * h2)/(1+(nr_measure - 1)*rep)

$$B = r_{u,\bar{y}}^2 = b = \frac{nh^2}{1+(n-1)t} = \frac{r nr_measurer h2}{1+(r nr_measure-1r rep)} = r round(rel_rep_rec, digits = 2)$$

c) The reliability of the predicted breeding values based on repeated records is larger than the reliability of the prediction based on one record. The relation between the two reliabilities is

$$ \frac{r_{u,\bar{y}}^2}{r_{u,y}^2} = \frac{n}{1+(n-1)t} = \frac{r nr_measure}{1+(r nr_measure-1*r rep)} = r round(nr_measure/(1+(nr_measure-1)*rep), digits = 2)$$

Problem 3: Predict Breeding Values Based on Progeny Records

n_nr_progeny <- 5

A few years later Elsa was the dam of r n_nr_progeny offspring. Each of the offspring has a record for weaning weight. Predict the breeding value of Elsa for weaning weight based on the offpsring records listed in the following table.

vec_ww_prog <- round(y + rnorm(n_nr_progeny, mean = 0, sd = 2), digits = 0)
tbl_prog_ww <- tibble::tibble(Offspring = c(1:n_nr_progeny),
                              `Weaning Weight` = vec_ww_prog)
knitr::kable(tbl_prog_ww)

The mean and the heritability can be taken the same as in Problems 1 and 2 resulting in

$h^2 = r h2$ and $\mu = r mu$

Solution

The predicted breeding value based on progeny records is defined as

\begin{equation} \hat{u_i} = b * (\bar{y_i} - \mu) \end{equation}

where $\bar{y_i}$ corresponds to the mean of the progeny records for animal $i$, and $b$ is the regression coefficient which can be shown to be

$$b = \frac{2n}{n + k}$$

where $n$ is the number of offspring and $k$ corresponds to

$$k = \frac{4-h^2}{h^2}$$

Inserting the numbers given in the problem task results in

k_prob3 <- (4-h2)/h2
k_prob3_rounded <- round(k_prob3, digits = 2)

$$k = \frac{4 - r h2}{r h2} = r k_prob3_rounded$$

Using the computed value of $k$ allows to get the regression coefficient $b$.

b_prob3 <- 2 * n_nr_progeny /(n_nr_progeny + k_prob3)
b_prob3_rounded <- round(b_prob3, digits = 2)

$$b = \frac{2 * r n_nr_progeny}{r n_nr_progeny + r k_prob3_rounded} = r b_prob3_rounded$$

The predicted breeding value based on progeny records corresponds to

baryi_prob3 <- mean(tbl_prog_ww$`Weaning Weight`)
baryi_prob3_rounded <- round(baryi_prob3, digits = 2)
hatui_prob3 <- b_prob3 * (baryi_prob3 - mu)
hatui_prob3_rounded <- round(hatui_prob3, digits = 2)

$$\hat{u_i} = r b_prob3_rounded * (r baryi_prob3_rounded - r mu) = r hatui_prob3_rounded$$



charlotte-ngs/lbgfs2020 documentation built on Dec. 20, 2020, 5:39 p.m.