Merge pull request #542 from aloctavodia/susi

suggest_size(): Return nterms_max instead of NA when no model satisfies the criterion

Author: aloctavodia

R/methods.R

@@ -1820,16 +1820,13 @@ suggest_size.vsel <- function(
 
   if (nrow(res) == 0) {
     ## no submodel satisfying the criterion found
-    if (object$nterms_max == object$nterms_all) {
-      suggested_size <- object$nterms_max
-    } else {
-      suggested_size <- NA
-      if (warnings) {
-        warning("Could not suggest submodel size. Investigate plot.vsel() to ",
-                "identify if the search was terminated too early. If this is ",
-                "the case, run variable selection with larger value for ",
-                "`nterms_max`.")
-      }
+    suggested_size <- object$nterms_max
+    if (object$nterms_max != object$nterms_all && warnings) {
+      warning("Could not suggest submodel size within the searched range. ",
+              "Investigate plot.vsel() to identify if the search was ",
+              "terminated too early or the criterion is too strict.",
+              "If this is the case, run variable selection with ",
+              "larger value for `nterms_max` or use less strict criterion.")
     }
   } else {
     suggested_size <- min(res)

tests/testthat/test_methods_vsel.R

@@ -580,28 +580,33 @@ test_that("`stat` works", {
       } else {
         suggsize_seed <- NULL
       }
-      # Warnings are suppressed, but a suggested size of `NA` (because of a
-      # search which was terminated too early) is tested below:
+      # Warnings are suppressed, but a suggested size of nterms_max (because of
+      # a search which was terminated too early) is tested below:
       suggsize <- suppressWarnings(
         suggest_size(vss[[tstsetup_vs]], stat = stat_crr, seed = suggsize_seed)
       )
       expect_length(suggsize, 1)
-      if (!is.na(suggsize)) {
-        expect_true(is.vector(suggsize, "numeric"),
-                    info = paste(tstsetup, stat_crr, sep = "__"))
-        expect_true(suggsize >= 0, info = paste(tstsetup, stat_crr, sep = "__"))
-      } else {
-        expect_identical(suggsize, NA,
-                         info = paste(tstsetup, stat_crr, sep = "__"))
-        expect_true(
-          vss[[tstsetup_vs]]$nterms_max < vss[[tstsetup_vs]]$nterms_all,
-          info = paste(tstsetup, stat_crr, sep = "__")
-        )
-      }
+      expect_true(is.vector(suggsize, "numeric"),
+                  info = paste(tstsetup, stat_crr, sep = "__"))
+      expect_true(suggsize >= 0, info = paste(tstsetup, stat_crr, sep = "__"))
+      # If the search was terminated early and no submodel satisfies the
+      # criterion, suggest_size() should return nterms_max:
+      expect_true(suggsize <= vss[[tstsetup_vs]]$nterms_max,
+                  info = paste(tstsetup, stat_crr, sep = "__"))
     }
   }
 })
 
+test_that("returns nterms_max when no criterion is met", {
+  skip_if_not(run_vs)
+  tstsetup <- head(names(vss), 1)
+  suggsize <- suppressWarnings(
+    suggest_size(vss[[tstsetup]], stat = "elpd", pct = -1.0)
+  )
+  expect_identical(suggsize, vss[[tstsetup]]$nterms_max,
+                   info = tstsetup)
+})
+
 # ranking() ---------------------------------------------------------------
 
 context("ranking()")