new tests for multiple runs

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
 #==================================================================== 

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")