Updated vignettes and package

Author: andrewherren

NAMESPACE

@@ -71,6 +71,7 @@ export(saveBARTModelToJsonString)
 export(saveBCFModelToJsonFile)
 export(saveBCFModelToJsonString)
 importFrom(R6,R6Class)
+importFrom(stats, coef)
 importFrom(stats,lm)
 importFrom(stats,model.matrix)
 importFrom(stats,qgamma)

R/bart.R

@@ -697,6 +697,7 @@ bart <- function(X_train, y_train, W_train = NULL, group_ids_train = NULL,
         if (sample_sigma_leaf) {
             leaf_scale_samples <- leaf_scale_samples[(num_gfr+1):length(leaf_scale_samples)]
         }
+        num_retained_samples <- num_retained_samples - num_gfr
     }
 
     # Mean forest predictions

R/bcf.R

@@ -1098,6 +1098,7 @@ bcf <- function(X_train, Z_train, y_train, pi_train = NULL, group_ids_train = NU
         if (sample_sigma_leaf_tau) {
             leaf_scale_tau_samples <- leaf_scale_tau_samples[(num_gfr+1):length(leaf_scale_tau_samples)]
         }
+        num_retained_samples <- num_retained_samples - num_gfr
     }
 
     # Forest predictions

cran-bootstrap.R

@@ -250,72 +250,72 @@ if (all(file.exists(eigen_files_to_vendor_src))) {
     }
 }
 
