Economic selection indices for multiple traits

Overview
Phenotypic covariance matrix
Genetic covariance matrix (pedigree)
Genetic covariance matrix (genomics)
Shiny package
Interactive Shiny application

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)