knitr::opts_chunk$set(echo = FALSE, results = 'asis')
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)
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}
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.
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_measure
r h2
}{1+(r nr_measure-1
r 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_measure
r h2
}{1+(r nr_measure-1
r 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)
$$
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
$
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
$$
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.