# Economic selection indices for multiple traits

# Overview

We will build economic selection indices for multiple traits using birth weight (BWT) and calving difficulty (CD) in the beef cattle data.

# Phenotypic covariance matrix

Variance of BWT is 110.5760529 and variance of z-score transformed CD is 0.9840235, and covariance between BWT and CD is 0.9727331.

`P <- matrix(c(110.5760529, 0.9727331, 0.9727331, 0.9840235), ncol = 2)`

# Genetic covariance matrix (pedigree)

Additive genetic variance of BWT is 84.561 and additive genetic variance of z-score transformed CD is 0.385, and additive genetic covariance between BWT and CD is 3.635.

`G.A <- matrix(c(84.561, 3.635, 3.635, 0.385), ncol = 2)`

# Genetic covariance matrix (genomics)

Additive genomic variance of BWT is 23.780 and additive genomic variance of z-score transformed CD is 0.862, and additive genomic covariance between BWT and CD is 0.077.

`G.G <- matrix(c(23.78, 0.862, 0.862, 0.077), ncol = 2)`

# Shiny package

Install the shiny package and load to your R environment.

```
install.packages("shiny")
library(shiny)
```

# Interactive Shiny application

Select ecnomic values for BWT and CD and see how selection index parameters vary between pedigree and genomic information.

```
server <- function(input, output) {
P <- matrix(c(110.5760529, 0.9727331, 0.9727331, 0.9840235), ncol = 2)
G.A <- matrix(c(84.561, 3.635, 3.635, 0.385), ncol = 2)
G.G <- matrix(c(23.78, 0.862, 0.862, 0.077), ncol = 2)
react <- reactive({
w1 <- input$obs
w2 <- input$obs2
w <- c(input$obs, input$obs2)
# b
b.A <- solve(P) %*% G.A %*% w
b.G <- solve(P) %*% G.G %*% w
# sigma HI
sigmaHI.A <- t(b.A) %*% G.A %*% w
sigmaHI.G <- t(b.G) %*% G.G %*% w
# sigma2 I
sigma2I.A <- t(b.A) %*% P %*% b.A
sigma2I.G <- t(b.G) %*% P %*% b.G
# sigma2 H
sigma2H.A <- t(w) %*% G.A %*% w
sigma2H.G <- t(w) %*% G.G %*% w
# r HI accuracy
rHI.A <- sigmaHI.A/(sqrt(sigma2I.A * sigma2H.A))
rHI.G <- sigmaHI.G/(sqrt(sigma2I.G * sigma2H.G))
# RH
RH.A <- sigmaHI.A/sqrt(sigma2I.A)
RH.G <- sigmaHI.G/sqrt(sigma2I.G)
# RE
RE.A <- RH.A/RH.G
RE.G <- RH.G/RH.A
df <- data.frame(Pedigree = c(b.A[1], b.A[2], sigmaHI.A, sigma2I.A,
sigma2H.A, rHI.A, RH.A, RE.A), Genomics = c(b.G[1], b.G[2], sigmaHI.G,
sigma2I.G, sigma2H.G, rHI.G, RH.G, RE.G))
row.names(df) <- c("Selection index coefficient for BWT (b1)", "Selection index coefficient for CD (b2)",
"Covariance between index and aggregate genotype (sigma_HI)", "Variance of the index (sigma2_I)",
"Variance of aggregate genotype (sigma2_H)", "Selection accuracy (r_HI)",
"Response (R_H)", "Relative efficiency")
df
})
output$view <- renderTable({
react()
}, include.rownames = TRUE)
}
ui <- fluidPage(sidebarLayout(sidebarPanel(numericInput("obs", "Economic value for BWT (w1):",
-1), numericInput("obs2", "Economic value for CD (w2):", -2)), mainPanel(tableOutput("view"))))
shinyApp(ui = ui, server = server)
```