Merge pull request #40 from gaynorr/devel

Devel

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: AlphaSimR
 Type: Package
 Title: Breeding Program Simulations
-Version: 1.0.4
-Date: 2021-09-08
+Version: 1.1.2
+Date: 2022-2-17
 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", 
@@ -30,7 +30,7 @@ Encoding: UTF-8
 Depends: R (>= 3.3.0), methods, R6
 Imports: Rcpp (>= 0.12.7)
 LinkingTo: Rcpp, RcppArmadillo (>= 0.7.500.0.0), BH
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Suggests: knitr, rmarkdown, testthat
 VignetteBuilder: knitr
 NeedsCompilation: true

NAMESPACE

@@ -26,6 +26,7 @@ export(genicVarA)
 export(genicVarAA)
 export(genicVarD)
 export(genicVarG)
+export(getNumThreads)
 export(getQtlMap)
 export(getSnpMap)
 export(gv)
@@ -73,6 +74,15 @@ export(setPheno)
 export(setPhenoGCA)
 export(setPhenoProgTest)
 export(smithHazel)
+export(solveMKM)
+export(solveMVM)
+export(solveRRBLUP)
+export(solveRRBLUPMK)
+export(solveRRBLUPMV)
+export(solveRRBLUP_EM)
+export(solveRRBLUP_EM2)
+export(solveRRBLUP_EM3)
+export(solveUVM)
 export(usefulness)
 export(varA)
 export(varAA)

NEWS

@@ -1,3 +1,26 @@
+Changes in version 1.1.2
+
+  Bug fixes
+    -added missing #ifdef _OPENMP to OCS.cpp
+
+Changes in version 1.1.1
+
+  Bug fixes
+    -removed use of PI variable in C++ code which is compilier specific
+
+Changes in version 1.1.0
+
+  New features
+    -added snpChip argument to pullIbdHaplo for backwards compatibility
+    -exposed internal mixed model solvers
+    -all selection functions now return a warning when there are not enough individuals
+
+  Bug fixes
+    -fixed error in pullIbdHaplo when chr isn't NULL
+    -fixed an error with assigning 1 QTL and/or SNP
+    -changed geno slot from matrix to list to support future RcppArmadillo changes
+    -doubleGenome and reduceGenome now work with IBD tracking
+
 Changes in version 1.0.4
 
   Bug fixes

R/Class-HybridPop.R

@@ -122,3 +122,8 @@ setMethod("c",
             return(x)
           }
 )
+
+isHybridPop = function(x) {
+  ret = is(x, class2 = "HybridPop")
+  return(ret)
+}

R/Class-LociMap.R

@@ -31,6 +31,11 @@ setValidity("LociMap",function(object){
   }
 })
 
+isLociMap = function(x) {
+  ret = is(x, class2 = "LociMap")
+  return(ret)
+}
+
 #TraitA----
 #' @title Additive trait
 #' 
@@ -58,6 +63,11 @@ setValidity("TraitA",function(object){
   }
 })
 
+isTraitA = function(x) {
+  ret = is(x, class2 = "TraitA")
+  return(ret)
+}
+
 #TraitA2----
 #' @title Sex specific additive trait
 #' 
@@ -84,6 +94,11 @@ setValidity("TraitA2",function(object){
   }
 })
 
+isTraitA2 = function(x) {
+  ret = is(x, class2 = "TraitA2")
+  return(ret)
+}
+
 #TraitAE----
 #' @title Additive and epistatic trait
 #' 
@@ -112,6 +127,11 @@ setValidity("TraitAE",function(object){
   }
 })
 
+isTraitAE = function(x) {
+  ret = is(x, class2 = "TraitAE")
+  return(ret)
+}
+
 #TraitAD----
 #' @title Additive and dominance trait
 #' 
@@ -137,6 +157,11 @@ setValidity("TraitAD",function(object){
   }
 })
 
+isTraitAD = function(x) {
+  ret = is(x, class2 = "TraitAD")
+  return(ret)
+}
+
 #TraitA2D----
 #' @title Sex specific additive and dominance trait
 #' 
@@ -162,6 +187,11 @@ setValidity("TraitA2D",function(object){
   }
 })
 
+isTraitA2D = function(x) {
+  ret = is(x, class2 = "TraitA2D")
+  return(ret)
+}
+
 #TraitADE----
 #' @title Additive, dominance, and epistatic trait
 #' 
@@ -190,6 +220,11 @@ setValidity("TraitADE",function(object){
   }
 })
 
+isTraitADE = function(x) {
+  ret = is(x, class2 = "TraitADE")
+  return(ret)
+}
+
 #TraitAG----
 #' @title Additive and GxE trait
 #' 
@@ -219,6 +254,11 @@ setValidity("TraitAG",function(object){
   }
 })
 
+isTraitAG = function(x) {
+  ret = is(x, class2 = "TraitAG")
+  return(ret)
+}
+
 #TraitAEG----
 #' @title Additive, epistasis and GxE trait
 #' 
@@ -248,6 +288,11 @@ setValidity("TraitAEG",function(object){
   }
 })
 
+isTraitAEG = function(x) {
+  ret = is(x, class2 = "TraitAEG")
+  return(ret)
+}
+
 #TraitADG----
 #' @title Additive, dominance and GxE trait
 #' 
@@ -277,6 +322,11 @@ setValidity("TraitADG",function(object){
   }
 })
 
+isTraitADG = function(x) {
+  ret = is(x, class2 = "TraitADG")
+  return(ret)
+}
+
 #TraitADEG----
 #' @title Additive, dominance, epistasis, and GxE trait
 #' 
@@ -306,3 +356,7 @@ setValidity("TraitADEG",function(object){
   }
 })
 
