Fix cpp pointer bug (#435)

NorskRegnesentral · Jan 20, 2025 · b06d14b · b06d14b
1 parent 6b3cc17
commit b06d14b
Show file tree

Hide file tree

Showing 29 changed files with 214 additions and 148 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # shapr (development version)
 
+* Fix CRAN NOTE which turned out to be bug related to returning NULL rather than integer(0) to identify (unconditional)
+asymmetric causal sampling [#435](https://github.com/NorskRegnesentral/shapr/pull/435)
+
 # shapr 1.0.1 
 
 * Spelling checking and other minor clean up [#431](https://github.com/NorskRegnesentral/shapr/pull/431))

diff --git a/R/asymmetric_and_casual_Shapley.R b/R/asymmetric_and_casual_Shapley.R
@@ -374,7 +374,12 @@ get_S_causal_steps <- function(S, causal_ordering, confounding, as_string = FALS
 
         # If confounding is FALSE, add intervened features in the same component to the `to_condition` set.
         # If confounding is TRUE, then no extra conditioning.
-        if (!confounding[i]) to_condition <- union(intersect(causal_ordering[[i]], index_given), to_condition)
+
+        if (!confounding[i]) {
+          inter0 <- intersect(causal_ordering[[i]], index_given)
+          inter0 <- if (length(inter0) == 0) NULL else inter0
+          to_condition <- union(inter0, to_condition)
+        }
 
         # Save Sbar and S (sorting is for the visual)
         to_sample <- sort(to_sample)

diff --git a/R/explain_forecast.R b/R/explain_forecast.R
@@ -67,7 +67,6 @@
 #'
 #' @author Jon Lachmann, Martin Jullum
 #' @examples
-#'
 #' \dontrun{
 #' # Load example data
 #' data("airquality")

diff --git a/R/plot.R b/R/plot.R
@@ -78,7 +78,6 @@
 #'
 #' @export
 #' @examples
-#'
 #' \dontrun{
 #' data("airquality")
 #' airquality <- airquality[complete.cases(airquality), ]

diff --git a/R/zzz.R b/R/zzz.R
@@ -1,5 +1,4 @@
 .onLoad <- function(libname = find.package("shapr"), pkgname = "shapr") {
-
   # CRAN Note avoidance 1
   # (as per https://stackoverflow.com/questions/77323811/r-package-to-cran-had-cpu-time-5-times-elapsed-time)
   # CRAN OMP THREAD LIMIT

diff --git a/man/explain_forecast.Rd b/man/explain_forecast.Rd
diff --git a/man/plot.shapr.Rd b/man/plot.shapr.Rd
diff --git a/tests/testthat/_snaps/asymmetric-causal-output.md b/tests/testthat/_snaps/asymmetric-causal-output.md
@@ -374,11 +374,11 @@
       
       i Using 32 of 32 coalitions. 
     Output
-         explain_id  none Solar.R    Wind    Temp  Month     Day
-              <int> <num>   <num>   <num>   <num>  <num>   <num>
-      1:          1 42.44  -7.978  10.871 12.1981 -2.188 -0.3003
-      2:          2 42.44   3.637  -6.474 -9.6711 -1.850  0.4779
-      3:          3 42.44   1.926 -27.039  0.7298  1.404  5.4112
+         explain_id  none Solar.R    Wind   Temp  Month     Day
+              <int> <num>   <num>   <num>  <num>  <num>   <num>
+      1:          1 42.44  -8.606  10.387 13.963 -4.010  0.8685
+      2:          2 42.44   3.506  -6.071 -4.521 -6.183 -0.6104
+      3:          3 42.44   2.371 -26.300  2.790  1.600  1.9707
 
 # output_sym_caus_conf_mix
 

diff --git a/tests/testthat/_snaps/asymmetric-causal-output/output_sym_caus_conf_FALSE.rds b/tests/testthat/_snaps/asymmetric-causal-output/output_sym_caus_conf_FALSE.rds
diff --git a/tests/testthat/test-asymmetric-causal-output.R b/tests/testthat/test-asymmetric-causal-output.R
@@ -140,7 +140,6 @@ test_that("output_asym_caus_conf_TRUE", {
 })
 
 
-
 test_that("output_asym_caus_conf_FALSE", {
   expect_snapshot_rds(
     explain(
@@ -250,6 +249,7 @@ test_that("output_sym_caus_conf_TRUE", {
   )
 })
 
+
 test_that("output_sym_caus_conf_FALSE", {
   expect_snapshot_rds(
     explain(

diff --git a/tests/testthat/test-asymmetric-causal-setup.R b/tests/testthat/test-asymmetric-causal-setup.R
@@ -341,3 +341,33 @@ test_that("asymmetric erroneous input: `confounding`", {
     error = TRUE
   )
 })
+
+
+
+test_that("cond_sym_as_NULLconfounding", {
+  ex_condsym <- explain(
+    testing = TRUE,
+    model = model_lm_numeric,
+    x_explain = x_explain_numeric,
+    x_train = x_train_numeric,
+    approach = "gaussian",
+    phi0 = p0,
+    n_MC_samples = 5 # Just for speed
+  )
+
+  ex_NULLconfounding <- explain(
+    testing = TRUE,
+    model = model_lm_numeric,
+    x_explain = x_explain_numeric,
+    x_train = x_train_numeric,
+    approach = "gaussian",
+    phi0 = p0,
+    asymmetric = FALSE,
+    causal_ordering = list(1:2, 3, 4:5),
+    confounding = NULL,
+    n_MC_samples = 5 # Just for speed
+  )
+
+  # When confounding is NULL, causal_ordering is ignored and regular symmetric conditional shapley values is computed
+  expect_equal(ex_condsym$shapley_values_est, ex_NULLconfounding$shapley_values_est)
+})
diff --git a/vignettes/asymmetric_causal.Rmd b/vignettes/asymmetric_causal.Rmd
diff --git a/vignettes/figure_asymmetric_causal/compare_plots-1.png b/vignettes/figure_asymmetric_causal/compare_plots-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_asym_cau_SV-1.png b/vignettes/figure_asymmetric_causal/explanation_asym_cau_SV-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_asym_cau_beeswarm-1.png b/vignettes/figure_asymmetric_causal/explanation_asym_cau_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_asym_con_beeswarm-1.png b/vignettes/figure_asymmetric_causal/explanation_asym_con_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_sym_cau_beeswarm-1.png b/vignettes/figure_asymmetric_causal/explanation_sym_cau_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_sym_con_SV-1.png b/vignettes/figure_asymmetric_causal/explanation_sym_con_SV-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_sym_con_beeswarm-1.png b/vignettes/figure_asymmetric_causal/explanation_sym_con_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/explanation_sym_mar_beeswarm-1.png b/vignettes/figure_asymmetric_causal/explanation_sym_mar_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/group_gaussian_plot_SV-1.png b/vignettes/figure_asymmetric_causal/group_gaussian_plot_SV-1.png
diff --git a/vignettes/figure_asymmetric_causal/group_gaussian_plot_beeswarm-1.png b/vignettes/figure_asymmetric_causal/group_gaussian_plot_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/n_coalitions_plot_SV-1.png b/vignettes/figure_asymmetric_causal/n_coalitions_plot_SV-1.png
diff --git a/vignettes/figure_asymmetric_causal/n_coalitions_plot_beeswarm-1.png b/vignettes/figure_asymmetric_causal/n_coalitions_plot_beeswarm-1.png
diff --git a/vignettes/figure_asymmetric_causal/scatter_plots-1.png b/vignettes/figure_asymmetric_causal/scatter_plots-1.png
diff --git a/vignettes/figure_asymmetric_causal/sym_and_asym_Shapley_values-1.png b/vignettes/figure_asymmetric_causal/sym_and_asym_Shapley_values-1.png
diff --git a/vignettes/figure_asymmetric_causal/two_dates_1-1.png b/vignettes/figure_asymmetric_causal/two_dates_1-1.png
diff --git a/vignettes/figure_asymmetric_causal/two_dates_2-1.png b/vignettes/figure_asymmetric_causal/two_dates_2-1.png
diff --git a/vignettes/figure_asymmetric_causal/two_dates_3-1.png b/vignettes/figure_asymmetric_causal/two_dates_3-1.png