[pull] master from gaynorr:master

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: AlphaSimR
 Type: Package
 Title: Breeding Program Simulations
-Version: 2.0.0
-Date: 2025-09-01
+Version: 2.1.0
+Date: 2025-11-08
 Authors@R: c(person("Chris", "Gaynor", email = "gaynor.robert@hotmail.com",
   role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0558-6656")),
   person("Gregor", "Gorjanc", role = "ctb", 
@@ -19,7 +19,9 @@ Authors@R: c(person("Chris", "Gaynor", email = "gaynor.robert@hotmail.com",
   person("Philip", "Greenspoon", role = "ctb",
   comment = c(ORCID = "0000-0001-6284-7248")),
   person("Ros", "Craddock", role = "ctb",
-  comment = c(ORCID = "0009-0004-1578-1580")))
+  comment = c(ORCID = "0009-0004-1578-1580")),
+  person("Jana", "Obsteter", role = "ctb", 
+  comment = c(ORCID = "0000-0003-1511-3916")))
 Description: The successor to the 'AlphaSim' software for breeding program 
   simulation [Faux et al. (2016) <doi:10.3835/plantgenome2016.02.0013>]. 
   Used for stochastic simulations of breeding programs to the level of DNA 
@@ -37,11 +39,11 @@ URL: https://github.com/gaynorr/AlphaSimR,
     https://gaynorr.github.io/AlphaSimR/,
     https://www.edx.org/learn/animal-breeding/the-university-of-edinburgh-breeding-programme-modelling-with-alphasimr
 Encoding: UTF-8
-Depends: R (>= 4.0.0), methods, R6
-Imports: Rcpp (>= 0.12.7), Rdpack
+Depends: R (>= 4.0.0)
+Imports: Rcpp (>= 0.12.7), Rdpack, methods, R6
 RdMacros: Rdpack
 LinkingTo: Rcpp, RcppArmadillo (>= 0.7.500.0.0), BH
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Suggests: knitr, rmarkdown, testthat
 VignetteBuilder: knitr
 NeedsCompilation: true

NAMESPACE

@@ -52,6 +52,7 @@ export(makeDH)
 export(meanEBV)
 export(meanG)
 export(meanP)
+export(mendelianSampling)
 export(mergeGenome)
 export(mergePops)
 export(mutate)
@@ -60,6 +61,7 @@ export(newEmptyPop)
 export(newMapPop)
 export(newMultiPop)
 export(newPop)
+export(parentAverage)
 export(pedigreeCross)
 export(pheno)
 export(popVar)
@@ -138,6 +140,7 @@ importFrom(methods,classLabel)
 importFrom(methods,is)
 importFrom(methods,new)
 importFrom(methods,show)
+importFrom(methods,slot)
 importFrom(methods,validObject)
 importFrom(stats,aggregate)
 importFrom(stats,coef)

NEWS.md

@@ -1,3 +1,17 @@
+# AlphaSimR 2.1.0
+
+*changed R6 and methods from Depends to Imports to match current best practices for R packages
+
+*Change order of call to `finalizePop` in `.newPop` to allow access to recombination tracking data
+
+*added `parentAverage` and `mendelianSampling` functions
+
+*fixed bug in `c` for RawPop, MapPop, and NamedMapPop
+
+*changed `popVar` to an R wrapper to automate casting of vectors to matrices
+
+*corrected bibliography entry month from sept to sep
+
 # AlphaSimR 2.0.0
 
 *added names to `SP$recHist`
@@ -418,7 +432,7 @@
 
 *`selectFam` now handles half-sib families
 
-*`selectWithinFa`m now handles half-sib families
+*`selectWithinFam` now handles half-sib families
 
 *Removed restriction on varE=NULL in `setPhenoGCA`
 

R/AlphaSimR.R

@@ -1,6 +1,8 @@
+# fmt: skip file
+
 #' @useDynLib AlphaSimR, .registration = TRUE
 #' @import Rcpp
-#' @importFrom methods new validObject is .hasSlot 
+#' @importFrom methods new validObject is .hasSlot slot
 #' @importFrom methods show classLabel
 #' @importFrom stats aggregate rnorm qnorm var
 #' @importFrom stats coef dnorm lm pnorm qgamma na.omit
@@ -10,21 +12,21 @@
 #' @importFrom Rdpack reprompt
 
 #' @description
-#' The successor to the 'AlphaSim' software for breeding program 
-#' simulation [Faux et al. (2016) <doi:10.3835/plantgenome2016.02.0013>]. 
-#' Used for stochastic simulations of breeding programs to the level of DNA 
-#' sequence for every individual. Contained is a wide range of functions for 
-#' modeling common tasks in a breeding program, such as selection and crossing. 
-#' These functions allow for constructing simulations of highly complex plant and 
-#' animal breeding programs via scripting in the R software environment. Such 
-#' simulations can be used to evaluate overall breeding program performance and 
-#' conduct research into breeding program design, such as implementation of 
-#' genomic selection. Included is the 'Markovian Coalescent Simulator' ('MaCS') 
-#' for fast simulation of biallelic sequences according to a population 
+#' The successor to the 'AlphaSim' software for breeding program
+#' simulation [Faux et al. (2016) <doi:10.3835/plantgenome2016.02.0013>].
+#' Used for stochastic simulations of breeding programs to the level of DNA
+#' sequence for every individual. Contained is a wide range of functions for
+#' modeling common tasks in a breeding program, such as selection and crossing.
+#' These functions allow for constructing simulations of highly complex plant and
+#' animal breeding programs via scripting in the R software environment. Such
+#' simulations can be used to evaluate overall breeding program performance and
+#' conduct research into breeding program design, such as implementation of
+#' genomic selection. Included is the 'Markovian Coalescent Simulator' ('MaCS')
+#' for fast simulation of biallelic sequences according to a population
 #' demographic history [Chen et al. (2009) <doi:10.1101/gr.083634.108>].
-#' 
-#' Please see the introductory vignette for instructions for using this package. 
-#' The vignette can be viewed using the following command: 
+#'
+#' Please see the introductory vignette for instructions for using this package.
+#' The vignette can be viewed using the following command:
 #' \code{vignette("intro",package="AlphaSimR")}
 #' @keywords internal
-"_PACKAGE"
+"_PACKAGE"

R/Class-Pop.R

@@ -90,7 +90,9 @@ setMethod("c",
                           x@ploidy==y@ploidy,
                           x@nLoci==y@nLoci)
                 x@nInd = x@nInd+y@nInd
-                x@geno = mergeGeno(x@geno,y@geno)
+                geno = mergeGeno(x@geno,y@geno)
+                dim(geno) = NULL # Account for matrix bug in RcppArmadillo
+                x@geno = geno
               }
             }
             return(x)
