New optimisation routine for gum()

Author: config-i1

R/adam-gum.R

@@ -66,7 +66,18 @@ utils::globalVariables(c("xregData","xregModel","xregNumber","initialXregEstimat
 #' @param model A previously estimated GUM model, if provided, the function
 #' will not estimate anything and will use all its parameters.
 #' @param ...  Other non-documented parameters. See \link[smooth]{adam} for
-#' details
+#' details.  However, there are several unique parameters passed to the optimiser
+#' in comparison with \code{adam}:
+#' 1. \code{algorithm0}, which defines what algorithm to use in nloptr for the initial
+#' optimisation. By default, this is "NLOPT_LN_BOBYQA".
+#' 2. \code{algorithm} determines the second optimiser. By default this is
+#' "NLOPT_LN_NELDERMEAD".
+#' 3. maxeval0 and maxeval, that determine the number of iterations for the two
+#' optimisers. By default, \code{maxeval0=1000}, \code{maxeval=40*k}, where
+#' k is the number of estimated parameters.
+#' 4. xtol_rel0 and xtol_rel, which are 1e-8 and 1e-6 respectively.
+#' There are also ftol_rel0, ftol_rel, ftol_abs0 and ftol_abs, which by default
+#' are set to values explained in the \code{nloptr.print.options()} function.
 #'
 #' @return Object of class "adam" is returned with similar elements to the
 #' \link[smooth]{adam} function.
@@ -232,6 +243,50 @@ gum <- function(data, orders=c(1,1), lags=c(1,frequency(data)), type=c("additive
                                        regressors=regressors, yName=yName,
                                        silent, modelDo, ParentEnvironment=environment(), ellipsis, fast=FALSE);
 
+    # Values for the preliminary optimiser
+    if(is.null(ellipsis$algorithm0)){
+        algorithm0 <- "NLOPT_LN_BOBYQA";
+    }
+    else{
+        algorithm0 <- ellipsis$algorithm0;
+    }
+    if(is.null(ellipsis$maxeval0)){
+        maxeval0 <- 1000;
+    }
+    else{
+        maxeval0 <- ellipsis$maxeval0;
+    }
+    if(is.null(ellipsis$maxtime0)){
+        maxtime0 <- -1;
+    }
+    else{
+        maxtime0 <- ellipsis$maxtime0;
+    }
+    if(is.null(ellipsis$xtol_rel0)){
+        xtol_rel0 <- 1e-8;
+    }
+    else{
+        xtol_rel0 <- ellipsis$xtol_rel0;
+    }
+    if(is.null(ellipsis$xtol_abs0)){
+        xtol_abs0 <- 0;
+    }
+    else{
+        xtol_abs0 <- ellipsis$xtol_abs0;
+    }
+    if(is.null(ellipsis$ftol_rel0)){
+        ftol_rel0 <- 0;
+    }
+    else{
+        ftol_rel0 <- ellipsis$ftol_rel0;
+    }
+    if(is.null(ellipsis$ftol_abs0)){
+        ftol_abs0 <- 0;
+    }
+    else{
+        ftol_abs0 <- ellipsis$ftol_abs0;
+    }
+
     # Check whether the multiplicative model is applicable
     if(type=="multiplicative"){
         if(any(yInSample<=0)){
@@ -604,6 +659,19 @@ gum <- function(data, orders=c(1,1), lags=c(1,frequency(data)), type=c("additive
             }
         }
 
+        # First run of BOBYQA to get better values of B
+        res <- nloptr(B, CF, opts=list(algorithm=algorithm0, xtol_rel=xtol_rel0, xtol_abs=xtol_abs0,
+                                       ftol_rel=ftol_rel0, ftol_abs=ftol_abs0,
+                                       maxeval=maxeval0, maxtime=maxtime0, print_level=print_level),
+                      matVt=matVt, matF=matF, vecG=vecG, matWt=matWt);
+
+        if(print_level_hidden>0){
+            print(res);
+        }
+
+        B[] <- res$solution;
+
+        # Tuning the best obtained values using Nelder-Mead
         res <- suppressWarnings(nloptr(B, CF,
                                        opts=list(algorithm=algorithm, xtol_rel=xtol_rel, xtol_abs=xtol_abs,
                                                  ftol_rel=ftol_rel, ftol_abs=ftol_abs,