From 5068e7d23d46954a9eaddfc590270697ad679a72 Mon Sep 17 00:00:00 2001 From: Clay Morrow Date: Fri, 20 Jan 2023 19:40:54 -0600 Subject: [PATCH] fixed bug with fitGLS_opt() error --- .github/workflows/check-standard.yaml | 2 +- DESCRIPTION | 2 +- NEWS.md | 6 ++++++ R/fitGLS_opt.R | 21 +++++++++++++++------ vignettes/Alaska.Rmd | 17 ++++++++++------- 5 files changed, 33 insertions(+), 15 deletions(-) diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index f764c35..8981c75 100644 --- 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 index 81a16d3..f4416dd 100644 --- 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 index 891ffb0..093aff3 100644 --- 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 index 3f490e0..99fc12f 100644 --- 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 index ae38f61..562df10 100644 --- 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,