knitr::opts_chunk$set(echo = TRUE)

Problem 1: Own Performance

set.seed(4206)
n_nr_animal <- 12
n_weight_mean <- 283
n_weight_sd <- 3
vec_weight <- round(rnorm(n_nr_animal, mean = n_weight_mean, n_weight_sd), digits = 0)
tbl_weight <- tibble::tibble(Animal = c(1:n_nr_animal),
                             Weight = vec_weight)
n_weight_h2 <- 0.2025

Given is the dataset with weight observations for r n_nr_animal animals. The heritability ($h^2$) for the trait is r n_weight_h2. The population mean $\mu$ can assumed to be the mean of the weights in the table below.

`

knitr::kable(tbl_weight)

Your Tasks

Solution

The predicted breeding value $\widehat{u_i}$ of animal $i$ is computed as

$$\widehat{u_i} = h^2 (y_i - \mu)$$

where $h^2$ is the heritability given in the problem, $y_i$ is observation of animal $i$ and $\mu$ is the poputlation mean. The population mean is to be computed from the mean of the observations. Hence

n_mu_weight <- mean(tbl_weight$Weight)

Problem 2: Breeding Value Prediction Based on Repeated Observations

geb_gew <- 52
mu2 <- 170
rep <- 0.65
h2 <- 0.45
y <- 320
mu <- 250

Elsa has observations for her birth weight ($r geb_gew$ kg) and some more repeated measures for her weight. We assume the heritability to be $h^2 = r h2$. 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 that would result from a prediction of breeding values based on own performance.

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/lbgfs2021 documentation built on Dec. 19, 2021, 3:01 p.m.