@@ -190,7 +192,9 @@ setMethod("c",
                           x@nLoci==y@nLoci,
                           all.equal(x@genMap, y@genMap))
                 x@nInd = x@nInd+y@nInd
-                x@geno = mergeGeno(x@geno,y@geno)
+                geno = mergeGeno(x@geno,y@geno)
+                dim(geno) = NULL # Account for matrix bug in RcppArmadillo
+                x@geno = geno
                 x@inbred = x@inbred & y@inbred
               }
             }
@@ -289,7 +293,9 @@ setMethod("c",
                 x@id = c(x@id, y@id)
                 x@mother = c(x@mother, y@mother)
                 x@father = c(x@father, y@father)
-                x@geno = mergeGeno(x@geno,y@geno)
+                geno = mergeGeno(x@geno,y@geno)
+                dim(geno) = NULL # Account for matrix bug in RcppArmadillo
+                x@geno = geno
                 x@inbred = x@inbred & y@inbred
               }
             }
@@ -757,8 +763,6 @@ newPop = function(rawPop,simParam=NULL,...){
                       simParam=simParam)
   }
 
-  output = simParam$finalizePop(output, simParam=simParam, ...)
-
   if(simParam$isTrackPed){
     if(simParam$isTrackRec){
       simParam$addToRec(lastId,id,iMother,iFather,isDH,hist,output@ploidy)
@@ -768,6 +772,8 @@ newPop = function(rawPop,simParam=NULL,...){
   }else{
     simParam$updateLastId(lastId)
   }
+
+  output = simParam$finalizePop(output, simParam=simParam, ...)
 
   return(output)
 }

R/RcppExports.R

@@ -316,9 +316,9 @@ createReducedGenome <- function(geno, nProgeny, genMap, v, p, trackRec, ploidy,
 #' 
 #' @return an m by m variance-covariance matrix
 #' 
-#' @export
-popVar <- function(X) {
-    .Call(`_AlphaSimR_popVar`, X)
+#' @keywords internal
+popVarCpp <- function(X) {
+    .Call(`_AlphaSimR_popVarCpp`, X)
 }
 
 mergeGeno <- function(x, y) {

R/misc.R

@@ -647,3 +647,22 @@ rnormWithSeed = function(n, u){
   set.seed(as.integer((u-0.5)*2*2147483647))
   rnorm(n)
 }
+
+
+#' @title Population variance
+#' 
+#' @description
+#' Calculates the population variance matrix as 
+#' opposed to the sample variance matrix calculated 
+#' by \code{\link{var}}. i.e. divides by n instead 
+#' of n-1
+#' 
+#' @param X an n by m matrix
+#' 
+#' @return an m by m variance-covariance matrix
+#' 
+#' @export
+popVar = function(X){
+  return(popVarCpp(as.matrix(X)))
+}
+

R/popSummary.R

@@ -1,3 +1,4 @@
+# fmt: skip file
 
 #' @title Mean genetic values
 #'
@@ -223,7 +224,7 @@ genParam = function(pop,simParam=NULL){
   if(is.null(simParam)){
     simParam = get("SP",envir=.GlobalEnv)
   }
-  
+
   nInd = nInd(pop)
   nTraits = simParam$nTraits
   traitNames = simParam$traitNames
@@ -680,6 +681,132 @@ ebv = function(pop){
   pop@ebv
 }
 
+#' @title Calculate parent average
+#'
+#' @param pop \code{\link{Pop-class}} with individuals whose parent average
+#'   will be calculated
+#' @param parents \code{\link{Pop-class}} with mothers and fathers of individuals
+#'   in \code{pop}; if \code{NULL} must provide \code{mothers} and \code{fathers}
+#' @param mothers \code{\link{Pop-class}} with mothers of individuals in \code{pop};
+#'   if \code{NULL} must provide \code{parents}
+#' @param fathers \code{\link{Pop-class}} with fathers of individuals in \code{pop};
+#'   if \code{NULL} must provide \code{parents}
+#' @param use character, calculate using \code{"\link{gv}"}, \code{"\link{bv}"},
+#'   \code{"\link{ebv}"}, or \code{"\link{pheno}"}
+#' @param simParam \code{\link{SimParam}} object
+#'
+#' @return a matrix of parent averages with dimensions nInd by nTraits
+#'
+#' @examples
+#' #Create founder haplotypes
+#' founderPop = quickHaplo(nInd=10, nChr=1, segSites=10)
+#'
+#' #Set simulation parameters
+#' SP = SimParam$new(founderPop)
+#' SP$addTraitAD(10, meanDD=0.5)
+#' SP$setVarE(h2=0.5)
+#' \dontshow{SP$nThreads = 1L}
+#'
+#' #Create population
+#' pop = newPop(founderPop, simParam=SP)
+#' pop2 = randCross(pop, nCrosses=10, nProgeny=2)
+#' parentAverage(pop2, parents = pop)
+#' parentAverage(pop2, mothers = pop, fathers = pop)
+#'
+#' @export
+parentAverage = function(pop, parents = NULL, mothers = NULL, fathers = NULL,
+                         use = "gv", simParam = NULL) {
+  if (is.null(simParam)) {
+    simParam = get("SP", envir = .GlobalEnv)
+  }
+  if (!is.null(parents)) {
+    matchMothers = match(x = pop@mother, table = parents@id)
+    matchFathers = match(x = pop@father, table = parents@id)
+  } else {
+    if (is.null(mothers) | is.null(fathers)) {
+      stop("must provide either 'parents' or both 'mothers' and 'fathers'!")
+    }
+    matchMothers = match(x = pop@mother, table = mothers@id)
+    matchFathers = match(x = pop@father, table = fathers@id)
+  }
+  if (anyNA(matchMothers)) {
+    stop("some parents/mothers not found!")
+  }
+  if (anyNA(matchFathers)) {
+    stop("some parents/fathers not found!")
+  }
+  if (use %in% c("gv", "ebv", "pheno")) {
+    if (!is.null(parents)) {
+      ret = 0.5 * (slot(object = parents, name = use)[matchMothers, , drop = FALSE] +
+                   slot(object = parents, name = use)[matchFathers, , drop = FALSE])
+    } else {
+      ret = 0.5 * (slot(object = mothers, name = use)[matchMothers, , drop = FALSE] +
+                   slot(object = fathers, name = use)[matchFathers, , drop = FALSE])
+    }
+  } else if (use == "bv") {
+    if (!is.null(parents)) {
+      ret = 0.5 * (bv(parents, simParam = simParam)[matchMothers, , drop = FALSE] +
+                   bv(parents, simParam = simParam)[matchFathers, , drop = FALSE])
+    } else {
+      ret = 0.5 * (bv(mothers, simParam = simParam)[matchMothers, , drop = FALSE] +
+                   bv(fathers, simParam = simParam)[matchFathers, , drop = FALSE])
+    }
+  } else {
+    stop("use must be one of 'gv', 'bv', 'ebv', or 'pheno'!")
+  }
+  return(ret)
+}
+
+#' @title Calculate Mendelian sampling
+#'
+#' @param pop \code{\link{Pop-class}} with individuals whose parent average
+#'   will be calculated
+#' @param parents \code{\link{Pop-class}} with mothers and fathers of individuals
+#'   in \code{pop}; if \code{NULL} must provide \code{mothers} and \code{fathers}
+#' @param mothers \code{\link{Pop-class}} with mothers of individuals in \code{pop};
+#'   if \code{NULL} must provide \code{parents}
+#' @param fathers \code{\link{Pop-class}} with fathers of individuals in \code{pop};
+#'   if \code{NULL} must provide \code{parents}
+#' @param use character, calculate using \code{"\link{gv}"}, \code{"\link{bv}"},
+#'   \code{"\link{ebv}"}, or \code{"\link{pheno}"}
+#' @param simParam \code{\link{SimParam}} object
+#'
+#' @return a matrix of Mendelian samplings with dimensions nInd by nTraits
+#'
+#' @examples
+#' #Create founder haplotypes
+#' founderPop = quickHaplo(nInd=10, nChr=1, segSites=10)
+#'
+#' #Set simulation parameters
+#' SP = SimParam$new(founderPop)
+#' SP$addTraitAD(10, meanDD=0.5)
+#' SP$setVarE(h2=0.5)
+#' \dontshow{SP$nThreads = 1L}
+#' 
+#' #Create population
+#' pop = newPop(founderPop, simParam=SP)
+#' pop2 = randCross(pop, nCrosses=10, nProgeny=2)
+#' mendelianSampling(pop2, parents = pop)
+#' mendelianSampling(pop2, mothers = pop, fathers = pop)
+#'
+#' @export
+mendelianSampling = function(pop, parents = NULL, mothers = NULL, fathers = NULL,
+                             use = "gv", simParam = NULL) {
+  if (is.null(simParam)) {
+    simParam = get("SP", envir = .GlobalEnv)
+  }
+  pa = parentAverage(pop = pop, parents = parents, mothers = mothers, fathers = fathers,
+                     use = use, simParam = simParam)
+  if (use %in% c("gv", "ebv", "pheno")) {
+    ret = slot(object = pop, name = use) - pa
+  } else if (use == "bv") {
+    ret = bv(pop, simParam = simParam) - pa
+  } else {
+    stop("use must be one of 'gv', 'bv', 'ebv', or 'pheno'!")
+  }
+  return(ret)
+}
+
 #' @title Number of individuals
 #'
 #' @description A wrapper for accessing the nInd slot

inst/REFERENCES.bib

@@ -154,7 +154,7 @@ @article{cattle
   publisher={Royal Society of Edinburgh Scotland Foundation},
   author={MacLeod, Iona M. and Larkin, Denis M. and Lewin, Harris A.and Hayes, Ben J. and Goddard, Mike E.},
   year={2013},
-  month=sept,
+  month=sep,
   pages={2209–2223}
 }