new plot method for a4aFitSAs

flr · Nov 25, 2024 · 02f2332 · 02f2332
1 parent cd8000e
commit 02f2332
Show file tree

Hide file tree

Showing 16 changed files with 145 additions and 59 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -29,7 +29,7 @@ Suggests:
     formatR,
     XML,
     reshape2,
-    testthat
+    testthat (>= 3.0.0)
 LazyLoad: yes
 LazyData: yes
 VignetteBuilder: knitr
@@ -69,3 +69,4 @@ Collate:
     'a4aFitCatchDiagn-class.R'
 RoxygenNote: 7.3.2
 Encoding: UTF-8
+Config/testthat/edition: 3
diff --git a/NEWS b/NEWS
@@ -3,9 +3,11 @@
  NEW FEATURES
 - plot for residuals by age
 - multisca method to run several sca
+- plot for multiple fits
 
  BUG FIXES:
 - sca use of covariates fixed
+- several man pages issues fixed
 
  FLa4a 1.8.x:
 

diff --git a/R/SCAMCMC-class.R b/R/SCAMCMC-class.R
@@ -92,7 +92,7 @@ setMethod("SCAMCMC", signature(object="missing"),
 #' @rdname SCAMCMC-class
 #' @aliases getADMBCallArgs getADMBCallArgs-methods
 setGeneric("getADMBCallArgs", function(object, ...) standardGeneric("getADMBCallArgs"))
-#' @rdname SCAMCMC-class
+
 setMethod("getADMBCallArgs", signature(object="SCAMCMC"),
   function(object, ...) {
 	slts <- getSlots("SCAMCMC")

diff --git a/R/a4aFitCatchDiagn-class.R b/R/a4aFitCatchDiagn-class.R
@@ -18,8 +18,8 @@ setClass("a4aFitCatchDiagn", contain="FLQuants")
 #' @examples
 #' data(ple4)
 #' data(ple4.index)
-#' obj <- sca(stock=ple4, indices=FLIndices(ple4.index))
-#' flqs <- residuals(obj, ple4, FLIndices(idx=ple4.index))
+#' fit <- sca(ple4, ple4.index)
+#' flqs <- computeCatchDiagnostics(fit, ple4)
 setGeneric("computeCatchDiagnostics", function(object, ...) standardGeneric("computeCatchDiagnostics"))
 
 #' @rdname a4aFit-class
@@ -51,22 +51,21 @@ setMethod("computeCatchDiagnostics", signature(object="a4aFit"), function(object
   }
 )
 
-#' @title Plot of standardized log residuals
-#' @name plot of residuals
+#' @title Plot of aggregated catch standardized log residuals
+#' @name plot of catch residuals
 #' @docType methods
-#' @rdname plot-methods
-##' @aliases plot,a4aFitResiduals,missing-method
-#' @description Method to produce scatterplots of standardized residuals
-#' @param x an \code{a4aFitResiduals} object with the standardized residuals
-#' @param y ignored
-#' @param auxline a string defining the type of line to be added, by default uses 'smooth', a common alternative is to use 'r', a regression, or leave it empty ''
+#' @rdname plot-catch
+#' @aliases plot,a4aFitCatchDiagn,missing-method
+#' @description Method to produce scatterplots of aggregated catch residuals
+#' @param x an \code{a4aFit} object with the model fit
+#' @param y the \code{FLStock} object used to fit the model
 #' @param ... additional argument list that might never be used
 #' @return a \code{plot} with stardardized log residuals
 #' @examples
 #' data(ple4)
 #' data(ple4.index)
-#' obj <- sca(ple4, FLIndices(ple4.index))
-#' flqs <- residuals(obj, ple4, FLIndices(idx=ple4.index))
+#' fit <- sca(ple4, ple4.index)
+#' flqs <- computeCatchDiagnostics(fit, ple4)
 #' plot(flqs)
 
 setMethod("plot", c("a4aFitCatchDiagn", "missing"), function(x, y=missing, ...){
@@ -175,8 +174,3 @@ setMethod("plot", c("a4aFitCatchDiagn", "missing"), function(x, y=missing, ...){
 
 })
 
-
-
-
-
-
diff --git a/R/a4aFitSAs-class.R b/R/a4aFitSAs-class.R
@@ -76,3 +76,45 @@ setMethod("a4aFitSAs", signature(object="missing"),
     }
   }
 )
+
+
+#' @title Plot of metrics of multiple fits
+#' @name plot metrics of multiple fits
+#' @docType methods
+#' @rdname plot-mfits
+#' @aliases plot,a4aFitSAs, missing-method
+#' @description Method to plot fitting statistics of multiple fits, useful to compare fits.
+#' @param x an \code{a4aFitSAs} object with multiple fits
+#' @param y ignored
+#' @param ... additional argument list that might never be used
+#' @return a \code{plot} with fitting statistics
+#' @examples
+#' data(ple4)
+#' data(ple4.index)
+#' qmods <- list(list(~s(age, k=6)))
+#' fmods = list()
+#' for(i in 1:6) {
+#'   fmods[[paste0(i)]] <- as.formula(paste0("~te(age, year, k = c(6,", i+14,"), bs = 'tp') + s(age, k = 6)"))
+#' }
+#' myFits <- FLa4a:::multisca(FLStocks(ple4), list(FLIndices(ple4.index)), fmodel = fmods, qmodel=qmods)
+#' plot(myFits)
+
+setMethod("plot", c("a4aFitSAs", "missing"), function(x, y=missing, ...){
+	args <- list()
+	par(mar=c(5, 4, 4, 4) + 0.1)
+	gcv = lapply(x,function(x) fitSumm(x)['gcv',])
+	bic = lapply(x, function(x) BIC(x))
+	df <- data.frame(unlist(gcv), unlist(bic))
+	df$fit <- as.numeric(gsub("fit", "",names(gcv)))
+	names(df) <- c("GCV","BIC","fit")
+	df <- df[complete.cases(df),]
+	plot(df$fit, df$GCV, type = "b", col = "blue", ylab = "GCV", xlab = "fit", main="Analysis of fit metrics")
+	par(new = TRUE)
+	plot(df$fit, df$BIC, type = "b", col = "red", axes = FALSE, xlab = "", ylab = "")
+	axis(4)
+	mtext("BIC", side=4, line=3)
+	abline(v=df[min(df$GCV)==df$GCV,]$fit, col = "blue",lty = 2)
+	abline(v=df[min(df$BIC)==df$BIC,]$fit, col = "red",lty = 2)
+	legend("topleft", legend = c("GCV", "BIC"), col = c("blue", "red"), lty = 1, bg="white")
+})
+
diff --git a/R/a4aFitresiduals-class.R b/R/a4aFitresiduals-class.R
@@ -142,8 +142,8 @@ setMethod("stdlogres", c("FLQuant","FLQuant"), function(obs, fit, ...){
 #' @title Plot of standardized log residuals
 #' @name plot of residuals
 #' @docType methods
-#' @rdname plot-methods
-##' @aliases plot,a4aFitResiduals,missing-method
+#' @rdname plot-res
+#' @aliases plot,a4aFitResiduals,missing-method
 #' @description Method to produce scatterplots of standardized residuals
 #' @param x an \code{a4aFitResiduals} object with the standardized residuals
 #' @param y ignored
@@ -189,7 +189,7 @@ setMethod("plot", c("a4aFitResiduals", "missing"), function(x, y=missing, auxlin
 #' @name qqplot of residuals
 #' @docType methods
 #' @rdname qqmath-methods
-##' @aliases qqmath,a4aFitResiduals,missing-method
+#' @aliases qqmath,a4aFitResiduals,missing-method
 #' @description Method to produce qqplots of standardized residuals
 #' @param x an \code{a4aFitResiduals} object with the standardized residuals
 #' @param data ignored
@@ -228,7 +228,7 @@ setMethod("qqmath", c("a4aFitResiduals", "missing"), function(x, data=missing, .
 #' @name bubble plot of residuals
 #' @docType methods
 #' @rdname bubbles-methods
-##' @aliases bubbles,a4aFitResiduals,missing-method
+#' @aliases bubbles,a4aFitResiduals,missing-method
 #' @description Method to produce bubble plots of standardized residuals
 #' @param x an \code{a4aFitResiduals} object with the standardized residuals
 #' @param data ignored

diff --git a/R/addition-methods.R b/R/addition-methods.R
@@ -35,18 +35,6 @@ setMethod("+", c("FLStock", "a4aFit"), function(e1, e2)
   e1
 })
 
-##' @rdname addition-methods
-##' @aliases +,FLStock,a4aFitSA-method
-#setMethod("+", c("FLStock", "a4aFitSA"), function(e1, e2)
-#{
-#  nit1 <- dims(e1) $ iter
-#  nit2 <- dims(qmodel(pars(e2))[[1]]@params)$iter
-#  v <- c(nit1, nit2)
-#  if(min(v)==max(v)) e1 <- e1 + as(e2, "a4aFit") else e1 <- e1 * e2
-#  e1
-#})
-
-#' @rdname addition-methods
 setMethod("+", c("FLIndices", "a4aFit"), function(e1, e2) 
 {
 

diff --git a/R/utilities.R b/R/utilities.R
@@ -188,7 +188,7 @@ setMethod("plot", c("a4aFit", "FLStock"), function(x, y, ...){
 	do.call("xyplot", args)
 })
 
-##' @title testing
+#' @title Plot for fitted indices-at-age
 #' @name plot for fitted indices-at-age
 #' @docType methods
 #' @rdname ploti
@@ -244,7 +244,7 @@ setMethod("plot", c("a4aFit", "FLIndices"), function(x, y, ...){
 })
 
 
-##' @title wireframe plot for FLQuant
+#' @title wireframe plot for FLQuant
 #' @name wireframe plot for FLQuant
 #' @docType methods
 #' @rdname wireframe

diff --git a/man/SCAMCMC-class.Rd b/man/SCAMCMC-class.Rd
diff --git a/man/a4aFitCatchDiagn-class.Rd b/man/a4aFitCatchDiagn-class.Rd
diff --git a/man/addition-methods.Rd b/man/addition-methods.Rd
diff --git a/man/plot-catch.Rd b/man/plot-catch.Rd
diff --git a/man/plot-mfits.Rd b/man/plot-mfits.Rd
diff --git a/man/plot-methods.Rd → man/plot-res.Rd b/man/plot-methods.Rd → man/plot-res.Rd
diff --git a/man/ploti.Rd b/man/ploti.Rd
diff --git a/tests/testthat.R b/tests/testthat.R
@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(FLa4a)
+
+test_check("FLa4a")