From 176235969590c6a8f8d472127ee4389d161f84fd Mon Sep 17 00:00:00 2001 From: Ernesto Jardim Date: Mon, 25 Nov 2024 17:52:07 +0100 Subject: [PATCH] new tests for multiple runs --- R/addition-methods.R | 34 ++++++++++++ man/a4aFit-class.Rd | 17 +++++- man/a4aFitMCMC-class.Rd | 16 +++++- man/multisca.Rd | 2 +- man/plot-mfits.Rd | 10 ++-- man/plot-mmcfits.Rd | 35 ++++++++++++ tests/multisca.R | 119 +++++++++++++++++++++++++++++++++++++--- 7 files changed, 216 insertions(+), 17 deletions(-) create mode 100644 man/plot-mmcfits.Rd diff --git a/R/addition-methods.R b/R/addition-methods.R index d96f242..68a32c2 100644 --- a/R/addition-methods.R +++ b/R/addition-methods.R @@ -52,6 +52,40 @@ setMethod("+", c("FLIndices", "a4aFit"), function(e1, e2) e1 }) + +#' + methods +#' @name addition +#' @description Update \code{FLStocks} objects with multiple stock assessment results in a \code{a4aFits}. +#' @param e1 the original \code{FLStocks} object +#' @param e2 a \code{a4aFits} object from where the new \code{FLStock} slots will be extracted. +#' @details If both objects have the same number of iterations, the \code{FLStocks} slots will be replaced by the \code{a4aFits} slots, in the case of 1 iter, or \code{a4aFitSA} slots, in the case of n iters. If one of the objects has 1 iter and the other n, the method will simulate using the fit results from the \code{a4aFitSA} object to update the slots of the \code{FLStock} object. +#' @rdname addition-methods +#' @aliases +,FLStocks,a4aFits-method +setMethod("+", c("FLStocks", "a4aFits"), function(e1, e2) +{ + + # checks 1 or n + ns <- length(e1) + nf <- length(e2) + if(ns!=1 & nf!= 1 & ns!=nf) stop("objects must be of equal size or of size 1") + + # set same sizes + n <- max(ns, nf) + if(n>1 & ns==1){ + e1[1:n] <- e1[1] + names(e1) <- rep(names(e1[1]), n) + } else if(n>1 & nf==1){ + e2[1:n] <- e2[1] + names(e2) <- rep(names(e2[1]), n) + } + + # call + + for(i in 1:n) e1[[i]] <- e1[[i]] + e2[[i]] + + # out + e1 +}) + #==================================================================== # "*" methods #==================================================================== diff --git a/man/a4aFit-class.Rd b/man/a4aFit-class.Rd index c67c93b..f2565d7 100644 --- a/man/a4aFit-class.Rd +++ b/man/a4aFit-class.Rd @@ -1,5 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/a4aFit-class.R, R/a4aFitCatchDiagn-class.R +% Please edit documentation in R/a4aFit-class.R, R/a4aFits-class.R, +% R/a4aFitCatchDiagn-class.R \docType{class} \name{a4aFit-class} \alias{a4aFit-class} @@ -18,6 +19,12 @@ \alias{show,a4aFit-method} \alias{logLik,a4aFit-method} \alias{iter,a4aFit-method} +\alias{a4aFits-class} +\alias{a4aFits} +\alias{a4aFits-methods} +\alias{a4aFits,list-method} +\alias{a4aFits,a4aFit-method} +\alias{a4aFits,missing-method} \alias{computeCatchDiagnostics,a4aFit-method} \title{S4 class \code{a4aFit}} \usage{ @@ -47,6 +54,14 @@ fitSumm(object, ...) \S4method{iter}{a4aFit}(obj, it) +a4aFits(object, ...) + +\S4method{a4aFits}{list}(object, ...) + +\S4method{a4aFits}{a4aFit}(object, ...) + +\S4method{a4aFits}{missing}(object, ...) + \S4method{computeCatchDiagnostics}{a4aFit}(object, stock, ...) } \arguments{ diff --git a/man/a4aFitMCMC-class.Rd b/man/a4aFitMCMC-class.Rd index 49f59ee..381a675 100644 --- a/man/a4aFitMCMC-class.Rd +++ b/man/a4aFitMCMC-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/a4aFitMCMC-class.R +% Please edit documentation in R/a4aFitMCMC-class.R, R/a4aFitMCMCs-class.R \docType{class} \name{a4aFitMCMC-class} \alias{a4aFitMCMC-class} @@ -13,6 +13,12 @@ \alias{burnin} \alias{burnin-methods} \alias{burnin,a4aFitMCMC-method} +\alias{a4aFitMCMCs-class} +\alias{a4aFitMCMCs} +\alias{a4aFitMCMCs-methods} +\alias{a4aFitMCMCs,list-method} +\alias{a4aFitMCMCs,a4aFitMCMC-method} +\alias{a4aFitMCMCs,missing-method} \title{S4 class \code{a4aFitMCMC}} \usage{ a4aFitMCMC(...) @@ -30,6 +36,14 @@ as.mcmc(x, ...) burnin(object, ...) \S4method{burnin}{a4aFitMCMC}(object, burnin) + +a4aFitMCMCs(object, ...) + +\S4method{a4aFitMCMCs}{list}(object, ...) + +\S4method{a4aFitMCMCs}{a4aFitMCMC}(object, ...) + +\S4method{a4aFitMCMCs}{missing}(object, ...) } \arguments{ \item{...}{additional argument list that might never be used} diff --git a/man/multisca.Rd b/man/multisca.Rd index ad3e02a..5cd92cf 100644 --- a/man/multisca.Rd +++ b/man/multisca.Rd @@ -32,7 +32,7 @@ multisca( \item{...}{all other arguments to be passed to \code{sca}} -\item{stock}{an \code{FLStocks} object, each component with a \ciode{FLStock} object containing catch and stock information} +\item{stock}{an \code{FLStocks} object, each component with a \code{FLStock} object containing catch and stock information} } \value{ an \code{a4aFits} or \code{a4aFitSAs} or \code{a4aFitMCMCs} depending on the argument \code{fit} diff --git a/man/plot-mfits.Rd b/man/plot-mfits.Rd index ac5c52a..7e43ad3 100644 --- a/man/plot-mfits.Rd +++ b/man/plot-mfits.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/a4aFitSAs-class.R +% Please edit documentation in R/a4aFits-class.R \docType{methods} \name{plot metrics of multiple fits} \alias{plot metrics of multiple fits} -\alias{plot,a4aFitSAs,} +\alias{plot,a4aFits,} \alias{missing-method} \title{Plot of metrics of multiple fits} \usage{ -\S4method{plot}{a4aFitSAs,missing}(x, y = missing, ...) +\S4method{plot}{a4aFits,missing}(x, y = missing, ...) } \arguments{ -\item{x}{an \code{a4aFitSAs} object with multiple fits} +\item{x}{an \code{a4aFits} object with multiple fits} \item{y}{ignored} @@ -30,6 +30,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) +myFits <- FLa4a:::multisca(FLStocks(ple4), list(FLIndices(ple4.index)), fmodel = fmods, qmodel=qmods, fit="MP") plot(myFits) } diff --git a/man/plot-mmcfits.Rd b/man/plot-mmcfits.Rd new file mode 100644 index 0000000..c0752ee --- /dev/null +++ b/man/plot-mmcfits.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/a4aFitMCMCs-class.R +\docType{methods} +\name{plot metrics of multiple fits} +\alias{plot metrics of multiple fits} +\alias{plot,a4aFitMCMCs,} +\alias{missing-method} +\title{Plot of metrics of multiple fits} +\usage{ +\S4method{plot}{a4aFitMCMCs,missing}(x, y = missing, ...) +} +\arguments{ +\item{x}{an \code{a4aFitMCMCs} object with multiple fits} + +\item{y}{ignored} + +\item{...}{additional argument list that might never be used} +} +\value{ +a \code{plot} with fitting statistics +} +\description{ +Method to plot fitting statistics of multiple fits, useful to compare fits. +} +\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, fit="MCMC", mcmc=SCAMCMC()) +plot(myFits) +} diff --git a/tests/multisca.R b/tests/multisca.R index f2d4509..3c14c17 100644 --- a/tests/multisca.R +++ b/tests/multisca.R @@ -4,22 +4,25 @@ library(FLa4a) data(ple4) data(ple4.index) +j <- 6 #==================================================================== -# run fits sca MP +# run fits sca #==================================================================== qmods <- list(list(~s(age, k=6))) fmods = list() -for(i in 1:6) { +for(i in 1:j) { fmods[[paste0(i)]] <- as.formula(paste0("~te(age, year, k = c(6,", i+14,"), bs = 'tp') + s(age, k = 6)")) } +stks <- FLStocks(ple4) +idxss <- list(FLIndices(ple4.index)) #-------------------------------------------------------------------- # MP #-------------------------------------------------------------------- -fits <- FLa4a:::multisca(FLStocks(ple4), list(FLIndices(ple4.index)), fmodel = fmods, qmodel=qmods, fit="MP") +fits <- FLa4a:::multisca(stks, idxss, fmodel = fmods, qmodel=qmods, fit="MP") is(fits, "a4aFits") is(fits[[1]], "a4aFit") @@ -29,18 +32,116 @@ is(fits[[1]], "a4aFit") # SA #-------------------------------------------------------------------- -fits <- FLa4a:::multisca(FLStocks(ple4), list(FLIndices(ple4.index)), fmodel = fmods, qmodel=qmods, fit="assessment") +fitsa <- FLa4a:::multisca(stks, idxss, fmodel = fmods, qmodel=qmods, fit="assessment") -is(fits, "a4aFitSAs") -is(fits[[1]], "a4aFitSA") +is(fitsa, "a4aFitSAs") +is(fitsa[[1]], "a4aFitSA") #-------------------------------------------------------------------- # MCMC #-------------------------------------------------------------------- -fits <- FLa4a:::multisca(FLStocks(ple4), list(FLIndices(ple4.index)), fmodel = fmods, qmodel=qmods, fit="MCMC", mcmc=SCAMCMC()) +fitsm <- FLa4a:::multisca(stks, idxss, fmodel = fmods, qmodel=qmods, fit="MCMC", mcmc=SCAMCMC()) + +is(fitsm, "a4aFitMCMCs") +is(fitsm[[1]], "a4aFitMCMC") + +#==================================================================== +# + +#==================================================================== + +#-------------------------------------------------------------------- +# MP +#-------------------------------------------------------------------- + +stks.mp <- stks + fits +length(stks.mp) == length(fits) +identical(stks.mp[[2]], stks[[1]] + fits[[2]]) + +#-------------------------------------------------------------------- +# SA +#-------------------------------------------------------------------- + +stks.sa <- stks + fitsa +length(stks.sa) == length(fitsa) +identical(stks.sa[[2]], stks[[1]] + fitsa[[2]]) + +#-------------------------------------------------------------------- +# MCMC +#-------------------------------------------------------------------- + +stks.mc <- stks + fitsm +length(stks.mc) == length(fitsm) +identical(stks.mc[[2]], stks[[1]] + fitsm[[2]]) + + + + + +#==================================================================== +# run fits sca multiple stocks and indices +#==================================================================== + +stks[1:j] <- stks[1] +idxss[1:j] <- idxss[1] + +#-------------------------------------------------------------------- +# MP +#-------------------------------------------------------------------- + +fits <- FLa4a:::multisca(stks, idxss, fmodel = fmods, qmodel=qmods, fit="MP") + +is(fits, "a4aFits") +is(fits[[1]], "a4aFit") + + +#-------------------------------------------------------------------- +# SA +#-------------------------------------------------------------------- + +fitsa <- FLa4a:::multisca(stks, idxss, fmodel = fmods, qmodel=qmods, fit="assessment") + +is(fitsa, "a4aFitSAs") +is(fitsa[[1]], "a4aFitSA") + +#-------------------------------------------------------------------- +# MCMC +#-------------------------------------------------------------------- + +fitsm <- FLa4a:::multisca(stks, idxss, fmodel = fmods, qmodel=qmods, fit="MCMC", mcmc=SCAMCMC()) + +is(fitsm, "a4aFitMCMCs") +is(fitsm[[1]], "a4aFitMCMC") + +#==================================================================== +# + +#==================================================================== + +#-------------------------------------------------------------------- +# MP +#-------------------------------------------------------------------- + +stks.mp <- stks + fits +length(stks.mp) == length(fits) +identical(stks.mp[[2]], stks[[1]] + fits[[2]]) + +#-------------------------------------------------------------------- +# SA +#-------------------------------------------------------------------- + +stks.sa <- stks + fitsa +length(stks.sa) == length(fitsa) +identical(stks.sa[[2]], stks[[1]] + fitsa[[2]]) + +#-------------------------------------------------------------------- +# MCMC +#-------------------------------------------------------------------- + +stks.mc <- stks + fitsm +length(stks.mc) == length(fitsm) +identical(stks.mc[[2]], stks[[1]] + fitsm[[2]]) + + -is(fits, "a4aFitMCMCs") -is(fits[[1]], "a4aFitMCMC")