Installation

You can install the released version of PopVar from CRAN with:

install.packages("PopVar")

And the development version from GitHub with:

# install.packages("devtools")
devtools::install_github("UMN-BarleyOatSilphium/PopVar")

Functions

Below is a description of the functions provided in PopVar:

Predictions using simulated populations

The code below simulates a single population of 1000 individuals for each of 150 crosses. For the sake of speed, the marker effects are predicted using RR-BLUP and no cross-validation is performed.

out <- pop.predict(G.in = G.in_ex, y.in = y.in_ex, map.in = map.in_ex,
                   crossing.table = cross.tab_ex,
                   nInd = 1000, nSim = 1, 
                   nCV.iter = 1, models = "rrBLUP")
#> Warning in read.cross.csv(dir, file, na.strings, genotypes, estimate.map, : There is no genotype data!
#> Warning in summary.cross(cross): Some markers at the same position on chr
#> 1,2,3,4,5,6,7; use jittermap().
#> Warning in summary.cross(cross): Strange genotype pattern on chr 7.

The function returns a list, one element of which is called predictions. This element is itself a list of matrices containing the predictions for each trait. They can be combined as such:

predictions1 <- lapply(X = out$predictions, FUN = function(x) {
  x1 <- as.data.frame(apply(X = x, MARGIN = 2, FUN = unlist), stringsAsFactors = FALSE)
  cbind(x1[,c("Par1", "Par2")], sapply(X = x1[,-1:-2], as.numeric)) 
})

# Display the first few lines of the predictions for grain yield
knitr::kable(head(predictions1$Yield_param.df))

Predictions using deterministic equations

Generating predictions via simulated populations can become computationally burdensome when many thousands or hundreds of thousands of crosses are possible. Fortunately, deterministic equations are available to generate equivalent predictions in a fraction of the time. These equations are provided in the pop.predict2 and pop_predict2 functions.

The pop.predict2 function takes arguments in the same format as pop.predict. We have eliminated the arguments for marker filtering and imputation and cross-validation, as the pop.predict2 function does not support these steps. (You may continue to conduct cross-validation using the x.val function.) Therefore, the genotype data input for pop.predict2 must not contain any missing data. Further, these predictions assume fully inbred parents, so marker genotypes must only be coded as -1 or 1. The data G.in_ex_imputed contains genotype data that is formatted properly.

Below is an example of using the pop.predict2 function:

out2 <- pop.predict2(G.in = G.in_ex_imputed, y.in = y.in_ex, map.in = map.in_ex,
                     crossing.table = cross.tab_ex, models = "rrBLUP")

knitr::kable(head(subset(out2, trait == "Yield")))

Note that the output of pop.predict2 is no longer a list, but a data frame containing the combined predictions for all traits.

The formatting requirements of G.in for pop.predict and pop.predict2 are admittedly confusing. Marker genotype data is commonly stored as a n x p matrix, where n is the number of entries and p the number of markers. The function pop_predict2 accommodates this general marker data storage. Here is an example:

out3 <- pop_predict2(M = G.in_ex_mat, y.in = y.in_ex, map.in = map.in_ex,
                     crossing.table = cross.tab_ex, models = "rrBLUP")

knitr::kable(head(subset(out2, trait == "Yield")))

time1 <- system.time({
  capture.output(pop.predict.out <- pop.predict(
    G.in = G.in_ex_imputed, y.in = y.in_ex, map.in = map.in_ex, crossing.table = cross.tab_ex,
    nInd = 1000, nSim = 1, nCV.iter = 1, models = "rrBLUP"))
})
#> Warning in read.cross.csv(dir, file, na.strings, genotypes, estimate.map, : There is no genotype data!
#> Warning in summary.cross(cross): Some markers at the same position on chr
#> 1,2,3,4,5,6,7; use jittermap().
#> Warning in summary.cross(cross): Strange genotype pattern on chr 7.

time2 <- system.time({pop.predict2.out <- pop.predict2(
  G.in = G.in_ex_imputed, y.in = y.in_ex, map.in = map.in_ex,
  crossing.table = cross.tab_ex,model = "rrBLUP")})

# Print the time (seconds) required for each function.
c(pop.predict = time1[[3]], pop.predict2 = time2[[3]])
#>  pop.predict pop.predict2 
#>      226.059        0.495

predictions1 <- lapply(X = pop.predict.out$predictions, FUN = function(x) {
  x1 <- as.data.frame(apply(X = x, MARGIN = 2, FUN = unlist), stringsAsFactors = FALSE)
  cbind(x1[,c("Par1", "Par2")], sapply(X = x1[,-1:-2], as.numeric))
})

pop.predict.out1 <- predictions1$Yield_param.df[,c("Par1", "Par2", "pred.varG")]
pop.predict2.out1 <- subset(pop.predict2.out, trait == "Yield", c(parent1, parent2, pred_varG))

toplot <- merge(pop.predict.out1, pop.predict2.out1, by.x = c("Par1", "Par2"),
                by.y = c("parent1", "parent2"))

plot(pred.varG ~ pred_varG, toplot,
     xlab = "pop.predict2", ylab = "pop.predict",
     main = "Comparsion of predicted genetic variance")

Multi-parent populations

PopVar also includes functions for predicting the mean, genetic variance, and superior progeny mean of multi-parent populations. The mppop.predict function takes the same inputs as pop.predict or pop.predict2, and the mppop_predict2 function takes the same inputs as pop_predict2. Both require the additional argument n.parents, which will determine whether the populations are formed by 2- or 4-way matings (support for 8-way populations is forthcoming.)

Below is an example of using the mppop.predict function:

# Generate predictions for all possible 4-way crosses of 10 sample parents
sample_parents <- sample(unique(unlist(cross.tab_ex)), 10)

mp_out <- mppop.predict(G.in = G.in_ex_imputed, y.in = y.in_ex, map.in = map.in_ex,
                        parents = sample_parents, n.parents = 4, models = "rrBLUP")

knitr::kable(head(subset(mp_out, trait == "Yield")))

Below is an example of using the mppop_predict2 function:

# Generate predictions for all possible 4-way crosses of 10 sample parents
mp_out2 <- mppop_predict2(M = G.in_ex_mat, y.in = y.in_ex, map.in = map.in_ex,
                          parents = sample_parents, n.parents = 4, models = "rrBLUP")

knitr::kable(head(subset(mp_out2, trait == "Yield")))