Update fitted

6 files changed, 63 insertions, 86 deletions

diff --git a/R/gdistremoval.R b/R/gdistremoval.R
index b253625..4610784 100644
--- a/R/gdistremoval.R
+++ b/R/gdistremoval.R
@@ -536,7 +536,7 @@ setMethod("getP", "unmarkedFitGDR", function(object){
   out
 })
 
-setMethod("fitted", "unmarkedFitGDR", function(object){
+setMethod("fitted_internal", "unmarkedFitGDR", function(object, na.rm = FALSE){
 
   T <- object@data@numPrimary
 
diff --git a/R/goccu.R b/R/goccu.R
index 487fb49..d692c14 100644
--- a/R/goccu.R
+++ b/R/goccu.R
@@ -190,7 +190,7 @@ setMethod("getP", "unmarkedFitGOccu",
   p
 })
 
-setMethod("fitted", "unmarkedFitGOccu",
+setMethod("fitted_internal", "unmarkedFitGOccu",
   function(object, na.rm= FALSE){
 
   M <- numSites(object@data)
diff --git a/R/occuCOP.R b/R/occuCOP.R
index f22c235..672efd5 100644
--- a/R/occuCOP.R
+++ b/R/occuCOP.R
@@ -380,7 +380,7 @@ setMethod("getP", "unmarkedFitOccuCOP", function(object, na.rm = TRUE) {
 
 
 ## fitted ----
-setMethod("fitted", "unmarkedFitOccuCOP", function(object, na.rm = FALSE) {
+setMethod("fitted_internal", "unmarkedFitOccuCOP", function(object, na.rm = FALSE) {
   data <- object@data
   M = nrow(getY(data))
   J = ncol(getY(data))
diff --git a/R/unmarkedFit.R b/R/unmarkedFit.R
index 97ccfe4..bf9decb 100644
--- a/R/unmarkedFit.R
+++ b/R/unmarkedFit.R
@@ -398,35 +398,39 @@ setMethod("confint", "unmarkedFit", function(object, parm, level = 0.95,
 })
 
 
+# Fitted-----------------------------------------------------------------------
+setMethod("fitted", "unmarkedFit", function(object, na.rm = FALSE){
+  fitted_internal(object, na.rm = na.rm)
+})
 
-setMethod("fitted", "unmarkedFit",
-    function(object, na.rm = FALSE)
-{
-    data <- object@data
-    des <- getDesign(data, object@formula, na.rm = na.rm)
-    X <- cbind(des$X, des$Z_state)
-    X.offset <- des$X.offset
-    if (is.null(X.offset)) {
-        X.offset <- rep(0, nrow(X))
-        }
-    beta_state <- coef(object, 'state', fixedOnly=FALSE)
-    state <- do.call(object['state']@invlink,
-        list(as.matrix(X %*% beta_state + X.offset)))
-    state <- as.numeric(state)  ## E(X) for most models
-    p <- getP(object, na.rm = na.rm) # P(detection | presence)
-    fitted <- state * p  # true for models with E[Y] = p * E[X]
-    fitted
+setGeneric("fitted_internal", function(object, na.rm = FALSE){
+  standardGeneric("fitted_internal")
 })
 
 
+setMethod("fitted_internal", "unmarkedFit", function(object, na.rm = FALSE){
+  data <- object@data
+  des <- getDesign(data, object@formula, na.rm = na.rm)
+  X <- cbind(des$X, des$Z_state)
+  X.offset <- des$X.offset
+  if (is.null(X.offset)) X.offset <- rep(0, nrow(X))
+  beta_state <- coef(object, 'state', fixedOnly=FALSE)
+  state <- do.call(object['state']@invlink,
+  list(as.matrix(X %*% beta_state + X.offset)))
+  state <- as.numeric(state)  ## E(X) for most models
+  p <- getP(object, na.rm = na.rm) # P(detection | presence)
+  fitted <- state * p  # true for models with E[Y] = p * E[X]
+  fitted
+})
 
-setMethod("fitted", "unmarkedFitOccuFP", function(object, na.rm = FALSE)
+
+setMethod("fitted_internal", "unmarkedFitOccuFP", function(object, na.rm = FALSE)
 {
   cat("fitted is not implemented for occuFP at this time")
 })
 
 
-setMethod("fitted", "unmarkedFitDS", function(object, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitDS", function(object, na.rm = FALSE)
 {
     data <- object@data
     db <- data@dist.breaks
@@ -464,7 +468,7 @@ setMethod("fitted", "unmarkedFitDS", function(object, na.rm = FALSE)
 
 
 
-setMethod("fitted", "unmarkedFitOccu", function(object, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitOccu", function(object, na.rm = FALSE)
 {
     data <- object@data
     des <- getDesign(data, object@formula, na.rm = na.rm)
@@ -483,7 +487,7 @@ setMethod("fitted", "unmarkedFitOccu", function(object, na.rm = FALSE)
 
 
 
-setMethod("fitted", "unmarkedFitPCount", function(object, K, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitPCount", function(object, na.rm = FALSE)
 {
     data <- object@data
     des <- getDesign(data, object@formula, na.rm = na.rm)
@@ -498,8 +502,6 @@ setMethod("fitted", "unmarkedFitPCount", function(object, K, na.rm = FALSE)
     state <- exp(X %*% coef(object, 'state', fixedOnly=FALSE) + X.offset)
     p <- getP(object, na.rm = na.rm)
     mix <- object@mixture
-##    if(!is.missing(K))
-##        warning("The K argument is ignored")
     switch(mix,
            P = {
                fitted <- as.numeric(state) * p
@@ -507,8 +509,7 @@ setMethod("fitted", "unmarkedFitPCount", function(object, K, na.rm = FALSE)
            NB = {
                ## I don't think this sum is necessary. Could do:
                ## fitted <- as.numeric(state) * p
-               if(missing(K))
-                   K <- object@K
+               K <- object@K
                k <- 0:K
                k.ijk <- rep(k, M*J)
                state.ijk <- state[rep(1:M, each = J*(K+1))]
@@ -532,8 +533,8 @@ setMethod("fitted", "unmarkedFitPCount", function(object, K, na.rm = FALSE)
 })
 
 
-setMethod("fitted", "unmarkedFitDailMadsen",
-    function(object, K, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitDailMadsen",
+    function(object, na.rm = FALSE)
 {
     dynamics <- object@dynamics
     mixture <- object@mixture
@@ -649,7 +650,7 @@ setMethod("fitted", "unmarkedFitDailMadsen",
 })
 
 
-setMethod("fitted", "unmarkedFitOccuRN", function(object, K, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitOccuRN", function(object, na.rm = FALSE)
 {
     data <- object@data
     des <- getDesign(data, object@formula, na.rm = na.rm)
@@ -667,14 +668,12 @@ setMethod("fitted", "unmarkedFitOccuRN", function(object, K, na.rm = FALSE)
     J <- ncol(y)
     lam <- exp(X %*% coef(object, 'state') + X.offset)
     r <- plogis(V %*% coef(object, 'det') + V.offset)
-    if(missing(K))
-        K <- object@K ##max(y, na.rm = TRUE) + 20
     lam <- rep(lam, each = J)
     fitted <- 1 - exp(-lam*r) ## analytical integration.
     return(matrix(fitted, M, J, byrow = TRUE))
 })
 
-setMethod("fitted", "unmarkedFitOccuMulti", function(object)
+setMethod("fitted_internal", "unmarkedFitOccuMulti", function(object, na.rm = FALSE)
 {
 
   S <- length(object@data@ylist)
@@ -692,7 +691,7 @@ setMethod("fitted", "unmarkedFitOccuMulti", function(object)
 
 })
 
-setMethod("fitted", "unmarkedFitOccuMS", function(object, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitOccuMS", function(object, na.rm = FALSE)
 {
   data <- object@data
   T <- data@numPrimary
@@ -737,7 +736,7 @@ setMethod("fitted", "unmarkedFitOccuMS", function(object, na.rm = FALSE)
   fit_out
 })
 
-setMethod("fitted", "unmarkedFitColExt", function(object, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitColExt", function(object, na.rm = FALSE)
 {
     data <- object@data
     M <- numSites(data)
@@ -802,7 +801,7 @@ setMethod("fitted", "unmarkedFitColExt", function(object, na.rm = FALSE)
 
 
 # This covers unmarkedFitGDS too
-setMethod("fitted", "unmarkedFitGMM",
+setMethod("fitted_internal", "unmarkedFitGMM",
     function(object, na.rm = FALSE)
 {
 
@@ -845,7 +844,7 @@ setMethod("fitted", "unmarkedFitGMM",
 })
 
 
-setMethod("fitted", "unmarkedFitOccuTTD", function(object, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitOccuTTD", function(object, na.rm = FALSE)
 {
 
   N <- nrow(object@data@y)
@@ -900,7 +899,7 @@ setMethod("fitted", "unmarkedFitOccuTTD", function(object, na.rm = FALSE)
 })
 
 
-setMethod("fitted", "unmarkedFitNmixTTD", function(object, na.rm = FALSE)
+setMethod("fitted_internal", "unmarkedFitNmixTTD", function(object, na.rm = FALSE)
 {
   stop("This method is not implemented for nmixTTD at this time", call.=FALSE)
 })
diff --git a/man/fitted-methods.Rd b/man/fitted-methods.Rd
deleted file mode 100644
index 7ef7ede..0000000
--- a/man/fitted-methods.Rd
+++ /dev/null
@@ -1,47 +0,0 @@
-\name{fitted-methods}
-\docType{methods}
-\alias{fitted-methods}
-\alias{fitted,unmarkedFit-method}
-\alias{fitted,unmarkedFitColExt-method}
-\alias{fitted,unmarkedFitOccu-method}
-\alias{fitted,unmarkedFitOccuFP-method}
-\alias{fitted,unmarkedFitOccuRN-method}
-\alias{fitted,unmarkedFitOccuMulti-method}
-\alias{fitted,unmarkedFitOccuMS-method}
-\alias{fitted,unmarkedFitOccuTTD-method}
-\alias{fitted,unmarkedFitNmixTTD-method}
-\alias{fitted,unmarkedFitPCount-method}
-\alias{fitted,unmarkedFitDS-method}
-\alias{fitted,unmarkedFitGMM-method}
-\alias{fitted,unmarkedFitGDR-method}
-\alias{fitted,unmarkedFitDailMadsen-method}
-\alias{fitted,unmarkedFitGOccu-method}
-\alias{fitted,unmarkedFitOccuCOP-method}
-\title{Methods for Function fitted in Package `unmarked'}
-\description{Extracted fitted values from a fitted model.
-}
-\usage{
-\S4method{fitted}{unmarkedFit}(object, na.rm = FALSE)
-\S4method{fitted}{unmarkedFitColExt}(object, na.rm = FALSE)
-\S4method{fitted}{unmarkedFitOccu}(object, na.rm = FALSE)
-\S4method{fitted}{unmarkedFitOccuRN}(object, K, na.rm = FALSE)
-\S4method{fitted}{unmarkedFitPCount}(object, K, na.rm = FALSE)
-\S4method{fitted}{unmarkedFitDS}(object, na.rm = FALSE)
-}
-\arguments{
-\item{object}{A fitted model of appropriate S4 class}
-\item{K}{Integer specifying upper bound of integration.}
-\item{na.rm}{Logical. Should missing values be removed from data?}
-}
-\section{Methods}{
-\describe{
-\item{object = "unmarkedFit"}{A fitted model}
-\item{object = "unmarkedFitColExt"}{A model fit by \code{\link{colext}}}
-\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 = "unmarkedFitDS"}{A model fit by \code{\link{distsamp}}}
-}}
-\value{Returns a matrix of expected values}
-\keyword{methods}
-
diff --git a/man/fitted.Rd b/man/fitted.Rd
new file mode 100644
index 0000000..db33309
--- /dev/null
+++ b/man/fitted.Rd
@@ -0,0 +1,25 @@
+\name{fitted}
+\alias{fitted}
+\alias{fitted-methods}
+\alias{fitted,unmarkedFit-method}
+
+\title{Calculate fitted (expected) values from a model}
+
+\description{Calculates expected values from a model. The approach varies based
+on the model type but is usually the product of the state and detection parameters.}
+
+\usage{
+\S4method{fitted}{unmarkedFit}(object, na.rm = FALSE)
+}
+
+\arguments{
+  \item{object}{A \code{unmarkedFit} object}
+  \item{na.rm}{Logical. Should missing values be removed from data? Not all model
+               types support this.}
+}
+
+\value{In most cases, \code{fitted} returns a matrix of expected values with the 
+  same dimensions as the \code{y} matrix (M x J or M x JT). For some models with 
+  multiple observation processes or multiple species, such as \code{gdistremoval}
+  or \code{occuMulti}, the output may be a named list of matrices.
+}