-# Copy boost_math headers / implementations to an include/ subdirectory of src/
-boost_header_files_to_vendor_src <- c()
-boost_header_files_to_vendor_dst <- c()
-# Existing header files
-boost_header_subfolder_src <- "deps/boost_math/include/boost"
-boost_header_filenames_src <- list.files(boost_header_subfolder_src, pattern = "\\.(hpp)$", recursive = TRUE)
-boost_header_files_to_vendor_src <- file.path(boost_header_subfolder_src, boost_header_filenames_src)
-# Existing implementation files
-boost_impl_subfolder_src <- "deps/boost_math/src"
-boost_impl_filenames_src <- list.files(boost_impl_subfolder_src, pattern = "\\.(cpp)$", recursive = TRUE)
-boost_impl_files_to_vendor_src <- file.path(boost_impl_subfolder_src, boost_impl_filenames_src)
-# Destination files
-boost_header_subfolder_dst <- "src/include/boost"
-boost_header_files_to_vendor_dst <- file.path(cran_dir, boost_header_subfolder_dst, boost_header_filenames_src)
-boost_impl_files_to_vendor_dst <- file.path(cran_dir, boost_header_subfolder_dst, boost_impl_filenames_src)
-
-if (all(file.exists(boost_header_files_to_vendor_src))) {
-    n_removed <- suppressWarnings(sum(file.remove(boost_header_files_to_vendor_dst)))
-    if (n_removed > 0) {
-        cat(sprintf("Removed %d previously vendored files from src/include/boost\n", n_removed))
-    }
-    
-    cat(
-        sprintf(
-            "Vendoring files from deps/boost_math/include/boost/ to src/include/boost\n"
-        )
-    )
-    
-    # Recreate the directory structure
-    dst_dirs <- unique(dirname(boost_header_files_to_vendor_dst))
-    for (dst_dir in dst_dirs) {
-        if (!dir.exists(dst_dir)) {
-            dir.create(dst_dir, recursive = TRUE)
-        }
-    }
-    
-    if (all(file.copy(boost_header_files_to_vendor_src, boost_header_files_to_vendor_dst))) {
-        cat("All deps/boost_math/include/boost header files successfully copied to src/include/boost\n")
-    } else {
-        stop("Failed to vendor all deps/boost_math/include/boost header files")
-    }
-}
-
-if (all(file.exists(boost_impl_files_to_vendor_src))) {
-    n_removed <- suppressWarnings(sum(file.remove(boost_impl_files_to_vendor_dst)))
-    if (n_removed > 0) {
-        cat(sprintf("Removed %d previously vendored cpp files from src/include/boost\n", n_removed))
-    }
-    
-    cat(
-        sprintf(
-            "Vendoring files from deps/boost_math/src/ to src/include/boost\n"
-        )
-    )
-    
-    # Recreate the directory structure
-    dst_dirs <- unique(dirname(boost_impl_files_to_vendor_dst))
-    for (dst_dir in dst_dirs) {
-        if (!dir.exists(dst_dir)) {
-            dir.create(dst_dir, recursive = TRUE)
-        }
-    }
-    
-    if (all(file.copy(boost_impl_files_to_vendor_src, boost_impl_files_to_vendor_dst))) {
-        cat("All deps/boost_math/src header files successfully copied to src/include/boost\n")
-    } else {
-        stop("Failed to vendor all deps/boost_math/src header files")
-    }
-}
+# # Copy boost_math headers / implementations to an include/ subdirectory of src/
+# boost_header_files_to_vendor_src <- c()
+# boost_header_files_to_vendor_dst <- c()
+# # Existing header files
+# boost_header_subfolder_src <- "deps/boost_math/include/boost"
+# boost_header_filenames_src <- list.files(boost_header_subfolder_src, pattern = "\\.(hpp)$", recursive = TRUE)
+# boost_header_files_to_vendor_src <- file.path(boost_header_subfolder_src, boost_header_filenames_src)
+# # Existing implementation files
+# boost_impl_subfolder_src <- "deps/boost_math/src"
+# boost_impl_filenames_src <- list.files(boost_impl_subfolder_src, pattern = "\\.(cpp)$", recursive = TRUE)
+# boost_impl_files_to_vendor_src <- file.path(boost_impl_subfolder_src, boost_impl_filenames_src)
+# # Destination files
+# boost_header_subfolder_dst <- "src/include/boost"
+# boost_header_files_to_vendor_dst <- file.path(cran_dir, boost_header_subfolder_dst, boost_header_filenames_src)
+# boost_impl_files_to_vendor_dst <- file.path(cran_dir, boost_header_subfolder_dst, boost_impl_filenames_src)
+# 
+# if (all(file.exists(boost_header_files_to_vendor_src))) {
+#     n_removed <- suppressWarnings(sum(file.remove(boost_header_files_to_vendor_dst)))
+#     if (n_removed > 0) {
+#         cat(sprintf("Removed %d previously vendored files from src/include/boost\n", n_removed))
+#     }
+#     
+#     cat(
+#         sprintf(
+#             "Vendoring files from deps/boost_math/include/boost/ to src/include/boost\n"
+#         )
+#     )
+#     
+#     # Recreate the directory structure
+#     dst_dirs <- unique(dirname(boost_header_files_to_vendor_dst))
+#     for (dst_dir in dst_dirs) {
+#         if (!dir.exists(dst_dir)) {
+#             dir.create(dst_dir, recursive = TRUE)
+#         }
+#     }
+#     
+#     if (all(file.copy(boost_header_files_to_vendor_src, boost_header_files_to_vendor_dst))) {
+#         cat("All deps/boost_math/include/boost header files successfully copied to src/include/boost\n")
+#     } else {
+#         stop("Failed to vendor all deps/boost_math/include/boost header files")
+#     }
+# }
+# 
+# if (all(file.exists(boost_impl_files_to_vendor_src))) {
+#     n_removed <- suppressWarnings(sum(file.remove(boost_impl_files_to_vendor_dst)))
+#     if (n_removed > 0) {
+#         cat(sprintf("Removed %d previously vendored cpp files from src/include/boost\n", n_removed))
+#     }
+#     
+#     cat(
+#         sprintf(
+#             "Vendoring files from deps/boost_math/src/ to src/include/boost\n"
+#         )
+#     )
+#     
+#     # Recreate the directory structure
+#     dst_dirs <- unique(dirname(boost_impl_files_to_vendor_dst))
+#     for (dst_dir in dst_dirs) {
+#         if (!dir.exists(dst_dir)) {
+#             dir.create(dst_dir, recursive = TRUE)
+#         }
+#     }
+#     
+#     if (all(file.copy(boost_impl_files_to_vendor_src, boost_impl_files_to_vendor_dst))) {
+#         cat("All deps/boost_math/src header files successfully copied to src/include/boost\n")
+#     } else {
+#         stop("Failed to vendor all deps/boost_math/src header files")
+#     }
+# }

