knitr::opts_chunk$set(echo = FALSE, results = 'asis', fig.pos = 'H')
knitr::knit_hooks$set(hook_convert_odg = rmdhelp::hook_convert_odg)
cnt <- rmdhelp::R6ClassCount$new()
cnt$set_prefix(ps_prefix = "## Problem")
cat(cnt$out(ps_suffix = "Multivariate BLUP Animal Model"), "\n")
n_nr_trait <- 2
n_nr_founder <- 3
n_nr_animal <- 8
n_nr_observation <- n_nr_animal - n_nr_founder
tbl_data_sol12p01 <- tibble::tibble(Animal = c((n_nr_founder+1):n_nr_animal),
                                        Sex = c("Male", "Female","Female","Male","Male"),
                                        Sire = c(1,3,1,4,3),
                                        Dam = c(NA,2,2,5,6),
                                        WWG = c(4.5,2.9,3.9,3.5,5.0),
                                        PWG = c(6.8,5.0,6.8,6.0,7.5))

The table below contains data for pre-weaning gain (WWG) and post-weaning gain (PWG) for r n_nr_observation beef calves.

knitr::kable(tbl_data_sol12p01,
             booktabs = TRUE,
             longtable = TRUE)

The genetic variance-covariance matrix $G_0$ between the traits is

mat_g0 <- matrix(data = c(20,18,18,40), nrow = n_nr_trait, byrow = TRUE)
cat(paste(rmdhelp::bmatrix(pmat = mat_g0, ps_name = 'G_0', ps_env = '$$'), collapse = '\n'), '\n')

The residual variance-covariance matrix $R_0$ between the traits is

mat_r0 <- matrix(data = c(40,11,11,30), nrow = n_nr_trait, byrow = TRUE)
cat(paste(rmdhelp::bmatrix(pmat = mat_r0, ps_name = 'R_0', ps_env = '$$'), collapse = '\n'), '\n')

Your Task

Set up the mixed model equations for a multivariate BLUP analysis and compute the estimates for the fixed effects and the predictions for the breeding values.

cat(cnt$out(ps_suffix = "Comparison of Reliabilites"), "\n")

Compare the predicted breeding values and the reliabilites obtained as results of Problem 1 with results from two univariate analyses for the same traits are used in Problem 1. All parameters can be taken from Problem 1.



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