Not-fully-functional update

Author: andrewherren

NAMESPACE

@@ -23,6 +23,7 @@ export(createBCFModelFromJsonString)
 export(createCppJson)
 export(createCppJsonFile)
 export(createCppJsonString)
+export(createForest)
 export(createForestContainer)
 export(createForestCovariates)
 export(createForestCovariatesFromMetadata)

R/cpp11.R

@@ -216,6 +216,10 @@ rfx_label_mapper_to_list_cpp <- function(label_mapper_ptr) {
   .Call(`_stochtree_rfx_label_mapper_to_list_cpp`, label_mapper_ptr)
 }
 
+active_forest_cpp <- function(num_trees, output_dimension, is_leaf_constant, is_exponentiated) {
+  .Call(`_stochtree_active_forest_cpp`, num_trees, output_dimension, is_leaf_constant, is_exponentiated)
+}
+
 forest_container_cpp <- function(num_trees, output_dimension, is_leaf_constant, is_exponentiated) {
   .Call(`_stochtree_forest_container_cpp`, num_trees, output_dimension, is_leaf_constant, is_exponentiated)
 }
@@ -348,6 +352,82 @@ predict_forest_raw_single_forest_cpp <- function(forest_samples, dataset, forest
   .Call(`_stochtree_predict_forest_raw_single_forest_cpp`, forest_samples, dataset, forest_num)
 }
 
+predict_active_forest_cpp <- function(active_forest, dataset) {
+  .Call(`_stochtree_predict_active_forest_cpp`, active_forest, dataset)
+}
+
+predict_raw_active_forest_cpp <- function(active_forest, dataset) {
+  .Call(`_stochtree_predict_raw_active_forest_cpp`, active_forest, dataset)
+}
+
+output_dimension_active_forest_cpp <- function(active_forest) {
+  .Call(`_stochtree_output_dimension_active_forest_cpp`, active_forest)
+}
+
+average_max_depth_active_forest_cpp <- function(active_forest) {
+  .Call(`_stochtree_average_max_depth_active_forest_cpp`, active_forest)
+}
+
+num_trees_active_forest_cpp <- function(active_forest) {
+  .Call(`_stochtree_num_trees_active_forest_cpp`, active_forest)
+}
+
+ensemble_tree_max_depth_active_forest_cpp <- function(active_forest, tree_num) {
+  .Call(`_stochtree_ensemble_tree_max_depth_active_forest_cpp`, active_forest, tree_num)
+}
+
+is_leaf_constant_active_forest_cpp <- function(active_forest) {
+  .Call(`_stochtree_is_leaf_constant_active_forest_cpp`, active_forest)
+}
+
+all_roots_active_forest_cpp <- function(active_forest) {
+  .Call(`_stochtree_all_roots_active_forest_cpp`, active_forest)
+}
+
+set_leaf_value_active_forest_cpp <- function(active_forest, leaf_value) {
+  invisible(.Call(`_stochtree_set_leaf_value_active_forest_cpp`, active_forest, leaf_value))
+}
+
+set_leaf_vector_active_forest_cpp <- function(active_forest, leaf_vector) {
+  invisible(.Call(`_stochtree_set_leaf_vector_active_forest_cpp`, active_forest, leaf_vector))
+}
+
+add_numeric_split_tree_value_active_forest_cpp <- function(active_forest, tree_num, leaf_num, feature_num, split_threshold, left_leaf_value, right_leaf_value) {
+  invisible(.Call(`_stochtree_add_numeric_split_tree_value_active_forest_cpp`, active_forest, tree_num, leaf_num, feature_num, split_threshold, left_leaf_value, right_leaf_value))
+}
+
+add_numeric_split_tree_vector_active_forest_cpp <- function(active_forest, tree_num, leaf_num, feature_num, split_threshold, left_leaf_vector, right_leaf_vector) {
+  invisible(.Call(`_stochtree_add_numeric_split_tree_vector_active_forest_cpp`, active_forest, tree_num, leaf_num, feature_num, split_threshold, left_leaf_vector, right_leaf_vector))
+}
+
+get_tree_leaves_active_forest_cpp <- function(active_forest, tree_num) {
+  .Call(`_stochtree_get_tree_leaves_active_forest_cpp`, active_forest, tree_num)
+}
+
+get_tree_split_counts_active_forest_cpp <- function(active_forest, tree_num, num_features) {
+  .Call(`_stochtree_get_tree_split_counts_active_forest_cpp`, active_forest, tree_num, num_features)
+}
+
+get_overall_split_counts_active_forest_cpp <- function(active_forest, num_features) {
+  .Call(`_stochtree_get_overall_split_counts_active_forest_cpp`, active_forest, num_features)
+}
+
+get_granular_split_count_array_active_forest_cpp <- function(active_forest, num_features) {
+  .Call(`_stochtree_get_granular_split_count_array_active_forest_cpp`, active_forest, num_features)
+}
+
+initialize_forest_model_active_forest_cpp <- function(data, residual, active_forest, tracker, init_values, leaf_model_int) {
+  invisible(.Call(`_stochtree_initialize_forest_model_active_forest_cpp`, data, residual, active_forest, tracker, init_values, leaf_model_int))
+}
+
+adjust_residual_active_forest_cpp <- function(data, residual, active_forest, tracker, requires_basis, add) {
+  invisible(.Call(`_stochtree_adjust_residual_active_forest_cpp`, data, residual, active_forest, tracker, requires_basis, add))
+}
+
+propagate_basis_update_active_forest_cpp <- function(data, residual, active_forest, tracker) {
+  invisible(.Call(`_stochtree_propagate_basis_update_active_forest_cpp`, data, residual, active_forest, tracker))
+}
+
 forest_container_get_max_leaf_index_cpp <- function(forest_container, forest_num) {
   .Call(`_stochtree_forest_container_get_max_leaf_index_cpp`, forest_container, forest_num)
 }