vignettes/CustomSamplingRoutine.Rmd

@@ -175,7 +175,7 @@ for (i in 1:num_warmstart) {
     
     # Sample leaf node variance parameter and update `leaf_prior_scale`
     leaf_scale_samples[i+1] <- sample_tau_one_iteration(
-        active_forest, rng, a_leaf, b_leaf, i-1
+        active_forest, rng, a_leaf, b_leaf
     )
     leaf_prior_scale[1,1] <- leaf_scale_samples[i+1]
 }
@@ -200,7 +200,7 @@ for (i in (num_warmstart+1):num_samples) {
     
     # Sample leaf node variance parameter and update `leaf_prior_scale`
     leaf_scale_samples[i+1] <- sample_tau_one_iteration(
-        active_forest, rng, a_leaf, b_leaf, i-1
+        active_forest, rng, a_leaf, b_leaf
     )
     leaf_prior_scale[1,1] <- leaf_scale_samples[i+1]
 }
@@ -388,12 +388,13 @@ for (i in 1:num_warmstart) {
     
     # Sample leaf node variance parameter and update `leaf_prior_scale`
     leaf_scale_samples[i+1] <- sample_tau_one_iteration(
-        active_forest, rng, a_leaf, b_leaf, i-1
+        active_forest, rng, a_leaf, b_leaf
     )
     leaf_prior_scale[1,1] <- leaf_scale_samples[i+1]
     
     # Sample random effects model
-    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, global_var_samples[i+1], rng)
+    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, 
+                                   TRUE, global_var_samples[i+1], rng)
 }
 ```
 
@@ -416,12 +417,13 @@ for (i in (num_warmstart+1):num_samples) {
     
     # Sample leaf node variance parameter and update `leaf_prior_scale`
     leaf_scale_samples[i+1] <- sample_tau_one_iteration(
-        active_forest, rng, a_leaf, b_leaf, i-1
+        active_forest, rng, a_leaf, b_leaf
     )
     leaf_prior_scale[1,1] <- leaf_scale_samples[i+1]
     
     # Sample random effects model
-    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, global_var_samples[i+1], rng)
+    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, 
+                                   TRUE, global_var_samples[i+1], rng)
 }
 ```
 
@@ -621,12 +623,13 @@ for (i in 1:num_warmstart) {
     
     # Sample leaf node variance parameter and update `leaf_prior_scale`
     leaf_scale_samples[i+1] <- sample_tau_one_iteration(
-        active_forest, rng, a_leaf, b_leaf, i-1
+        active_forest, rng, a_leaf, b_leaf
     )
     leaf_prior_scale[1,1] <- leaf_scale_samples[i+1]
     
     # Sample random effects model
-    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, global_var_samples[i+1], rng)
+    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, 
+                                   TRUE, global_var_samples[i+1], rng)
 }
 ```
 
@@ -649,12 +652,13 @@ for (i in (num_warmstart+1):num_samples) {
     
     # Sample leaf node variance parameter and update `leaf_prior_scale`
     leaf_scale_samples[i+1] <- sample_tau_one_iteration(
-        active_forest, rng, a_leaf, b_leaf, i-1
+        active_forest, rng, a_leaf, b_leaf
     )
     leaf_prior_scale[1,1] <- leaf_scale_samples[i+1]
     
     # Sample random effects model
-    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, global_var_samples[i+1], rng)
+    rfx_model$sample_random_effect(rfx_dataset, outcome, rfx_tracker, rfx_samples, 
+                                   TRUE, global_var_samples[i+1], rng)
 }
 ```