fixed bug with fitGLS_opt() error

morrowcj · Jan 21, 2023 · 5068e7d · 5068e7d
1 parent 0e6475e
commit 5068e7d
Show file tree

Hide file tree

Showing 5 changed files with 33 additions and 15 deletions.
diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml
@@ -23,7 +23,7 @@ jobs:
       matrix:
         config:
           - {os: windows-latest, r: 'release'}
-          - {os: macOS-latest, r: 'release'}
+          - {os: macOS-11, r: 'release'}
           - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
 
     env:

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: remotePARTS
 Title: Spatiotemporal Autoregression Analyses for Large Data Sets
-Version: 1.0.2
+Version: 1.0.3
 Authors@R: 
     c(person(given = "Clay",
            family = "Morrow",

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,9 @@
+# v1.0.3
+* fixed bug where `fitGLS_opt()` would fail if one of the iterations in the 
+optimization loop raises an error.
+* added explicit call to "BFGS" method while using `fitGLS_opt()` in the 
+vignette and lowered tolerance to improve speed.
+
 # v1.0.2
 
 * fixed a bug where `fitCor()` was calculating a full distance matrix instead

diff --git a/R/fitGLS_opt.R b/R/fitGLS_opt.R
@@ -180,9 +180,17 @@ fitGLS_opt <- function(formula, data = NULL, coords, distm_FUN = "distm_scaled",
   # append arguments given by ... to the argument list
   arg.list = append(arg.list, list(...)) # add additional arguments to arg list
 
+  if(debug){
+    cat("optimizing...\n")
+  }
+
   # call optim, and pass arguments
   opt.out <- do.call(optim, args = arg.list)
 
+  if(debug){
+    cat("solution found\n")
+  }
+
   # back-transform the parameter values to their original scale
   if(is.trans){
     if(debug){cat("backtransforming parameters.\n")}
@@ -207,9 +215,6 @@ fitGLS_opt <- function(formula, data = NULL, coords, distm_FUN = "distm_scaled",
     }
   }
 
-  if(debug){
-    cat("\noutput:\n")
-  }
   if(opt.only){
     return(opt.out)
   } else {
@@ -299,9 +304,13 @@ fitGLS_opt_FUN <- function(op, fp, formula, data = NULL, coords, covar_FUN = "co
   args = append(list(d = V), as.list(sp.pars))
   V = do.call(cov.f, args) # replace with covariance
   ## Calculate log-likelihood
-  logLik = suppressWarnings(fitGLS(formula = formula, data = data, V = V, formula0 = NULL,
-                  save.xx = FALSE, save.invchol = FALSE, logLik.only = TRUE, no.F = TRUE,
-                  nugget = nug))
+  logLik = suppressWarnings(
+    tryCatch(expr = {fitGLS(formula = formula, data = data, V = V,
+                            formula0 = NULL, save.xx = FALSE,
+                            save.invchol = FALSE, logLik.only = TRUE,
+                            no.F = TRUE, nugget = nug)},
+             error = function(e){return(NA)})
+  )
   return(-logLik)
 }
 
diff --git a/vignettes/Alaska.Rmd b/vignettes/Alaska.Rmd
@@ -457,16 +457,19 @@ This task is computationally slower than optimizing `nugget` alone with
 
 ```{r optimized_GLS, eval = FALSE}
 fitopt <- fitGLS_opt(formula = AR_coef ~ 0 + land, data = ndvi_AK3000, 
-                       coords = ndvi_AK3000[, c("lng", "lat")], 
-                       covar_FUN = "covar_exp", 
-                       start = c(range = .1, nugget = .2))
+                     coords = ndvi_AK3000[, c("lng", "lat")], 
+                     covar_FUN = "covar_exp", 
+                     start = c(range = .1, nugget = .2),
+                     method = "BFGS", # use BFGS algorightm (see ?stats::optim())
+                     control = list(reltol = 1e-5)  # lower the convergence tolerance (see ?stats::optim()) 
+                     )
 fitopt$opt$par
-##      range     nugget 
-## 0.03660171 0.26859993 
+#      range     nugget 
+# 0.02497874 0.17914929 
 fitopt$GLS$logLik
-## [1] 13276.15
+# [1] 12824.77
 fitopt$GLS$MSE
-## [1] 1.720775e-05
+# [1] 2.475972e-05
 ```
 
 Note that, because `fitGLS_opt()` does not require time series residuals,