Merge pull request #229 from config-i1/Additional-criteria

dsrboot() in coefbootstrap()

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: smooth
 Type: Package
 Title: Forecasting Using State Space Models
-Version: 4.1.0.41003
-Date: 2024-07-30
+Version: 4.1.0.41004
+Date: 2024-08-27
 Authors@R: person("Ivan", "Svetunkov", email = "[email protected]", role = c("aut", "cre"),
                   comment="Lecturer at Centre for Marketing Analytics and Forecasting, Lancaster University, UK")
 URL: https://github.com/config-i1/smooth
@@ -19,7 +19,7 @@ Description: Functions implementing Single Source of Error state space models fo
 License: LGPL-2.1
 Depends:
     R (>= 3.0.2),
-    greybox (>= 2.0.1)
+    greybox (>= 2.0.2)
 Imports:
     Rcpp (>= 0.12.3),
     stats,

NAMESPACE

@@ -206,6 +206,7 @@ importFrom(greybox,detectdst)
 importFrom(greybox,dgnorm)
 importFrom(greybox,dlaplace)
 importFrom(greybox,ds)
+importFrom(greybox,dsrboot)
 importFrom(greybox,errorType)
 importFrom(greybox,extractScale)
 importFrom(greybox,extractSigma)
@@ -232,7 +233,6 @@ importFrom(greybox,rlaplace)
 importFrom(greybox,rs)
 importFrom(greybox,sm)
 importFrom(greybox,stepwise)
-importFrom(greybox,timeboot)
 importFrom(greybox,xregExpander)
 importFrom(nloptr,nloptr)
 importFrom(pracma,hessian)

NEWS

@@ -1,9 +1,10 @@
-smooth v4.1.0 (Release data: 2024-07-30)
+smooth v4.1.0 (Release data: 2024-08-27)
 =======
 
 Changes:
 * New initialisation mechanism for ARIMA in case of initial="optimal". Now we do backcasting in the first step and then grab what we got and optimise.
 * nIterations for the backcasting is now set outside the C++ code, can be provided as a parameter in the ellipsis of adam().
+* coefbootstrap() now relies on the dsrboot() function from the greybox, implementing the "Data Shape Replication" bootstrap algorithm.
 
 Bugfixes:
 * Fix in reapply() for ARIMA.

R/adam.R

@@ -6836,16 +6836,22 @@ xtable.summary.adam <- function(x, caption = NULL, label = NULL, align = NULL, d
 }
 
 
-#' @importFrom greybox coefbootstrap timeboot
+#' @importFrom greybox coefbootstrap dsrboot
 #' @export
-coefbootstrap.adam <- function(object, nsim=100,
-                               size=floor(0.5*nobs(object)), replace=FALSE, prob=NULL,
-                               parallel=FALSE, ...){
+coefbootstrap.adam <- function(object, nsim=1000, size=floor(0.75*nobs(object)),
+                               replace=FALSE, prob=NULL, parallel=FALSE,
+                               method=c("dsr","cr"), ...){
 
     startTime <- Sys.time();
 
     cl <- match.call();
 
+    method <- match.arg(method);
+    if(method=="cr"){
+        warning("Only dsr is supported as the bootstrap method for adam().",
+                call.=FALSE);
+    }
+
     if(is.numeric(parallel)){
         nCores <- parallel;
         parallel <- TRUE;
@@ -6999,18 +7005,25 @@ coefbootstrap.adam <- function(object, nsim=100,
     # }
 
     responseName <- all.vars(formula(object))[1];
-    newY <- timeboot(y=actuals(object), nsim=nsim, ...)$boot;
+    # Create a new dataset
+    newData <- replicate(nsim, newCall$data, simplify=FALSE);
+    newCall$formula <- as.formula(paste0(responseName,"~."));
+    # Bootstrap the data
+    dataBoot <- suppressWarnings(apply(newCall$data, 2, dsrboot,
+                                       nsim=nsim, intermittent=FALSE));
+    nLevels <- length(dataBoot);
+    # Fill in the list of data
+    for(i in 1:nsim){
+        for(j in 1:nLevels){
+            newData[[i]][,j] <- dataBoot[[j]]$boot[,i];
+        }
+    }
 
     if(!parallel){
         for(i in 1:nsim){
             # subsetValues <- sampler(indices,size,replace,prob,regressionPure,changeOrigin);
             # newCall$data <- object$data[subsetValues,,drop=FALSE];
-            if(!is.null(dim(newCall$data))){
-                newCall$data[,responseName] <- newY[,i];
-            }
-            else{
-                newCall$data[] <- newY[,i];
-            }
+            newCall$data[] <- newData[[i]];
             testModel <- suppressWarnings(eval(newCall));
             coefBootstrap[i,variablesNames %in% names(coef(testModel))] <- coef(testModel);
         }
@@ -7020,12 +7033,7 @@ coefbootstrap.adam <- function(object, nsim=100,
         coefBootstrapParallel <- foreach::`%dopar%`(foreach::foreach(i=1:nsim),{
             # subsetValues <- sampler(indices,size,replace,prob,regressionPure,changeOrigin);
             # newCall$data <- object$data[subsetValues,,drop=FALSE];
-            if(!is.null(dim(newCall$data))){
-                newCall$data[,responseName] <- newY[,i];
-            }
-            else{
-                newCall$data[] <- newY[,i];
-            }
+            newCall$data[] <- newData[[i]];
             testModel <- eval(newCall);
             return(coef(testModel));
         })
@@ -7045,8 +7053,8 @@ coefbootstrap.adam <- function(object, nsim=100,
     coefvcov <- coefBootstrap - matrix(coefficientsOriginal, nsim, nVariables, byrow=TRUE);
 
     return(structure(list(vcov=(t(coefvcov) %*% coefvcov)/nsim,
-                          coefficients=coefBootstrap, nsim=nsim,
-                          size=NA, replace=NA, prob=NA,
+                          coefficients=coefBootstrap, method=method,
+                          nsim=nsim, size=NA, replace=NA, prob=NA,
                           parallel=parallel, model=object$call[[1]], timeElapsed=Sys.time()-startTime),
                      class="bootstrap"));
 }