Refactor residuals method

DESCRIPTION

@@ -45,7 +45,7 @@ License: GPL (>=3)
 LazyLoad: yes
 LazyData: yes
 Collate: 'classes.R' 'unmarkedEstimate.R' 'mapInfo.R' 'unmarkedFrame.R'
-    'unmarkedFit.R' 'utils.R' 'getDesign.R' 'fitted.R' 'colext.R' 'distsamp.R'
+    'unmarkedFit.R' 'utils.R' 'getDesign.R' 'fitted.R' 'residuals.R' 'colext.R' 'distsamp.R'
     'multinomPois.R' 'occu.R' 'occuRN.R' 'occuMulti.R' 'pcount.R' 'gmultmix.R'
     'pcountOpen.R' 'gdistsamp.R' 'unmarkedFitList.R' 'unmarkedLinComb.R'
     'ranef.R' 'boot.R' 'occuFP.R' 'gpcount.R' 'occuPEN.R' 'pcount.spHDS.R'

R/IDS.R

@@ -467,7 +467,7 @@ setMethod("getP", "unmarkedFitIDS", function(object, ...){
 })
 
 
-setMethod("residuals", "unmarkedFitIDS", function(object, ...){
+setMethod("residuals_internal", "unmarkedFitIDS", function(object){
 
   dists <- names(object)[names(object) %in% c("ds", "pc")]
 

R/gdistremoval.R

@@ -586,7 +586,7 @@ setMethod("fitted_internal", "unmarkedFitGDR", function(object){
   list(dist=ft_dist, rem=ft_rem)
 })
 
-setMethod("residuals", "unmarkedFitGDR", function(object){
+setMethod("residuals_internal", "unmarkedFitGDR", function(object){
   ft <- fitted(object)
   list(dist=object@data@yDistance - ft$dist, rem=object@data@yRemoval-ft$rem)
 })

R/occuCOP.R

@@ -395,15 +395,6 @@ setMethod("fitted_internal", "unmarkedFitOccuCOP", function(object) {
 })
 
 
-## residuals ----
-setMethod("residuals", "unmarkedFitOccuCOP", function(object) {
-  y <- getY(object@data)
-  e <- fitted(object)
-  r <- y - e
-  return(r)
-})
-
-
 ## plot ----
 setMethod("plot", c(x = "unmarkedFitOccuCOP", y = "missing"), function(x, y, ...) {
   y <- getY(x)

R/residuals.R

@@ -0,0 +1,36 @@
+# Method for all fit types, exported
+setMethod("residuals", "unmarkedFit", function(object, ...){
+  residuals_internal(object)
+})
+
+# Internal method for specific fit types, not exported
+setGeneric("residuals_internal", function(object){
+  standardGeneric("residuals_internal")
+})
+
+setMethod("residuals_internal", "unmarkedFit", function(object) {
+    y <- getY(object)
+    e <- fitted(object)
+    r <- y - e
+    return(r)
+})
+
+setMethod("residuals_internal", "unmarkedFitOccuMulti", function(object) {
+  res_list <- list()
+  ylist <- getY(object)
+  fitlist <- fitted(object)
+
+  for (i in seq_along(ylist)){
+    res_list[[i]] <- ylist[[i]] - fitlist[[i]]
+  }
+  names(res_list) <- names(ylist)
+  res_list
+})
+
+setMethod("residuals_internal", "unmarkedFitOccuTTD", function(object) {
+  tmax <- object@data@surveyLength
+  yraw <- object@data@y
+  y <- ifelse(yraw<tmax,1,0)
+  e <- fitted(object)
+  y - e
+})

R/unmarkedFit.R

@@ -757,54 +757,6 @@ setMethod("plot", c("profile", "missing"), function(x) {
 })
 
 
-setMethod("residuals", "unmarkedFit", function(object, ...) {
-    y <- getY(object@data)
-    e <- fitted(object, na.rm = FALSE)
-    r <- y - e
-    return(r)
-})
-
-setMethod("residuals", "unmarkedFitOccu", function(object, ...) {
-    y <- getY(object@data)
-    y <- truncateToBinary(y)
-    e <- fitted(object, na.rm = FALSE)
-    r <- y - e
-    return(r)
-})
-
-setMethod("residuals", "unmarkedFitOccuFP", function(object, ...) {
-  cat("residuals is not implemented for occuFP at this time")
-})
-
-
-setMethod("residuals", "unmarkedFitOccuRN", function(object, ...) {
-    y <- getY(object@data)
-    y <- truncateToBinary(y)
-    e <- fitted(object, na.rm = FALSE)
-    r <- y - e
-    return(r)
-})
-
-setMethod("residuals", "unmarkedFitOccuMulti", function(object, ...) {
-  res_list <- list()
-  ylist <- object@data@ylist
-  fitlist <- fitted(object)
-
-  for (i in seq_along(ylist)){
-    res_list[[i]] <- ylist[[i]] - fitlist[[i]]
-  }
-  names(res_list) <- names(ylist)
-  res_list
-})
-
-setMethod("residuals", "unmarkedFitOccuTTD", function(object, ...) {
-  tmax <- object@data@surveyLength
-  yraw <- object@data@y
-  y <- ifelse(yraw<tmax,1,0)
-  e <- fitted(object)
-  y - e
-})
-
 setMethod("plot", c(x = "unmarkedFit", y = "missing"), function(x, y, ...)
 {
     r <- residuals(x)

man/residuals.Rd

@@ -0,0 +1,24 @@
+\name{residuals}
+\alias{residuals}
+\alias{residuals,unmarkedFit-method}
+
+\title{Calculate residuals from a model}
+
+\description{Calculates residuals from a model. The approach varies based
+on the model type, but is usually the observed data (\code{y}) minus the 
+fitted values. See \code{\link{fitted}}.}
+
+\usage{
+\S4method{residuals}{unmarkedFit}(object, ...)
+}
+
+\arguments{
+  \item{object}{A \code{unmarkedFit} object}
+  \item{...}{Other arguments, currently unused.}
+}
+
+\value{In most cases, \code{residuals} returns a matrix of residual 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.
+}

man/unmarkedFit-class.Rd

@@ -21,15 +21,6 @@
 \alias{plot,unmarkedFitIDS,missing-method}
 \alias{plot,unmarkedFitOccuCOP,missing-method}
 \alias{profile,unmarkedFit-method}
-\alias{residuals,unmarkedFit-method}
-\alias{residuals,unmarkedFitOccu-method}
-\alias{residuals,unmarkedFitOccuFP-method}
-\alias{residuals,unmarkedFitOccuRN-method}
-\alias{residuals,unmarkedFitOccuMulti-method}
-\alias{residuals,unmarkedFitOccuTTD-method}
-\alias{residuals,unmarkedFitGDR-method}
-\alias{residuals,unmarkedFitIDS-method}
-\alias{residuals,unmarkedFitOccuCOP-method}
 \alias{update,unmarkedFit-method}
 \alias{update,unmarkedFitColExt-method}
 \alias{update,unmarkedFitGMM-method}