Introduced `vaeac.save_model" parameter to help testing

R/RcppExports.R

@@ -14,7 +14,7 @@
 #' @return Matrix of dimension \code{ncol(X)*ncol(X)}
 #' @author Martin Jullum
 hat_matrix_cpp <- function(X, mcov, S_scale_dist, h) {
-  .Call(`_shapr_hat_matrix_cpp`, X, mcov, S_scale_dist, h)
+    .Call(`_shapr_hat_matrix_cpp`, X, mcov, S_scale_dist, h)
 }
 
 #' sigma_hat_sq-function
@@ -29,7 +29,7 @@ hat_matrix_cpp <- function(X, mcov, S_scale_dist, h) {
 #'
 #' @author Martin Jullum
 rss_cpp <- function(H, y) {
-  .Call(`_shapr_rss_cpp`, H, y)
+    .Call(`_shapr_rss_cpp`, H, y)
 }
 
 #' correction term with trace_input in AICc formula
@@ -42,7 +42,7 @@ rss_cpp <- function(H, y) {
 #' @return Scalar
 #' @author Martin Jullum
 correction_matrix_cpp <- function(tr_H, n) {
-  .Call(`_shapr_correction_matrix_cpp`, tr_H, n)
+    .Call(`_shapr_correction_matrix_cpp`, tr_H, n)
 }
 
 #'  Temp-function for computing the full AICc with several X's etc
@@ -59,7 +59,7 @@ correction_matrix_cpp <- function(tr_H, n) {
 #' @return Scalar with the numeric value of the AICc formula
 #' @author Martin Jullum
 aicc_full_single_cpp <- function(X, mcov, S_scale_dist, h, y) {
-  .Call(`_shapr_aicc_full_single_cpp`, X, mcov, S_scale_dist, h, y)
+    .Call(`_shapr_aicc_full_single_cpp`, X, mcov, S_scale_dist, h, y)
 }
 
 #'  AICc formula for several sets, alternative definition
@@ -77,7 +77,7 @@ aicc_full_single_cpp <- function(X, mcov, S_scale_dist, h, y) {
 #'
 #' @author Martin Jullum
 aicc_full_cpp <- function(h, X_list, mcov_list, S_scale_dist, y_list, negative) {
-  .Call(`_shapr_aicc_full_cpp`, h, X_list, mcov_list, S_scale_dist, y_list, negative)
+    .Call(`_shapr_aicc_full_cpp`, h, X_list, mcov_list, S_scale_dist, y_list, negative)
 }
 
 #' Compute the quantiles using quantile type seven
@@ -92,7 +92,7 @@ aicc_full_cpp <- function(h, X_list, mcov_list, S_scale_dist, y_list, negative)
 #' @keywords internal
 #' @author Lars Henry Berge Olsen
 quantile_type7_cpp <- function(x, probs) {
-  .Call(`_shapr_quantile_type7_cpp`, x, probs)
+    .Call(`_shapr_quantile_type7_cpp`, x, probs)
 }
 
 #' Transforms new data to a standardized normal distribution
@@ -105,7 +105,7 @@ quantile_type7_cpp <- function(x, probs) {
 #' @keywords internal
 #' @author Lars Henry Berge Olsen
 inv_gaussian_transform_cpp <- function(z, x) {
-  .Call(`_shapr_inv_gaussian_transform_cpp`, z, x)
+    .Call(`_shapr_inv_gaussian_transform_cpp`, z, x)
 }
 
 #' Generate (Gaussian) Copula MC samples
@@ -135,7 +135,7 @@ inv_gaussian_transform_cpp <- function(z, x) {
 #' @keywords internal
 #' @author Lars Henry Berge Olsen
 prepare_data_copula_cpp <- function(MC_samples_mat, x_explain_mat, x_explain_gaussian_mat, x_train_mat, S, mu, cov_mat) {
-  .Call(`_shapr_prepare_data_copula_cpp`, MC_samples_mat, x_explain_mat, x_explain_gaussian_mat, x_train_mat, S, mu, cov_mat)
+    .Call(`_shapr_prepare_data_copula_cpp`, MC_samples_mat, x_explain_mat, x_explain_gaussian_mat, x_train_mat, S, mu, cov_mat)
 }
 
 #' Generate Gaussian MC samples
@@ -159,7 +159,7 @@ prepare_data_copula_cpp <- function(MC_samples_mat, x_explain_mat, x_explain_gau
 #' @keywords internal
 #' @author Lars Henry Berge Olsen
 prepare_data_gaussian_cpp <- function(MC_samples_mat, x_explain_mat, S, mu, cov_mat) {
-  .Call(`_shapr_prepare_data_gaussian_cpp`, MC_samples_mat, x_explain_mat, S, mu, cov_mat)
+    .Call(`_shapr_prepare_data_gaussian_cpp`, MC_samples_mat, x_explain_mat, S, mu, cov_mat)
 }
 
 #' (Generalized) Mahalanobis distance
@@ -179,12 +179,12 @@ prepare_data_gaussian_cpp <- function(MC_samples_mat, x_explain_mat, S, mu, cov_
 #' @return Array of three dimensions. Contains the squared distance for between all training and test observations for all feature combinations passed to the function.
 #' @author Martin Jullum
 mahalanobis_distance_cpp <- function(featureList, Xtrain_mat, Xtest_mat, mcov, S_scale_dist) {
-  .Call(`_shapr_mahalanobis_distance_cpp`, featureList, Xtrain_mat, Xtest_mat, mcov, S_scale_dist)
+    .Call(`_shapr_mahalanobis_distance_cpp`, featureList, Xtrain_mat, Xtest_mat, mcov, S_scale_dist)
 }
 
 #' @keywords internal
 sample_features_cpp <- function(m, n_features) {
-  .Call(`_shapr_sample_features_cpp`, m, n_features)
+    .Call(`_shapr_sample_features_cpp`, m, n_features)
 }
 
 #' Get imputed data
@@ -223,7 +223,7 @@ sample_features_cpp <- function(m, n_features) {
 #'
 #' @author Nikolai Sellereite
 observation_impute_cpp <- function(index_xtrain, index_s, xtrain, xtest, S) {
-  .Call(`_shapr_observation_impute_cpp`, index_xtrain, index_s, xtrain, xtest, S)
+    .Call(`_shapr_observation_impute_cpp`, index_xtrain, index_s, xtrain, xtest, S)
 }
 
 #' Calculate weight matrix
@@ -242,7 +242,7 @@ observation_impute_cpp <- function(index_xtrain, index_s, xtrain, xtest, S) {
 #' @return Matrix of dimension n x m + 1
 #' @author Nikolai Sellereite
 weight_matrix_cpp <- function(subsets, m, n, w) {
-  .Call(`_shapr_weight_matrix_cpp`, subsets, m, n, w)
+    .Call(`_shapr_weight_matrix_cpp`, subsets, m, n, w)
 }
 
 #' Get feature matrix
@@ -256,5 +256,6 @@ weight_matrix_cpp <- function(subsets, m, n, w) {
 #' @return Matrix
 #' @author Nikolai Sellereite
 feature_matrix_cpp <- function(features, m) {
-  .Call(`_shapr_feature_matrix_cpp`, features, m)
+    .Call(`_shapr_feature_matrix_cpp`, features, m)
 }
+

R/approach_vaeac.R

@@ -14,6 +14,9 @@
 #'  epochs (default is `2`) and continue training that one.
 #' @param vaeac.epochs Integer. The number of epochs to train the final vaeac model. This includes
 #' `vaeac.extra_parameters$epochs_initiation_phase`, where the default is `2`.
+#' @param vaeac.save_model Boolean. If `TRUE` (default), the `vaeac` model will be saved either in a temp
+#' folder or in a user specified location specified in `vaeac.folder_to_save_model`. If `FALSE`, then the
+#' paths to model and the model will will be deleted from the returned object from [shapr::explain()].
 #' @param vaeac.extra_parameters Named list with extra parameters to the `vaeac` approach. See
 #' section "The `vaeac` approach" in [setup_approach()] for description of possible additional
 #' parameters.
@@ -133,6 +136,7 @@ setup_approach.vaeac <- function(internal, # add default values for vaeac here.
                                  vaeac.lr = 0.001,
                                  vaeac.num_vaeacs_initiate = 10,
                                  vaeac.epochs = 200,
+                                 vaeac.save_model = TRUE,
                                  vaeac.extra_parameters = list(),
                                  ...) {
   # A function that sets up and calls the function builds the models used by the vaeac approach.

R/explain.R

@@ -354,5 +354,11 @@ explain <- function(model,
   output$internal$objects$cols_per_horizon <- NULL
   output$internal$objects$W_list <- NULL
 
+  if (isFALSE(output$internal$parameters$vaeac.save_model)) {
+    output$internal$parameters$vaeac$models = NULL
+    output$internal$parameters$vaeac$parameters$folder_to_save_model = NULL
+    output$internal$parameters$vaeac$parameters$model_description = NULL
+  }
+
   return(output)
 }

tests/testthat/test-output.R

@@ -182,12 +182,9 @@ test_that("output_lm_numeric_vaeac", {
       n_samples = 10, # Low value here to speed up the time
       vaeac.epochs = 4, # Low value here to speed up the time
       vaeac.num_vaeacs_initiate = 2, # Low value here to speed up the time
+      vaeac.save_model = FALSE,
       vaeac.extra_parameters = list(
-        vaeac.epochs_initiation_phase = 2, # Low value here to speed up the time
-        # Add this since otherwise it gets set to the time, which would break the test.
-        vaeac.model_description = "test",
-        # Save the model in the current folder to avoid a OS specific tempdir to be set randomly
-        vaeac.folder_to_save_model = "."
+        vaeac.epochs_initiation_phase = 2 # Low value here to speed up the time
       )
     ),
     "output_lm_numeric_vaeac"
@@ -231,12 +228,9 @@ test_that("output_lm_categorical_vaeac", {
       n_samples = 10, # Low value here to speed up the time
       vaeac.epochs = 4, # Low value here to speed up the time
       vaeac.num_vaeacs_initiate = 2, # Low value here to speed up the time
+      vaeac.save_model = FALSE,
       vaeac.extra_parameters = list(
-        vaeac.epochs_initiation_phase = 2, # Low value here to speed up the time
-        # Add this since otherwise it gets set to the time, which would break the test.
-        vaeac.model_description = "test",
-        # Save the model in the current folder to avoid a OS specific tempdir to be set randomly
-        vaeac.folder_to_save_model = "."
+        vaeac.epochs_initiation_phase = 2 # Low value here to speed up the time
       )
     ),
     "output_lm_categorical_vaeac"
@@ -389,12 +383,9 @@ test_that("output_lm_mixed_vaeac", {
       n_samples = 10, # Low value here to speed up the time
       vaeac.epochs = 4, # Low value here to speed up the time
       vaeac.num_vaeacs_initiate = 2, # Low value here to speed up the time
+      vaeac.save_model = FALSE,
       vaeac.extra_parameters = list(
         vaeac.epochs_initiation_phase = 2, # Low value here to speed up the time
-        # Add this since otherwise it gets set to the time, which would break the test.
-        vaeac.model_description = "test",
-        # Save the model in the current folder to avoid a OS specific tempdir to be set randomly
-        vaeac.folder_to_save_model = "."
       )
     ),
     "output_lm_mixed_vaeac"