add broader tests of plotting routines

nicholasjclark · Apr 16, 2024 · 54b2a26 · 54b2a26
1 parent 1325f9a
commit 54b2a26
Show file tree

Hide file tree

Showing 5 changed files with 58 additions and 13 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -18,12 +18,14 @@ jobs:
       fail-fast: false
       matrix:
         config:
+          # check latest release and up to date rtools
+          - {os: windows-latest, r: 'release'}
           # use 4.1 to check with rtools40's older compiler
           - {os: windows-latest, r: '4.1'}
           - {os: windows-latest, r: 'oldrel', rtools: '42'}
-          - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release', rtools: ''}
-          - {os: ubuntu-latest, r: 'release', rtools: ''}
-          - {os: ubuntu-latest, r: 'oldrel-1', rtools: ''}
+          - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest, r: 'release'}
+          - {os: ubuntu-latest, r: 'oldrel-1'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

diff --git a/R/plot_mvgam_series.R b/R/plot_mvgam_series.R
@@ -72,7 +72,25 @@ plot_mvgam_series = function(object,
   # Check variables in data / data_train
   if(!missing("data")){
     data_train <- data
+  }
+
+# Choose models over data if both supplied
+  if(!missing(object)){
+    if(!missing(data_train)){
+      warning('both "object" and "data" were supplied; only using "object"')
+    }
+    data_train <- object$obs_data
 
+    resp_terms <- as.character(terms(formula(object$call))[[2]])
+    if(length(resp_terms) == 1){
+      out_name <- as.character(terms(object$call)[[2]])
+    } else {
+      if(any(grepl('cbind', resp_terms))){
+        resp_terms <- resp_terms[-grepl('cbind', resp_terms)]
+        out_name <- resp_terms[1]
+      }
+    }
+    y <- out_name
   }
 
   if(!missing(data_train)){
@@ -100,7 +118,7 @@ plot_mvgam_series = function(object,
     }
   }
 
-  if(!y %in% names(data_train)){
+  if(!as.character(y) %in% names(data_train)){
     stop(paste0('variable "', y, '" not found in data'),
          call. = FALSE)
   } else {
@@ -150,15 +168,6 @@ plot_mvgam_series = function(object,
     data_test$series <- droplevels(data_test$series)
   }
 
-# Choose models over data if both supplied
-  if(!missing(object)){
-    if(!missing(data_train)){
-      warning('both "object" and "data" were supplied; only using "object"')
-    }
-    data_train <- object$obs_data
-    y <- terms(formula(object$call))[[2]]
-  }
-
   if(series == 'all'){
     n_plots <- length(levels(data_train$series))
     pages <- 1

diff --git a/src/mvgam.dll b/src/mvgam.dll
diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf
diff --git a/tests/testthat/test-example_processing.R b/tests/testthat/test-example_processing.R
@@ -120,6 +120,40 @@ test_that("marginaleffects works correctly", {
                                  type = 'link'))
 })
 
+test_that("plot_mvgam... functions work properly", {
+  expect_no_error(plot_mvgam_fc(mvgam:::mvgam_example1))
+  expect_no_error(plot_mvgam_fc(mvgam:::mvgam_example2))
+  expect_no_error(plot(mvgam:::mvgam_example4, type = 'forecast'))
+  expect_no_error(plot(mvgam:::mvgam_example3, type = 'smooths'))
+  expect_no_error(plot(mvgam:::mvgam_example3, type = 'smooths',
+                       realisations = TRUE))
+  expect_no_error(plot_mvgam_smooth(mvgam:::mvgam_example1,
+                                    smooth = 1,
+                                    derivatives = TRUE))
+  expect_no_error(plot_mvgam_smooth(mvgam:::mvgam_example1,
+                                    smooth = 1,
+                                    residuals = TRUE))
+  expect_no_error(plot_mvgam_smooth(mvgam:::mvgam_example1,
+                                    smooth = 1,
+                                    realisations = TRUE))
+  expect_error(plot_mvgam_smooth(mvgam:::mvgam_example4,
+                                    smooth = 1))
+  expect_no_error(plot_mvgam_smooth(mvgam:::mvgam_example4,
+                                         smooth = 1,
+                                         trend_effects = TRUE))
+  expect_no_error(plot_mvgam_smooth(mvgam:::mvgam_example4,
+                                    smooth = 1,
+                                    derivatives = TRUE,
+                                    trend_effects = TRUE))
+  expect_message(plot(mvgam:::mvgam_example3, type = 'pterms'),
+                 'No parametric terms in model formula')
+  expect_message(plot(mvgam:::mvgam_example1, type = 're'))
+  expect_error(plot(mvgam:::mvgam_example1, type = 'factors'))
+  expect_no_error(plot_mvgam_trend(mvgam:::mvgam_example1))
+  expect_no_error(plot_mvgam_trend(mvgam:::mvgam_example4))
+  expect_no_error(plot_mvgam_series(object = mvgam:::mvgam_example4))
+})
+
 # Skip forecast and loo testing as they are a bit time-consuming
 test_that("forecast() works correctly", {
   skip_on_cran()