Merge pull request #161 from gaynorr/devel

Devel
gaynorr · Nov 1, 2023 · b597187 · b597187
2 parents 695aef0 + 3ada1fb
commit b597187
Show file tree

Hide file tree

Showing 109 changed files with 1,877 additions and 987 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: AlphaSimR
 Type: Package
 Title: Breeding Program Simulations
-Version: 1.4.2
-Date: 2023-3-27
+Version: 1.5.2
+Date: 2023-10-31
 Authors@R: c(person("Chris", "Gaynor", email = "[email protected]",
   role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0558-6656")),
   person("Gregor", "Gorjanc", role = "ctb", 
@@ -12,10 +12,12 @@ Authors@R: c(person("Chris", "Gaynor", email = "[email protected]",
   person("Daniel", "Money", role = "ctb", 
   comment = c(ORCID = "0000-0001-5151-3648")),
   person("David", "Wilson", role = "ctb"),
-  person("Thiago","Oliveira", role = "ctb",
+  person("Thiago", "Oliveira", role = "ctb",
   comment = c(ORCID = "0000-0002-4555-2584")),
   person("Audrey", "Martin", role = "ctb",
-  comment = c(ORCID = "0000-0003-2235-0098")))
+  comment = c(ORCID = "0000-0003-2235-0098")),
+  person("Philip", "Greenspoon", role = "ctb",
+  comment = c(ORCID = "0000-0001-6284-7248")))
 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 
@@ -31,7 +33,7 @@ Description: The successor to the 'AlphaSim' software for breeding program
 License: MIT + file LICENSE
 URL: https://github.com/gaynorr/AlphaSimR,
     https://gaynorr.github.io/AlphaSimR/,
-    https://www.edx.org/course/breeding-programme-modelling-with-alphasimr?utm_source=breeding_alphasimr&utm_medium=partner-marketing&utm_campaign=edinburghx
+    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

diff --git a/NAMESPACE b/NAMESPACE
@@ -42,7 +42,7 @@ export(isFemale)
 export(isHybridPop)
 export(isMale)
 export(isMapPop)
-export(isMegaPop)
+export(isMultiPop)
 export(isNamedMapPop)
 export(isPop)
 export(isRawPop)
@@ -57,7 +57,7 @@ export(mutate)
 export(nInd)
 export(newEmptyPop)
 export(newMapPop)
-export(newMegaPop)
+export(newMultiPop)
 export(newPop)
 export(pedigreeCross)
 export(pheno)
@@ -115,7 +115,7 @@ export(writeRecords)
 exportClasses(HybridPop)
 exportClasses(LociMap)
 exportClasses(MapPop)
-exportClasses(MegaPop)
+exportClasses(MultiPop)
 exportClasses(NamedMapPop)
 exportClasses(Pop)
 exportClasses(RRsol)

diff --git a/NEWS.md b/NEWS.md
@@ -1,10 +1,32 @@
+# AlphaSimR 1.5.2
+
+*fix SimParam examples for CRAN
+
+# AlphaSimR 1.5.1
+
+*deleted bad example code for `setMisc`
+
+*changed examples to use a single thread for CRAN testing this change is not shown in the documentation
+
+# AlphaSimR 1.5.0
+
+*renamed `MegaPop` to `MultiPop`
+
+*fixed bug in `writePlink` to correctly export map positions in cM
+
+*fixed bug in `writeRecords` due to removed reps slot in pops
+
+*added `altAddTraitAD` for specifying traits with dominance effects using dominance variance and inbreeding depression
+
+*add miscPop slot to class `Pop`
+
 # AlphaSimR 1.4.2
 
-* updated MaCS citation to https site
+*updated MaCS citation to https site
 
 # AlphaSimR 1.4.1
 
-* Changed citation to use `bibentry` instead of `citEntry`
+*Changed citation to use `bibentry` instead of `citEntry`
 
 # AlphaSimR 1.4.0
 

diff --git a/R/Class-Pop.R b/R/Class-Pop.R
@@ -379,6 +379,9 @@ isNamedMapPop = function(x) {
 #' population. This list is normally empty and exists solely as an
 #' open slot available for uses to store extra information about
 #' individuals.
+#' @slot miscPop a list of any length containing optional meta data for the 
+#' population. This list is empty unless information is supplied by the user.
+#' Note that the list is emptied every time the population is subsetted.
 #'
 #' @export
 setClass("Pop",
@@ -393,7 +396,8 @@ setClass("Pop",
                  ebv="matrix",
                  gxe="list",
                  fixEff="integer",
-                 misc="list"),
+                 misc="list",
+                 miscPop="list"),
          contains="RawPop")
 
 setValidity("Pop",function(object){
@@ -500,6 +504,7 @@ setMethod("[",
             for(chr in 1:x@nChr){
               x@geno[[chr]] = x@geno[[chr]][,,i,drop=FALSE]
             }
+            x@miscPop = list()
             return(x)
           }
 )
@@ -692,7 +697,8 @@ newPop = function(rawPop,simParam=NULL,...){
                ebv=matrix(NA_real_,
                           nrow=rawPop@nInd,
                           ncol=0),
-               misc=vector("list",rawPop@nInd))
+               misc=vector("list",rawPop@nInd),
+               miscPop=list())
   if(simParam$nTraits>=1){
     output = setPheno(output, varE=NULL, reps=1,
                       fixEff=1L, p=NULL, onlyPheno=FALSE,
@@ -808,8 +814,8 @@ isPop = function(x) {
 #' @title Creates an empty population
 #'
 #' @description
-#' Creates an empty \code{\link{Pop-class}} object with user 
-#' defined ploidy and other parameters taken from simParam. 
+#' Creates an empty \code{\link{Pop-class}} object with user
+#' defined ploidy and other parameters taken from simParam.
 #'
 #' @param ploidy the ploidy of the population
 #' @param simParam an object of \code{\link{SimParam}}
@@ -834,32 +840,32 @@ newEmptyPop = function(ploidy=2L, simParam=NULL){
   if(is.null(simParam)){
     simParam = get("SP", envir=.GlobalEnv)
   }
-  
+
   # Create 0 x nTrait matrix with trait names
   # For pheno and gv slots
   traitMat = matrix(NA_real_,
                     nrow = 0L,
                     ncol = simParam$nTraits)
-  
+
   traitNames = character(simParam$nTraits)
-  
+
   if(simParam$nTraits > 0L){
     # Get trait names
     for(i in 1:simParam$nTraits){
       traitNames[i] = simParam$traits[[i]]@name
     }
   }
-  
+
   colnames(traitMat) = traitNames
-  
+
   # Create empty geno list
   nLoci = unname(sapply(simParam$genMap, length))
   geno = vector("list", simParam$nChr)
   for(i in 1:simParam$nChr){
     DIM1 = nLoci[i]%/%8L + (nLoci[i]%%8L > 0L)
     geno[[i]] = array(as.raw(0), dim=c(DIM1, ploidy, 0))
   }
-  
+
   output = new("Pop",
                nInd = 0L,
                nChr = simParam$nChr,
@@ -879,37 +885,38 @@ newEmptyPop = function(ploidy=2L, simParam=NULL){
                ebv = matrix(NA_real_,
                             nrow=0L,
                             ncol=0L),
-               misc = list())
+               misc = list(),
+               miscPop = list())
   return(output)
 }
 
-# MegaPop ------------------------------------------------------------------
+# MultiPop ------------------------------------------------------------------
 
-#' @title Mega-Population
+#' @title Multi-Population
 #'
 #' @description
 #' The mega-population represents a population of populations.
 #' It is designed to behave like a list of populations.
 #'
-#' @param x a 'MegaPop' object
+#' @param x a 'MultiPop' object
 #' @param i index of populations or mega-populations
-#' @param ... additional 'MegaPop' or 'Pop' objects
+#' @param ... additional 'MultiPop' or 'Pop' objects
 #'
 #' @slot pops list of \code{\link{Pop-class}} and/or
-#' \code{MegaPop-class}
+#' \code{MultiPop-class}
 #'
 #'
 #' @export
-setClass("MegaPop",
+setClass("MultiPop",
          slots=c(pops="list"))
 
-setValidity("MegaPop",function(object){
+setValidity("MultiPop",function(object){
   errors = character()
     # Check that all populations are valid
     for(i in 1:length(object@pops)){
       if(!validObject(object@pops[[i]]) &
          (is(object@pops[[i]], "Pop") |
-                is(object@pops[[i]],"MegaPop"))){
+                is(object@pops[[i]],"MultiPop"))){
         errors = c(errors,paste("object",i,"is not a valid pop"))
       }
     }
@@ -920,26 +927,26 @@ setValidity("MegaPop",function(object){
   }
 })
 
-#' @describeIn MegaPop Extract MegaPop by index
+#' @describeIn MultiPop Extract MultiPop by index
 setMethod("[",
-          signature(x = "MegaPop"),
+          signature(x = "MultiPop"),
           function(x, i){
             x@pops = x@pops[i]
             return(x)
           }
 )
 
-#' @describeIn MegaPop Extract Pop by index
+#' @describeIn MultiPop Extract Pop by index
 setMethod("[[",
-          signature(x = "MegaPop"),
+          signature(x = "MultiPop"),
           function (x, i){
             return(x@pops[[i]])
           }
 )
 
-#' @describeIn MegaPop Combine multiple MegaPops
+#' @describeIn MultiPop Combine multiple MultiPops
 setMethod("c",
-          signature(x = "MegaPop"),
+          signature(x = "MultiPop"),
           function (x, ...){
             for(y in list(...)){
               if(is(y,"NULL")){
@@ -948,7 +955,7 @@ setMethod("c",
                 if(is(y,"Pop")){
                   x@pops = c(x@pops, y)
                 }else{
-                  stopifnot(is(y,"MegaPop"))
+                  stopifnot(is(y,"MultiPop"))
                   x@pops = c(x@pops, y@pops)
                 }
               }
@@ -957,17 +964,17 @@ setMethod("c",
           }
 )
 
-#' @title Create new Mega Population
+#' @title Create new Multi Population
 #'
 #' @description
-#' Creates a new \code{\link{MegaPop-class}} from one or more
-#' \code{\link{Pop-class}} and/or \code{\link{MegaPop-class}}
+#' Creates a new \code{\link{MultiPop-class}} from one or more
+#' \code{\link{Pop-class}} and/or \code{\link{MultiPop-class}}
 #' objects.
 #'
 #' @param ... one or more \code{\link{Pop-class}} and/or
-#' \code{\link{MegaPop-class}} objects.
+#' \code{\link{MultiPop-class}} objects.
 #'
-#' @return Returns an object of \code{\link{MegaPop-class}}
+#' @return Returns an object of \code{\link{MultiPop-class}}
 #'
 #' @examples
 #' #Create founder haplotypes
@@ -979,21 +986,21 @@ setMethod("c",
 #'
 #' #Create population
 #' pop = newPop(founderPop, simParam=SP)
-#' megaPop = newMegaPop(pop=pop)
-#' isMegaPop(megaPop)
+#' megaPop = newMultiPop(pop=pop)
+#' isMultiPop(megaPop)
 #'
 #' @export
-newMegaPop = function(...){
+newMultiPop = function(...){
   input = list(...)
   class = sapply(input, "class")
-  stopifnot(all(class=="Pop" | class=="MegaPop"))
-  output = new("MegaPop", pops=input)
+  stopifnot(all(class=="Pop" | class=="MultiPop"))
+  output = new("MultiPop", pops=input)
   return(output)
 }
 
-#' @describeIn MegaPop Test if object is of a MegaPop class
+#' @describeIn MultiPop Test if object is of a MultiPop class
 #' @export
-isMegaPop = function(x) {
-  ret = is(x, class2 = "MegaPop")
+isMultiPop = function(x) {
+  ret = is(x, class2 = "MultiPop")
   return(ret)
 }