@@ -356,20 +436,20 @@ compute_leaf_indices_cpp <- function(forest_container, covariates, forest_nums)
   .Call(`_stochtree_compute_leaf_indices_cpp`, forest_container, covariates, forest_nums)
 }
 
-sample_gfr_one_iteration_cpp <- function(data, residual, forest_samples, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, pre_initialized) {
-  invisible(.Call(`_stochtree_sample_gfr_one_iteration_cpp`, data, residual, forest_samples, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, pre_initialized))
+sample_gfr_one_iteration_cpp <- function(data, residual, forest_samples, active_forest, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, keep_forest, pre_initialized) {
+  invisible(.Call(`_stochtree_sample_gfr_one_iteration_cpp`, data, residual, forest_samples, active_forest, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, keep_forest, pre_initialized))
 }
 
-sample_mcmc_one_iteration_cpp <- function(data, residual, forest_samples, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, pre_initialized) {
-  invisible(.Call(`_stochtree_sample_mcmc_one_iteration_cpp`, data, residual, forest_samples, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, pre_initialized))
+sample_mcmc_one_iteration_cpp <- function(data, residual, forest_samples, active_forest, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, keep_forest, pre_initialized) {
+  invisible(.Call(`_stochtree_sample_mcmc_one_iteration_cpp`, data, residual, forest_samples, active_forest, tracker, split_prior, rng, feature_types, cutpoint_grid_size, leaf_model_scale_input, variable_weights, a_forest, b_forest, global_variance, leaf_model_int, keep_forest, pre_initialized))
 }
 
 sample_sigma2_one_iteration_cpp <- function(residual, dataset, rng, a, b) {
   .Call(`_stochtree_sample_sigma2_one_iteration_cpp`, residual, dataset, rng, a, b)
 }
 
-sample_tau_one_iteration_cpp <- function(forest_samples, rng, a, b, sample_num) {
-  .Call(`_stochtree_sample_tau_one_iteration_cpp`, forest_samples, rng, a, b, sample_num)
+sample_tau_one_iteration_cpp <- function(active_forest, rng, a, b, sample_num) {
+  .Call(`_stochtree_sample_tau_one_iteration_cpp`, active_forest, rng, a, b, sample_num)
 }
 
 rng_cpp <- function(random_seed) {

R/forest.R

@@ -327,12 +327,13 @@ Forest <- R6::R6Class(
 
         #' @description
         #' Create a new Forest object.
+        #' @param num_trees Number of trees in the forest
         #' @param output_dimension Dimensionality of the outcome model
         #' @param is_leaf_constant Whether leaf is constant
         #' @param is_exponentiated Whether forest predictions should be exponentiated before being returned
         #' @return A new `Forest` object.
-        initialize = function(output_dimension=1, is_leaf_constant=F, is_exponentiated=F) {
-            self$forest_ptr <- active_forest_cpp(output_dimension, is_leaf_constant, is_exponentiated)
+        initialize = function(num_trees, output_dimension=1, is_leaf_constant=F, is_exponentiated=F) {
+            self$forest_ptr <- active_forest_cpp(num_trees, output_dimension, is_leaf_constant, is_exponentiated)
         }, 
 
         #' @description
@@ -465,7 +466,7 @@ Forest <- R6::R6Class(
         #' @description
         #' Retrieve a vector of indices of leaf nodes for a given tree in a given forest
         #' @param tree_num Index of the tree for which leaf indices will be retrieved
-        get_tree_leaves = function(forest_num, tree_num) {
+        get_tree_leaves = function(tree_num) {
             return(get_tree_leaves_active_forest_cpp(self$forest_ptr, tree_num))
         }, 
 
@@ -518,14 +519,15 @@ createForestContainer <- function(num_trees, output_dimension=1, is_leaf_constan
 
 #' Create a forest
 #'
+#' @param num_trees Number of trees in the forest
 #' @param output_dimension Dimensionality of the outcome model
 #' @param is_leaf_constant Whether leaf is constant
 #' @param is_exponentiated Whether forest predictions should be exponentiated before being returned
 #'
 #' @return `Forest` object
 #' @export
-createForest <- function(output_dimension=1, is_leaf_constant=F, is_exponentiated=F) {
+createForest <- function(num_trees, output_dimension=1, is_leaf_constant=F, is_exponentiated=F) {
     return(invisible((
-        Forest$new(output_dimension, is_leaf_constant, is_exponentiated)
+        Forest$new(num_trees, output_dimension, is_leaf_constant, is_exponentiated)
     )))
 }

R/model.R

@@ -63,6 +63,7 @@ ForestModel <- R6::R6Class(
         #' @param forest_dataset Dataset used to sample the forest
         #' @param residual Outcome used to sample the forest
         #' @param forest_samples Container of forest samples
+        #' @param active_forest "Active" forest updated by the sampler in each iteration
         #' @param rng Wrapper around C++ random number generator
         #' @param feature_types Vector specifying the type of all p covariates in `forest_dataset` (0 = numeric, 1 = ordered categorical, 2 = unordered categorical)
         #' @param leaf_model_int Integer specifying the leaf model type (0 = constant leaf, 1 = univariate leaf regression, 2 = multivariate leaf regression)
@@ -71,26 +72,27 @@ ForestModel <- R6::R6Class(
         #' @param a_forest Shape parameter on variance forest model (if applicable)
         #' @param b_forest Scale parameter on variance forest model (if applicable)
         #' @param global_scale Global variance parameter
-        #' @param cutpoint_grid_size (Optional) Number of unique cutpoints to consider (default: 500, currently only used when `GFR = TRUE`)
-        #' @param gfr (Optional) Whether or not the forest should be sampled using the "grow-from-root" (GFR) algorithm
-        #' @param pre_initialized (Optional) Whether or not the leaves are pre-initialized outside of the sampling loop (before any samples are drawn). In multi-forest implementations like BCF, this is true, though in the single-forest supervised learning implementation, we can let C++ do the initialization. Default: F.
-        sample_one_iteration = function(forest_dataset, residual, forest_samples, rng, feature_types, 
+        #' @param cutpoint_grid_size (Optional) Number of unique cutpoints to consider (default: `500`, currently only used when `GFR = TRUE`)
+        #' @param keep_forest (Optional) Whether the updated forest sample should be saved to `forest_samples`. Default: `T`.
+        #' @param gfr (Optional) Whether or not the forest should be sampled using the "grow-from-root" (GFR) algorithm. Default: `T`.
+        #' @param pre_initialized (Optional) Whether or not the leaves are pre-initialized outside of the sampling loop (before any samples are drawn). In multi-forest implementations like BCF, this is true, though in the single-forest supervised learning implementation, we can let C++ do the initialization. Default: `F`.
+        sample_one_iteration = function(forest_dataset, residual, forest_samples, active_forest, rng, feature_types, 
                                         leaf_model_int, leaf_model_scale, variable_weights, 
                                         a_forest, b_forest, global_scale, cutpoint_grid_size = 500, 
-                                        gfr = T, pre_initialized = F) {
+                                        keep_forest = T, gfr = T, pre_initialized = F) {
             if (gfr) {
                 sample_gfr_one_iteration_cpp(
                     forest_dataset$data_ptr, residual$data_ptr, 
-                    forest_samples$forest_container_ptr, self$tracker_ptr, self$tree_prior_ptr, 
-                    rng$rng_ptr, feature_types, cutpoint_grid_size, leaf_model_scale, 
-                    variable_weights, a_forest, b_forest, global_scale, leaf_model_int, pre_initialized
+                    forest_samples$forest_container_ptr, active_forest$forest_ptr, self$tracker_ptr, 
+                    self$tree_prior_ptr, rng$rng_ptr, feature_types, cutpoint_grid_size, leaf_model_scale, 
+                    variable_weights, a_forest, b_forest, global_scale, leaf_model_int, keep_forest, pre_initialized
                 )
             } else {
                 sample_mcmc_one_iteration_cpp(
                     forest_dataset$data_ptr, residual$data_ptr, 
-                    forest_samples$forest_container_ptr, self$tracker_ptr, self$tree_prior_ptr,
-                    rng$rng_ptr, feature_types, cutpoint_grid_size, leaf_model_scale, 
-                    variable_weights, a_forest, b_forest, global_scale, leaf_model_int, pre_initialized
+                    forest_samples$forest_container_ptr, active_forest$forest_ptr, self$tracker_ptr, 
+                    self$tree_prior_ptr, rng$rng_ptr, feature_types, cutpoint_grid_size, leaf_model_scale, 
+                    variable_weights, a_forest, b_forest, global_scale, leaf_model_int, keep_forest, pre_initialized
                 ) 
             }
         }, 
@@ -106,17 +108,16 @@ ForestModel <- R6::R6Class(
         #' changed and this should be reflected through to the residual before the next sampling loop is run.
         #' @param dataset `ForestDataset` object storing the covariates and bases for a given forest
         #' @param outcome `Outcome` object storing the residuals to be updated based on forest predictions
-        #' @param forest_samples `ForestSamples` object storing draws of tree ensembles
-        #' @param forest_num Index of forest used to update residuals (starting at 1, in R style)
-        propagate_basis_update = function(dataset, outcome, forest_samples, forest_num) {
+        #' @param active_forest "Active" forest updated by the sampler in each iteration
+        propagate_basis_update = function(dataset, outcome, active_forest) {
             stopifnot(!is.null(dataset$data_ptr))
             stopifnot(!is.null(outcome$data_ptr))
             stopifnot(!is.null(self$tracker_ptr))
-            stopifnot(!is.null(forest_samples$forest_container_ptr))
+            stopifnot(!is.null(active_forest$forest_ptr))
 
-            propagate_basis_update_forest_container_cpp(
-                dataset$data_ptr, outcome$data_ptr, forest_samples$forest_container_ptr, 
-                self$tracker_ptr, forest_num
+            propagate_basis_update_active_forest_cpp(
+                dataset$data_ptr, outcome$data_ptr, active_forest$forest_ptr, 
+                self$tracker_ptr
             )
         }, 
 

R/variance.R

@@ -13,13 +13,13 @@ sample_sigma2_one_iteration <- function(residual, dataset, rng, a, b) {
 
 #' Sample one iteration of the leaf parameter variance model (only for univariate basis and constant leaf!)
 #'
-#' @param forest_samples Container of forest samples
+#' @param forest C++ forest sample
 #' @param rng C++ random number generator
 #' @param a Leaf variance shape parameter
 #' @param b Leaf variance scale parameter
 #' @param sample_num Sample index
 #'
 #' @export
-sample_tau_one_iteration <- function(forest_samples, rng, a, b, sample_num) {
-    return(sample_tau_one_iteration_cpp(forest_samples$forest_container_ptr, rng$rng_ptr, a, b, sample_num))
+sample_tau_one_iteration <- function(forest, rng, a, b, sample_num) {
+    return(sample_tau_one_iteration_cpp(forest$forest_ptr, rng$rng_ptr, a, b, sample_num))
 }

debug/api_debug.cpp

@@ -699,7 +699,7 @@ void RunDebug(int dgp_num = 0, const ModelType model_type = kConstantLeafGaussia
       }
 
       // Sample leaf node variance
-      leaf_variance_samples.push_back(leaf_var_model.SampleVarianceParameter(forest_samples.GetEnsemble(i), a_leaf, b_leaf, gen));
+      leaf_variance_samples.push_back(leaf_var_model.SampleVarianceParameter(&active_forest, a_leaf, b_leaf, gen));
 
       // Sample global variance
       global_variance_samples.push_back(global_var_model.SampleVarianceParameter(residual.GetData(), a_global, b_global, gen));
@@ -736,7 +736,7 @@ void RunDebug(int dgp_num = 0, const ModelType model_type = kConstantLeafGaussia
       }
 
       // Sample leaf node variance
-      leaf_variance_samples.push_back(leaf_var_model.SampleVarianceParameter(forest_samples.GetEnsemble(i), a_leaf, b_leaf, gen));
+      leaf_variance_samples.push_back(leaf_var_model.SampleVarianceParameter(&active_forest, a_leaf, b_leaf, gen));
 
       // Sample global variance
       global_variance_samples.push_back(global_var_model.SampleVarianceParameter(residual.GetData(), a_global, b_global, gen));