Update simulate

5 files changed, 128 insertions, 144 deletions

diff --git a/R/gdistremoval.R b/R/gdistremoval.R
index 29c685f..fdeab80 100644
--- a/R/gdistremoval.R
+++ b/R/gdistremoval.R
@@ -674,7 +674,8 @@ setMethod("ranef", "unmarkedFitGDR", function(object){
   new("unmarkedRanef", post=post)
 })
 
-setMethod("simulate", "unmarkedFitGDR", function(object, nsim, seed=NULL, na.rm=FALSE){
+setMethod("simulate_internal", "unmarkedFitGDR", 
+  function(object, nsim, na.rm=FALSE){
 
   # Adjust log lambda when there is a random intercept
   #loglam <- log(predict(object, "lambda", level=NULL)$Predicted)
diff --git a/R/goccu.R b/R/goccu.R
index d692c14..ca54fc6 100644
--- a/R/goccu.R
+++ b/R/goccu.R
@@ -267,8 +267,8 @@ setMethod("ranef", "unmarkedFitGOccu", function(object, ...){
 })
 
 
-setMethod("simulate", "unmarkedFitGOccu", 
-          function(object, nsim = 1, seed = NULL, na.rm = FALSE){
+setMethod("simulate_internal", "unmarkedFitGOccu", 
+          function(object, nsim = 1, na.rm = FALSE){
   
   gd <- getDesign(object@data, object@formula, na.rm=FALSE)
   M <- nrow(gd$y)
diff --git a/R/occuCOP.R b/R/occuCOP.R
index 29ecc89..d91879e 100644
--- a/R/occuCOP.R
+++ b/R/occuCOP.R
@@ -462,10 +462,9 @@ setMethod("simulate_fit", "unmarkedFitOccuCOP",
 
 
 ## simulate ----
-setMethod("simulate", "unmarkedFitOccuCOP",
-  function(object, nsim = 1, seed = NULL, na.rm = TRUE){
-  # set.seed(seed) 
-  # Purposefully not implemented
+setMethod("simulate_internal", "unmarkedFitOccuCOP",
+  function(object, nsim = 1, na.rm = TRUE){
+
   formula <- object@formula
   umf <- object@data
   designMats <- getDesign(umf = umf, formlist = object@formlist, na.rm = na.rm)
diff --git a/R/unmarkedFit.R b/R/unmarkedFit.R
index bf9decb..3d664ca 100644
--- a/R/unmarkedFit.R
+++ b/R/unmarkedFit.R
@@ -2057,9 +2057,20 @@ setMethod("getY", "unmarkedFitOccuMulti", function(object) {
 })
 
 
+# Simulate methods-------------------------------------------------------------
 
-setMethod("simulate", "unmarkedFitDS",
-    function(object, nsim = 1, seed = NULL, na.rm=TRUE)
+setMethod("simulate", "unmarkedFit", 
+  function(object, nsim = 1, seed = NULL, na.rm= TRUE){
+  simulate_internal(object, nsim = nsim, na.rm = na.rm)
+})
+
+setGeneric("simulate_internal", function(object, nsim = 1, na.rm = TRUE){
+  standardGeneric("simulate_internal")
+})
+
+
+setMethod("simulate_internal", "unmarkedFitDS",
+    function(object, nsim = 1, na.rm=TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2102,10 +2113,8 @@ setMethod("simulate", "unmarkedFitDS",
 })
 
 
-
-
-setMethod("simulate", "unmarkedFitPCount",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitPCount",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2273,8 +2282,8 @@ simOpenN <- function(object, na.rm)
     N
 }
 
-setMethod("simulate", "unmarkedFitPCO",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitPCO",
+    function(object, nsim = 1, na.rm = TRUE)
 {
 
     umf <- object@data
@@ -2296,9 +2305,9 @@ setMethod("simulate", "unmarkedFitPCO",
     return(simList)
 })
 
-
-setMethod("simulate", "unmarkedFitDailMadsen",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+# Applies to unmarkedFitDSO and unmarkedFitMMO
+setMethod("simulate_internal", "unmarkedFitDailMadsen",
+    function(object, nsim = 1, na.rm = TRUE)
 {
   umf <- object@data
   D <- getDesign(umf, object@formula, na.rm = na.rm)
@@ -2339,8 +2348,8 @@ setMethod("simulate", "unmarkedFitDailMadsen",
 })
 
 
-setMethod("simulate", "unmarkedFitMPois",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitMPois",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2366,10 +2375,8 @@ setMethod("simulate", "unmarkedFitMPois",
 })
 
 
-
-
-setMethod("simulate", "unmarkedFitOccu",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitOccu",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2396,56 +2403,57 @@ setMethod("simulate", "unmarkedFitOccu",
 })
 
 
-setMethod("simulate", "unmarkedFitOccuFP",
-          function(object, nsim = 1, seed = NULL, na.rm = TRUE)
-          {
-            detformula <- object@detformula
-            stateformula <- object@stateformula
-            FPformula <- object@FPformula
-            Bformula <- object@Bformula
-            umf <- object@data
-            designMats <- getDesign(umf, detformula,FPformula,Bformula,stateformula, na.rm = na.rm)
-            X <- designMats$X; V <- designMats$V; U <- designMats$U; W <- designMats$W;
-            y <- designMats$y
-            X.offset <- designMats$X.offset; V.offset <- designMats$V.offset; U.offset <- designMats$U.offset; W.offset <- designMats$W.offset
-            if(is.null(X.offset)) {
-              X.offset <- rep(0, nrow(X))
-            }
-            if(is.null(V.offset)) {
-              V.offset <- rep(0, nrow(V))
-            }
-            if(is.null(U.offset)) {
-              U.offset <- rep(0, nrow(U))
-            }
-            if(is.null(W.offset)) {
-              W.offset <- rep(0, nrow(W))
-            }
-            M <- nrow(y)
-            J <- ncol(y)
-            allParms <- coef(object, altNames = FALSE)
-            psiParms <- coef(object, type = "state")
-            psi <- as.numeric(plogis(X %*% psiParms + X.offset))
-            p <- c(t(getP(object)))
-            fp <- c(t(getFP(object)))
-            b <- c(t(getB(object)))
-            simList <- list()
-            for(i in 1:nsim) {
-              Z <- rbinom(M, 1, psi)
-              Z[object@knownOcc] <- 1
-              Z <- rep(Z, each = J)
-              P <- matrix(0,M*J,3)
-              P[,1] <- Z*rbinom(M * J, 1, prob = (1-p)) + (1-Z)*rbinom(M * J, 1, prob = (1-fp))
-              P[,2] <- (1-P[,1])*(1-Z) + (1-P[,1])*rbinom(M * J, 1, prob = (1-b))*Z
-              P[,3] <- 1 - P[,1]-P[,2]
-              yvec <- sapply(1:(M*J),function(x) which(as.logical(rmultinom2(1,1,P[x,])))-1)
-              simList[[i]] <- matrix(yvec, M, J, byrow = TRUE)
-            }
-            return(simList)
-          })
+setMethod("simulate_internal", "unmarkedFitOccuFP",
+  function(object, nsim = 1, na.rm = TRUE)
+{
+  detformula <- object@detformula
+  stateformula <- object@stateformula
+  FPformula <- object@FPformula
+  Bformula <- object@Bformula
+  umf <- object@data
+  designMats <- getDesign(umf, detformula,FPformula,Bformula,stateformula, na.rm = na.rm)
+  X <- designMats$X; V <- designMats$V; U <- designMats$U; W <- designMats$W;
+  y <- designMats$y
+  X.offset <- designMats$X.offset; V.offset <- designMats$V.offset 
+  U.offset <- designMats$U.offset; W.offset <- designMats$W.offset
+  if(is.null(X.offset)) {
+    X.offset <- rep(0, nrow(X))
+  }
+  if(is.null(V.offset)) {
+    V.offset <- rep(0, nrow(V))
+  }
+  if(is.null(U.offset)) {
+    U.offset <- rep(0, nrow(U))
+  }
+  if(is.null(W.offset)) {
+    W.offset <- rep(0, nrow(W))
+  }
+  M <- nrow(y)
+  J <- ncol(y)
+  allParms <- coef(object, altNames = FALSE)
+  psiParms <- coef(object, type = "state")
+  psi <- as.numeric(plogis(X %*% psiParms + X.offset))
+  p <- c(t(getP(object)))
+  fp <- c(t(getFP(object)))
+  b <- c(t(getB(object)))
+  simList <- list()
+  for(i in 1:nsim) {
+    Z <- rbinom(M, 1, psi)
+    Z[object@knownOcc] <- 1
+    Z <- rep(Z, each = J)
+    P <- matrix(0,M*J,3)
+    P[,1] <- Z*rbinom(M * J, 1, prob = (1-p)) + (1-Z)*rbinom(M * J, 1, prob = (1-fp))
+    P[,2] <- (1-P[,1])*(1-Z) + (1-P[,1])*rbinom(M * J, 1, prob = (1-b))*Z
+    P[,3] <- 1 - P[,1]-P[,2]
+    yvec <- sapply(1:(M*J),function(x) which(as.logical(rmultinom2(1,1,P[x,])))-1)
+    simList[[i]] <- matrix(yvec, M, J, byrow = TRUE)
+  }
+  return(simList)
+})
 
 
-setMethod("simulate", "unmarkedFitOccuMulti",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitOccuMulti",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     data <- object@data
     ynames <- names(object@data@ylist)
@@ -2482,8 +2490,8 @@ setMethod("simulate", "unmarkedFitOccuMulti",
 })
 
 
-setMethod("simulate", "unmarkedFitOccuMS",
-    function(object, nsim = 1, seed = NULL, na.rm=TRUE)
+setMethod("simulate_internal", "unmarkedFitOccuMS",
+    function(object, nsim = 1, na.rm=TRUE)
 {
 
   S <- object@data@numStates
@@ -2604,8 +2612,8 @@ setMethod("simulate", "unmarkedFitOccuMS",
 })
 
 
-setMethod("simulate", "unmarkedFitOccuTTD",
-          function(object,  nsim = 1, seed = NULL, na.rm = FALSE)
+setMethod("simulate_internal", "unmarkedFitOccuTTD",
+          function(object, nsim = 1, na.rm = FALSE)
 {
 
   N <- nrow(object@data@y)
@@ -2669,8 +2677,9 @@ setMethod("simulate", "unmarkedFitOccuTTD",
   simlist
 })
 
-setMethod("simulate", "unmarkedFitNmixTTD",
-          function(object,  nsim = 1, seed = NULL, na.rm = FALSE)
+
+setMethod("simulate_internal", "unmarkedFitNmixTTD",
+          function(object,  nsim = 1, na.rm = FALSE)
 {
 
   M <- nrow(object@data@y)
@@ -2720,8 +2729,9 @@ setMethod("simulate", "unmarkedFitNmixTTD",
   simlist
 })
 
-setMethod("simulate", "unmarkedFitColExt",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+
+setMethod("simulate_internal", "unmarkedFitColExt",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     data <- object@data
     psiParms <- coef(object, 'psi')
@@ -2791,10 +2801,8 @@ setMethod("simulate", "unmarkedFitColExt",
 })
 
 
-
-
-setMethod("simulate", "unmarkedFitOccuRN",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitOccuRN",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2825,9 +2833,8 @@ setMethod("simulate", "unmarkedFitOccuRN",
 })
 
 
-
-setMethod("simulate", "unmarkedFitGMM",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitGMM",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2902,11 +2909,8 @@ setMethod("simulate", "unmarkedFitGMM",
 })
 
 
-
-
-
-setMethod("simulate", "unmarkedFitGPC",
-    function(object, nsim = 1, seed = NULL, na.rm = TRUE)
+setMethod("simulate_internal", "unmarkedFitGPC",
+    function(object, nsim = 1, na.rm = TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -2973,8 +2977,8 @@ setMethod("simulate", "unmarkedFitGPC",
 })
 
 
-setMethod("simulate", "unmarkedFitGDS",
-    function(object, nsim = 1, seed = NULL, na.rm=TRUE)
+setMethod("simulate_internal", "unmarkedFitGDS",
+    function(object, nsim = 1, na.rm=TRUE)
 {
     formula <- object@formula
     umf <- object@data
@@ -3061,6 +3065,3 @@ setMethod("simulate", "unmarkedFitGDS",
         }
     return(simList)
 })
-
-
-
diff --git a/man/simulate-methods.Rd b/man/simulate.Rd
index 21bd377..e56214c 100644
--- a/man/simulate-methods.Rd
+++ b/man/simulate.Rd
@@ -1,46 +1,27 @@
-\name{simulate-methods}
-\docType{methods}
+\name{simulate}
+\alias{simulate}
 \alias{simulate-methods}
-\alias{simulate,unmarkedFitColExt-method}
-\alias{simulate,unmarkedFitDS-method}
-\alias{simulate,unmarkedFitMPois-method}
-\alias{simulate,unmarkedFitOccu-method}
-\alias{simulate,unmarkedFitOccuRN-method}
-\alias{simulate,unmarkedFitOccuFP-method}
-\alias{simulate,unmarkedFitOccuMulti-method}
-\alias{simulate,unmarkedFitOccuMS-method}
-\alias{simulate,unmarkedFitOccuTTD-method}
-\alias{simulate,unmarkedFitNmixTTD-method}
-\alias{simulate,unmarkedFitPCount-method}
-\alias{simulate,unmarkedFitPCO-method}
-\alias{simulate,unmarkedFitGMM-method}
-\alias{simulate,unmarkedFitGDS-method}
-\alias{simulate,unmarkedFitGPC-method}
-\alias{simulate,unmarkedFitGDR-method}
-\alias{simulate,unmarkedFitDailMadsen-method}
-\alias{simulate,unmarkedFitGOccu-method}
-\alias{simulate,unmarkedFitOccuCOP-method}
+\alias{simulate,unmarkedFit-method}
 \alias{simulate,character-method}
-\title{Methods for Function simulate in Package `unmarked'}
-\description{
-Simulate data from a fitted model.
-}
+
+\title{Simulate datasets for 'unmarked' models}
+
+\description{Simulate a new dataset from a fitted model or from custom input settings.}
+
 \usage{
-\S4method{simulate}{unmarkedFitColExt}(object, nsim, seed, na.rm)
-\S4method{simulate}{unmarkedFitDS}(object, nsim, seed, na.rm)
-\S4method{simulate}{unmarkedFitMPois}(object, nsim, seed, na.rm)
-\S4method{simulate}{unmarkedFitOccu}(object, nsim, seed, na.rm)
-\S4method{simulate}{unmarkedFitOccuRN}(object, nsim, seed, na.rm)
-\S4method{simulate}{unmarkedFitPCount}(object, nsim, seed, na.rm)
-\S4method{simulate}{character}(object, nsim=1, seed=NULL, formulas, coefs=NULL,
+\S4method{simulate}{unmarkedFit}(object, nsim = 1, seed = NULL, na.rm = TRUE)
+\S4method{simulate}{character}(object, nsim = 1, seed = NULL, formulas, coefs=NULL,
   design, guide=NULL, ...)
 }
 
 \arguments{
-\item{object}{Fitted model of appropriate S4 class}
-\item{nsim}{Number of simulations}
-\item{seed}{Seed for random number generator. Not currently implemented}
-\item{na.rm}{Logical, should missing values be removed?}
+\item{object}{An \code{unmarkedFit} object (to simulate from a fitted model),
+  or a character string with the model function name (to simulate an entirely
+  new dataset).}
+\item{nsim}{Number of simulated datsets to generate.}
+\item{seed}{Seed for random number generator. This is not implemented and does nothing.}
+\item{na.rm}{Logical. When simulating from a \code{unmarkedFit} object, should 
+  missing values be removed?}
 \item{formulas}{
   A named list of formulas, one per submodel (e.g. a formula for occupancy
   \code{"state"} and a formula for detection \code{"det"}). To get the correct
@@ -75,17 +56,19 @@ Simulate data from a fitted model.
 }
 }
 
-\section{Methods}{
-\describe{
-\item{object = "unmarkedFitColExt"}{A model fit by \code{\link{colext}}}
-\item{object = "unmarkedFitDS"}{A model fit by \code{\link{distsamp}}}
-\item{object = "unmarkedFitMPois"}{A model fit by \code{\link{multinomPois}}}
-\item{object = "unmarkedFitOccu"}{A model fit by \code{\link{occu}}}
-\item{object = "unmarkedFitOccuRN"}{A model fit by \code{\link{occuRN}}}
-\item{object = "unmarkedFitPCount"}{A model fit by \code{\link{pcount}}}
-\item{object = "character"}{An \code{unmarkedFrame} of the appropriate type}
-}}
-\keyword{methods}
+\value{When simulating from a \code{unmarkedFit} model, a list of simulated
+ \code{y}-matrices. When simulating from scratch, a list of complete
+ \code{unmarkedFrame}s for the chosen model type.} 
+
+\details{This function does two different things depending on the inputs provided.
+  If you run \code{simulate} on a fitted model (an \code{unmarkedFit} object),
+  you will get a list of observed data (\code{y}-matrices) simulated based on
+  the fitted model. These are useful for e.g. bootstrapping. Alternatively,
+  if you provide the name of an \code{unmarked} fitting function as a string to
+  the first argument, such as \code{"occu"}, along with other settings described
+  above you can generate a dataset for that model type from scratch to be used
+  for examples, validation, etc.
+}
 
 \examples{