In charlotte-ngs/lbgfs2020: Livestock Breeding and Genomics (Fall 2020)

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)

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.

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)