+isTraitADEG = function(x) {
+  ret = is(x, class2 = "TraitADEG")
+  return(ret)
+}

R/Class-Pop.R

@@ -14,18 +14,17 @@
 #' @slot nChr number of chromosomes
 #' @slot ploidy level of ploidy
 #' @slot nLoci number of loci per chromosome
-#' @slot geno "matrix" containing chromosome genotypes. The "matrix" 
-#' has dimensions nChr by 1 and each element is a three dimensional
-#' array of raw values. The array dimensions are nLoci by ploidy by nInd.
-#' 
+#' @slot geno list of nChr length containing chromosome genotypes.
+#' Each element is a three dimensional array of raw values. 
+#' The array dimensions are nLoci by ploidy by nInd.
 #' 
 #' @export
 setClass("RawPop",
          slots=c(nInd="integer",
                  nChr="integer",
                  ploidy="integer",
                  nLoci="integer",
-                 geno="matrix"))
+                 geno="list"))
 
 setValidity("RawPop",function(object){
   errors = character()
@@ -112,6 +111,11 @@ setMethod("show",
           }
 )
 
+isRawPop = function(x) {
+  ret = is(x, class2 = "RawPop")
+  return(ret)
+}
+
 # MapPop ------------------------------------------------------------------
 
 #' @title Raw population with genetic map
@@ -126,7 +130,7 @@ setMethod("show",
 #' @param i index of individuals
 #' @param ... additional 'MapPop' objects
 #' 
-#' @slot genMap "matrix" of chromosome genetic maps
+#' @slot genMap list of chromosome genetic maps
 #' @slot centromere vector of centromere positions
 #' @slot inbred indicates whether the individuals are fully inbred
 #' 
@@ -192,6 +196,11 @@ setMethod("c",
           }
 )
 
+isMapPop = function(x) {
+  ret = is(x, class2 = "MapPop")
+  return(ret)
+}
+
 # NamedMapPop ------------------------------------------------------------------
 
 #' @title Raw population with genetic map and id
@@ -315,7 +324,7 @@ cChr = function(...){
         stopifnot(x@nInd==y@nInd,
                   x@ploidy==y@ploidy)
         x@nChr = x@nChr+y@nChr
-        x@geno = rbind(x@geno,y@geno)
+        x@geno = c(x@geno,y@geno)
         x@genMap = c(x@genMap,y@genMap)
         x@centromere = c(x@centromere,y@centromere)
         x@nLoci = c(x@nLoci,y@nLoci)
@@ -326,6 +335,11 @@ cChr = function(...){
   return(x)
 }
 
+isNamedMapPop = function(x) {
+  ret = is(x, class2 = "NamedMapPop")
+  return(ret)
+}
+
 # Pop ---------------------------------------------------------------------
 
 #' @title Population
@@ -726,6 +740,11 @@ resetPop = function(pop,simParam=NULL){
   return(pop)
 }
 
+isPop = function(x) {
+  ret = is(x, class2 = "Pop")
+  return(ret)
+}
+
 # MegaPop ------------------------------------------------------------------
 
 #' @title Mega-Population
@@ -833,3 +852,7 @@ newMegaPop = function(...){
   return(output)
 }
 
+isMegaPop = function(x) {
+  ret = is(x, class2 = "MegaPop")
+  return(ret)
+}

R/Class-RRsol.R

@@ -20,3 +20,7 @@ setClass("RRsol",
                  Vu="matrix",
                  Ve="matrix"))
 
+isRRsol = function(x) {
+  ret = is(x, class2 = "RRsol")
+  return(ret)
+}

R/Class-SimParam.R

@@ -1388,6 +1388,7 @@ SimParam = R6Class(
     #' positions. If NULL, the centromere are assumed to 
     #' be metacentric.
     switchGenMap = function(genMap, centromere=NULL){
+      genMap = lapply(genMap, function(x) x-x[1]) # Set position 1 to 0
       if(is.null(centromere)){
         centromere=sapply(genMap,max)/2
       }
@@ -1413,6 +1414,7 @@ SimParam = R6Class(
     #' positions. If NULL, the centromere are assumed to 
     #' be metacentric.
     switchFemaleMap = function(genMap, centromere=NULL){
+      genMap = lapply(genMap, function(x) x-x[1]) # Set position 1 to 0
       if(is.null(centromere)){
         centromere=sapply(genMap,max)/2
       }
@@ -1443,6 +1445,7 @@ SimParam = R6Class(
     #' positions. If NULL, the centromere are assumed to 
     #' be metacentric.
     switchMaleMap = function(genMap, centromere=NULL){
+      genMap = lapply(genMap, function(x) x-x[1]) # Set position 1 to 0
       if(is.null(centromere)){
         centromere=sapply(genMap,max)/2
       }
@@ -1682,7 +1685,11 @@ SimParam = R6Class(
         if(nSitesPerChr[x]==0){
           return(NULL)
         }else{
-          tmp = sort(sample(pot[[x]],nSitesPerChr[x]))
+          if(length(pot[[x]])==1){
+            tmp = pot[[x]]
+          }else{
+            tmp = sort(sample(pot[[x]],nSitesPerChr[x]))
+          }
           # Add site restrictions
           if(private$.restrSites){
             if(QTL){
@@ -1978,3 +1985,8 @@ sampEpiEff = function(qtlLoci,nTraits,corr,gamma,shape,relVar){
   epiEff = sweep(epiEff,2,sqrt(relVar),"*")
   return(epiEff)
 }
+
+isSimParam = function(x) {
+  ret = is(x, class2 = "SimParam")
+  return(ret)
+}

R/OCS.R

@@ -0,0 +1,4 @@
+
+# OCS_plant = function(pop, gsModel, simParam=NULL){
+#   
+# }