get categories of CategoricalVariable

R/RcppExports.R

@@ -81,6 +81,10 @@ categorical_variable_get_size_of <- function(variable, values) {
     .Call(`_individual_categorical_variable_get_size_of`, variable, values)
 }
 
+categorical_variable_get_categories <- function(variable) {
+    .Call(`_individual_categorical_variable_get_categories`, variable)
+}
+
 categorical_variable_queue_update_vector <- function(variable, value, index) {
     invisible(.Call(`_individual_categorical_variable_queue_update_vector`, variable, value, index))
 }

R/categorical_variable.R

@@ -31,6 +31,14 @@ CategoricalVariable <- R6::R6Class(
       categorical_variable_get_size_of(self$.variable, values)
     },
 
+    #' @description return a character vector of possible values.
+    #' Note that the order of the returned vector may not be the same order
+    #' that was given when the variable was intitialized, due to the underlying
+    #' unordered storage type. 
+    get_categories = function() {
+      categorical_variable_get_categories(self$.variable)
+    },
+
     #' @description queue an update for this variable
     #' @param values the new values
     #' @param index the indices of individuals whose value will be updated

src/RcppExports.cpp

@@ -235,6 +235,17 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// categorical_variable_get_categories
+std::vector<std::string> categorical_variable_get_categories(Rcpp::XPtr<CategoricalVariable> variable);
+RcppExport SEXP _individual_categorical_variable_get_categories(SEXP variableSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< Rcpp::XPtr<CategoricalVariable> >::type variable(variableSEXP);
+    rcpp_result_gen = Rcpp::wrap(categorical_variable_get_categories(variable));
+    return rcpp_result_gen;
+END_RCPP
+}
 // categorical_variable_queue_update_vector
 void categorical_variable_queue_update_vector(Rcpp::XPtr<CategoricalVariable> variable, const std::string& value, std::vector<size_t>& index);
 RcppExport SEXP _individual_categorical_variable_queue_update_vector(SEXP variableSEXP, SEXP valueSEXP, SEXP indexSEXP) {
@@ -814,6 +825,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_individual_categorical_variable_queue_update", (DL_FUNC) &_individual_categorical_variable_queue_update, 3},
     {"_individual_categorical_variable_get_index_of", (DL_FUNC) &_individual_categorical_variable_get_index_of, 2},
     {"_individual_categorical_variable_get_size_of", (DL_FUNC) &_individual_categorical_variable_get_size_of, 2},
+    {"_individual_categorical_variable_get_categories", (DL_FUNC) &_individual_categorical_variable_get_categories, 1},
     {"_individual_categorical_variable_queue_update_vector", (DL_FUNC) &_individual_categorical_variable_queue_update_vector, 3},
     {"_individual_categorical_variable_update", (DL_FUNC) &_individual_categorical_variable_update, 1},
     {"_individual_dummy", (DL_FUNC) &_individual_dummy, 0},

src/categorical_variable.cpp

@@ -48,6 +48,18 @@ int categorical_variable_get_size_of(
     return variable->get_size_of(values);
 }
 
+//[[Rcpp::export]]
+std::vector<std::string> categorical_variable_get_categories(
+    Rcpp::XPtr<CategoricalVariable> variable
+    ) {
+    std::vector<std::string> categories;
+    categories.reserve(variable->indices.size());
+    for (const auto& it : variable->indices) {
+        categories.emplace_back(it.first);
+    }
+    return categories;
+}
+
 //[[Rcpp::export]]
 void categorical_variable_queue_update_vector(
     Rcpp::XPtr<CategoricalVariable> variable,

src/prefab.cpp

@@ -25,7 +25,7 @@ Rcpp::XPtr<process_t> fixed_probability_multinomial_process_internal(
 
     // make pointer to lambda function and return XPtr to R
     return Rcpp::XPtr<process_t>(
-        new process_t([variable,source_state,destination_states,rate,cdf](size_t t){      
+        new process_t([variable,source_state,destination_states,rate,cdf](size_t t){
 
             // sample leavers
             individual_index_t leaving_individuals(variable->get_index_of(source_state));
@@ -73,7 +73,7 @@ Rcpp::XPtr<process_t> multi_probability_multinomial_process_internal(
 
     // make pointer to lambda function and return XPtr to R
     return Rcpp::XPtr<process_t>(
-        new process_t([variable,source_state,destination_states,rate_variable,cdf](size_t t){      
+        new process_t([variable,source_state,destination_states,rate_variable,cdf](size_t t){
 
             // sample leavers with their unique prob
             individual_index_t leaving_individuals(variable->get_index_of(source_state));
@@ -83,7 +83,7 @@ Rcpp::XPtr<process_t> multi_probability_multinomial_process_internal(
             // empty bitsets to put them (their destinations)
             std::vector<individual_index_t> destination_individuals;
             size_t n = destination_states.size();
-            for(size_t i=0; i<n; i++) {
+            for (size_t i=0; i<n; i++) {
                 destination_individuals.emplace_back(leaving_individuals.max_size());
             }
 
@@ -117,7 +117,7 @@ Rcpp::XPtr<process_t> multi_probability_bernoulli_process_internal(
 
     // make pointer to lambda function and return XPtr to R
     return Rcpp::XPtr<process_t>(
-        new process_t([variable,rate_variable,from,to](size_t t){      
+        new process_t([variable,rate_variable,from,to](size_t t){
 
             // sample leavers with their unique prob
             individual_index_t leaving_individuals(variable->get_index_of(from));

tests/testthat/test-variables.R

@@ -40,6 +40,12 @@ test_that("getting the size of CategoricalVariable category which does not exist
   expect_error(state$get_size_of('X'))
 })
 
+test_that("can retrieve categories of CategoricalVariable", {
+  values <- c("S","E","I","R")
+  var <- CategoricalVariable$new(categories = values,initial_values = rep(values,2))
+  expect_setequal(categorical_variable_get_categories(var$.variable), values)
+})
+
 test_that("getting variables works", {
   size <- 10
   sequence <- DoubleVariable$new(seq_len(size))