Disallow no-intercept models, improvements for efficiency (#124)

* Avoid calling pseudo_data() if not necessary.

* Remove an unnecessary assignment.

* Remove unused code.

* Throw an error for a reference model without an intercept (see PR #100 and in particular <#100 (comment)>).

* Insert GitHub PR number.

NEWS.md

@@ -8,6 +8,7 @@
 
 * The behavior of arguments `ndraws`, `nclusters`, `ndraws_pred`, and `nclusters_pred` in `varsel()`, `cv_varsel()`, and `project()` has been changed: Now, `ndraws` and `ndraws_pred` have non-`NULL` defaults and for `ndraws <= 20` or `ndraws_pred <= 20`, the value of `ndraws` or `ndraws_pred` is passed to `nclusters` or `nclusters_pred`, respectively (so that clustering is used). (GitHub: commits babe031db7732e0d81dd2591938551d02dcf374d, 4ef95d3b4ab85eaaa5177c4d40f33b2943bff37c, and ce7d1e001fd76830c4379cbbe0dfe730cba8d9e5)
 * For `proj_linpred()` and `proj_predict()`, arguments `nterms`, `ndraws`, and `seed` have been removed to allow the user to pass them to `project()`. New arguments `filter_nterms`, `size_sub`, and `seed_sub` have been introduced (see the documentation for details). (GitHub: #92)
+* Reference models lacking an intercept are not supported anymore (actually, the previous implementation for such models was incomplete). Support might be re-introduced in the future (when fixed), but for now it is withdrawn as it requires some larger changes. (GitHub: #124, but see also #96 and #100)
 
 ## Minor changes
 

R/project.R

@@ -180,6 +180,9 @@ project <- function(object, nterms = NULL, solution_terms = NULL,
   }
 
   intercept <- refmodel$intercept
+  if (!intercept) {
+    stop("Reference models without an intercept are currently not supported.")
+  }
   family <- refmodel$family
 
   ## get the clustering or subsample

R/projfun.R

@@ -112,13 +112,12 @@ project_submodel <- function(solution_terms, p_ref, refmodel, family, intercept,
 
 .init_submodel <- function(sub_fit, p_ref, refmodel, family, solution_terms,
                            wobs, wsample) {
-  pobs <- pseudo_data(
-    f = 0, y = p_ref$mu, family = family, weights = wobs,
-    offset = refmodel$offset
-  )
-
   ## split b to alpha and beta, add it to submodel and return the result
   if (family$family == "gaussian") {
+    pobs <- pseudo_data(
+      f = 0, y = p_ref$mu, family = family, weights = wobs,
+      offset = refmodel$offset
+    )
     ref <- list(mu = pobs$z, var = p_ref$var, wobs = pobs$wobs)
   } else {
     ref <- p_ref

R/summary_funs.R

@@ -1,7 +1,7 @@
 .get_sub_summaries <- function(submodels, test_points, refmodel, family,
                                search_terms = NULL) {
   has_group_features <- !is.null(search_terms)
-  res <- lapply(submodels, function(model) {
+  lapply(submodels, function(model) {
     solution_terms <- model$solution_terms
     if (length(solution_terms) == 0) {
       solution_terms <- c("1")

R/varsel.R

@@ -201,16 +201,6 @@ varsel.refmodel <- function(object, d_test = NULL, method = NULL,
     )
   }
 
-  ## warn the user if the projection performance does not match the reference
-  ## model's.
-  ref_elpd <- get_stat(ref$mu, ref$lppd, d_test, family, "elpd",
-                       weights = ref$w
-  )
-  summ <- sub[[length(sub)]]
-  proj_elpd <- get_stat(summ$mu, summ$lppd, d_test, family, "elpd",
-                        weights = summ$w
-  )
-
   ## store the relevant fields into the object to be returned
   vs <- nlist(
     refmodel,
@@ -341,6 +331,9 @@ parse_args_varsel <- function(refmodel, method, cv_search, intercept,
   if (is.null(intercept)) {
     intercept <- refmodel$intercept
   }
+  if (!intercept) {
+    stop("Reference models without an intercept are currently not supported.")
+  }
   if (is.null(nterms_max)) {
     nterms_max <- min(max_nv_possible, 20)
   } else {