outliertree 0.2.1 → 0.3.1

data/vendor/outliertree/src/Rwrapper.cpp

@@ -1,4 +1,8 @@
+#ifdef _FOR_R
+
 #include <Rcpp.h>
+#include <Rcpp/unwindProtect.h>
+#include <R_ext/Altrep.h>
 // [[Rcpp::plugins(cpp11)]]
 
 /* This is to serialize the model objects */
@@ -7,15 +11,31 @@
 #include <cereal/types/vector.hpp>
 #include <sstream>
 #include <string>
+#include <limits>
 
 /* This is the package's header */
 #include "outlier_tree.hpp"
 
+void delete_model_from_R_ptr(SEXP R_ptr)
+{
+    ModelOutputs *model = static_cast<ModelOutputs*>(R_ExternalPtrAddr(R_ptr));
+    delete model;
+    R_SetExternalPtrAddr(R_ptr, nullptr);
+    R_ClearExternalPtr(R_ptr);
+}
+
+SEXP alloc_RawVec(void *data)
+{
+    size_t vec_size = *(size_t*)data;
+    if (vec_size > (size_t)std::numeric_limits<R_xlen_t>::max())
+        Rcpp::stop("Resulting model is too large for R to handle.");
+    return Rf_allocVector(RAWSXP, vec_size);
+}
+
 /* for model serialization and re-usage in R */
 /* https://stackoverflow.com/questions/18474292/how-to-handle-c-internal-data-structure-in-r-in-order-to-allow-save-load */
 /* this extra comment below the link is a workaround for Rcpp issue 675 in GitHub, do not remove it */
-#include <Rinternals.h>
-Rcpp::RawVector serialize_OutlierTree(ModelOutputs *model_outputs)
+SEXP serialize_OutlierTree(ModelOutputs *model_outputs)
 {
     std::stringstream ss;
     {
@@ -23,30 +43,157 @@ Rcpp::RawVector serialize_OutlierTree(ModelOutputs *model_outputs)
         oarchive(*model_outputs);
     }
     ss.seekg(0, ss.end);
-    Rcpp::RawVector retval(ss.tellg());
+    std::stringstream::pos_type vec_size = ss.tellg();
+    if (vec_size <= 0) {
+        Rf_error("Error: model is too big to serialize, resulting object will not be usable.\n");
+    }
+    size_t vec_size_ = (size_t)vec_size;
+    SEXP retval = PROTECT(Rcpp::unwindProtect(alloc_RawVec, (void*)&vec_size_));
     ss.seekg(0, ss.beg);
-    ss.read(reinterpret_cast<char*>(&retval[0]), retval.size());
+    ss.read(reinterpret_cast<char*>(RAW(retval)), vec_size_);
+    UNPROTECT(1);
     return retval;
 }
 
-// [[Rcpp::export]]
-SEXP deserialize_OutlierTree(Rcpp::RawVector src)
+SEXP deserialize_OutlierTree(SEXP src, SEXP ptr_obj)
 {
     std::stringstream ss;
-    ss.write(reinterpret_cast<char*>(&src[0]), src.size());
+    ss.write(reinterpret_cast<char*>(RAW(src)), Rf_xlength(src));
     ss.seekg(0, ss.beg);
     std::unique_ptr<ModelOutputs> model_outputs = std::unique_ptr<ModelOutputs>(new ModelOutputs());
     {
         cereal::BinaryInputArchive iarchive(ss);
         iarchive(*model_outputs);
     }
-    return Rcpp::XPtr<ModelOutputs>(model_outputs.release(), true);
+    R_SetExternalPtrAddr(ptr_obj, model_outputs.get());
+    R_RegisterCFinalizerEx(ptr_obj, delete_model_from_R_ptr, TRUE);
+    model_outputs.release();
+    return R_NilValue;
+}
+
+static R_altrep_class_t otree_altrepped_pointer_class;
+
+R_xlen_t altrepped_pointer_length(SEXP obj)
+{
+    return 1;
+}
+
+SEXP get_element_from_altrepped_ptr(SEXP R_altrepped_obj, R_xlen_t idx)
+{
+    return R_altrep_data1(R_altrepped_obj);
+}
+
+Rboolean inspect_altrepped_pointer(SEXP x, int pre, int deep, int pvec, void (*inspect_subtree)(SEXP, int, int, int))
+{
+    Rprintf("Altrepped pointer [address:%p]\n", R_ExternalPtrAddr(R_altrep_data1(x)));
+    return TRUE;
+}
+
+SEXP duplicate_altrepped_pointer(SEXP altrepped_obj, Rboolean deep)
+{
+    SEXP R_ptr_name = PROTECT(Rf_mkString("ptr"));
+    SEXP R_ptr_class = PROTECT(Rf_mkString("otree_altrepped_handle"));
+    SEXP out = PROTECT(R_new_altrep(otree_altrepped_pointer_class, R_NilValue, R_NilValue));
+
+    if (!deep) {
+        R_set_altrep_data1(out, R_altrep_data1(altrepped_obj));
+    }
+
+    else {
+
+        SEXP R_ptr = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
+
+        try {
+            std::unique_ptr<ModelOutputs> new_obj(new ModelOutputs());
+            ModelOutputs *cpp_ptr = (ModelOutputs*)R_ExternalPtrAddr(R_altrep_data1(altrepped_obj));
+            *new_obj = *cpp_ptr;
+
+            R_SetExternalPtrAddr(R_ptr, new_obj.get());
+            R_RegisterCFinalizerEx(R_ptr, delete_model_from_R_ptr, TRUE);
+            new_obj.release();
+        }
+
+        catch (const std::exception &ex) {
+            Rf_error("%s\n", ex.what());
+        }
+
+        R_set_altrep_data1(out, R_ptr);
+        UNPROTECT(1);
+    }
+
+    Rf_setAttrib(out, R_NamesSymbol, R_ptr_name);
+    Rf_setAttrib(out, R_NamesSymbol, R_ptr_class);
+    UNPROTECT(3);
+    return out;
 }
 
-// [[Rcpp::export]]
-Rcpp::LogicalVector check_null_ptr_model(SEXP ptr_model)
+SEXP serialize_altrepped_pointer(SEXP altrepped_obj)
 {
-    return Rcpp::LogicalVector(R_ExternalPtrAddr(ptr_model) == NULL);
+    return serialize_OutlierTree((ModelOutputs*)R_ExternalPtrAddr(R_altrep_data1(altrepped_obj)));
+}
+
+SEXP deserialize_altrepped_pointer(SEXP cls, SEXP R_state)
+{
+    SEXP R_ptr_name = PROTECT(Rf_mkString("ptr"));
+    SEXP R_ptr_class = PROTECT(Rf_mkString("otree_altrepped_handle"));
+    SEXP R_ptr = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
+    SEXP out = PROTECT(R_new_altrep(otree_altrepped_pointer_class, R_NilValue, R_NilValue));
+
+    try {
+        deserialize_OutlierTree(R_state, R_ptr);
+    }
+    catch (const std::exception &ex) {
+        Rf_error("%s\n", ex.what());
+    }
+
+    R_set_altrep_data1(out, R_ptr);
+    Rf_setAttrib(out, R_NamesSymbol, R_ptr_name);
+    Rf_setAttrib(out, R_ClassSymbol, R_ptr_class);
+
+    UNPROTECT(4);
+    return out;
+}
+
+SEXP get_altrepped_pointer(void *void_ptr)
+{
+    SEXP R_ptr_name = PROTECT(Rf_mkString("ptr"));
+    SEXP R_ptr_class = PROTECT(Rf_mkString("otree_altrepped_handle"));
+    SEXP R_ptr = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
+    SEXP out = PROTECT(R_new_altrep(otree_altrepped_pointer_class, R_NilValue, R_NilValue));
+
+    std::unique_ptr<ModelOutputs> *ptr = (std::unique_ptr<ModelOutputs>*)void_ptr;
+    R_SetExternalPtrAddr(R_ptr, ptr->get());
+    R_RegisterCFinalizerEx(R_ptr, delete_model_from_R_ptr, TRUE);
+    ptr->release();
+    
+    R_set_altrep_data1(out, R_ptr);
+    Rf_setAttrib(out, R_NamesSymbol, R_ptr_name);
+    Rf_setAttrib(out, R_ClassSymbol, R_ptr_class);
+
+    UNPROTECT(4);
+    return out;
+}
+
+// [[Rcpp::init]]
+void init_altrepped_class(DllInfo* dll)
+{
+    otree_altrepped_pointer_class = R_make_altlist_class("otree_altrepped_pointer_class", "outliertree", dll);
+    R_set_altrep_Length_method(otree_altrepped_pointer_class, altrepped_pointer_length);
+    R_set_altrep_Inspect_method(otree_altrepped_pointer_class, inspect_altrepped_pointer);
+    R_set_altrep_Serialized_state_method(otree_altrepped_pointer_class, serialize_altrepped_pointer);
+    R_set_altrep_Unserialize_method(otree_altrepped_pointer_class, deserialize_altrepped_pointer);
+    R_set_altrep_Duplicate_method(otree_altrepped_pointer_class, duplicate_altrepped_pointer);
+    R_set_altlist_Elt_method(otree_altrepped_pointer_class, get_element_from_altrepped_ptr);
+}
+
+SEXP safe_int(void *x)
+{
+    return Rf_ScalarInteger(*(int*)x);
+}
+
+SEXP safe_bool(void *x)
+{
+    return Rf_ScalarLogical(*(bool*)x);
 }
 
 double* set_R_nan_as_C_nan(double *restrict x_R, std::vector<double> &x_C, size_t n, int nthreads)
@@ -59,12 +206,22 @@ double* set_R_nan_as_C_nan(double *restrict x_R, std::vector<double> &x_C, size_
     return x_C.data();
 }
 
+double* set_R_nan_as_C_nan(double *restrict x_R, Rcpp::NumericVector &x_C, size_t n, int nthreads)
+{
+    x_C = Rcpp::NumericVector(x_R, x_R + n);
+    #pragma omp parallel for schedule(static) num_threads(nthreads) shared(x_R, x_C, n)
+    for (size_t_for i = 0; i < n; i++)
+        if (isnan(x_R[i]) || Rcpp::NumericVector::is_na(x_R[i]) || Rcpp::traits::is_nan<REALSXP>(x_R[i]))
+            x_C[i] = NAN;
+    return REAL(x_C);
+}
+
 
 /* for predicting outliers */
 Rcpp::List describe_outliers(ModelOutputs &model_outputs,
-                             double *arr_num,
-                             int    *arr_cat,
-                             int    *arr_ord,
+                             double *restrict arr_num,
+                             int    *restrict arr_cat,
+                             int    *restrict arr_ord,
                              Rcpp::ListOf<Rcpp::StringVector> cat_levels,
                              Rcpp::ListOf<Rcpp::StringVector> ord_levels,
                              Rcpp::StringVector colnames_num,
@@ -209,7 +366,7 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
             } else if (outl_col < (ncols_num + ncols_cat)) {
                 if (outl_col < (ncols_num + ncols_cat_cat)) {
                     tmp_bool = Rcpp::LogicalVector(model_outputs.all_clusters[outl_col][outl_clust].subset_common.size(), false);
-                    for (size_t cat = 0; cat < tmp_bool.size(); cat++) {
+                    for (size_t cat = 0; cat < (size_t)tmp_bool.size(); cat++) {
                         if (model_outputs.all_clusters[outl_col][outl_clust].subset_common[cat] == 0) {
                             tmp_bool[cat] = true;
                             }
@@ -253,7 +410,7 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                 }
             } else {
                 tmp_bool = Rcpp::LogicalVector(model_outputs.all_clusters[outl_col][outl_clust].subset_common.size(), false);
-                for (size_t cat = 0; cat < tmp_bool.size(); cat++) {
+                for (size_t cat = 0; cat < (size_t)tmp_bool.size(); cat++) {
                     if (model_outputs.all_clusters[outl_col][outl_clust].subset_common[cat] == 0) {
                         tmp_bool[cat] = true;
                     }
@@ -345,6 +502,12 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                         }
                         break;
                     }
+
+                    default:
+                    {
+                        assert(0);
+                        break;
+                    }
                 }
                 
                 /* add the comparison point */
@@ -377,6 +540,11 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                 cond_clust["value_comp"] = Rcpp::as<Rcpp::CharacterVector>(NA_STRING);
                                 break;
                             }
+
+                            default:
+                            {
+                                unexpected_error();
+                            }
                         }
                         break;
                     }
@@ -492,6 +660,12 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                         }
                         break;
                     }
+
+                    default:
+                    {
+                        assert(0);
+                        break;
+                    }
                     
                 }
                 lst_cond[row] = Rcpp::List::create(Rcpp::clone(cond_clust));
@@ -528,6 +702,12 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                 cond_clust["column"] = Rcpp::as<Rcpp::CharacterVector>(colnames_ord[model_outputs.all_trees[outl_col][curr_tree].col_num]);
                                 break;
                             }
+
+                            default:
+                            {
+                                assert(0);
+                                break;
+                            }
                         }
 
                         /* add conditions from tree */
@@ -599,6 +779,7 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                         break;
                                     }
 
+                                    default: {}
                                 }
                                 break;
                             }
@@ -696,6 +877,7 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                         break;
                                     }
 
+                                    default: {}
                                 }
                                 break;
                             }
@@ -758,10 +940,16 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                         break;
                                     }
 
+                                    default: {}
                                 }
                                 break;
                             }
 
+                            default:
+                            {
+                                assert(0);
+                                break;
+                            }
                         }
                     }
 
@@ -796,6 +984,12 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                 cond_clust["column"] = Rcpp::as<Rcpp::CharacterVector>(colnames_ord[model_outputs.all_trees[outl_col][parent_tree].col_num]);
                                 break;
                             }
+
+                            default:
+                            {
+                                assert(0);
+                                break;
+                            }
                         }
 
 
@@ -835,6 +1029,11 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                         cond_clust["value_comp"] = Rcpp::as<Rcpp::CharacterVector>(NA_STRING);
                                         break;
                                     }
+
+                                    default:
+                                    {
+                                        unexpected_error();
+                                    }
                                 }
                                 break;
                             }
@@ -1011,6 +1210,11 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
                                 break;
                             }
 
+                            default:
+                            {
+                                assert(0);
+                                break;
+                            }
                         }
 
                         
@@ -1038,6 +1242,37 @@ Rcpp::List describe_outliers(ModelOutputs &model_outputs,
     return outp;
 }
 
+struct args_describe_outliers {
+    ModelOutputs *model_outputs;
+    double *arr_num;
+    int    *arr_cat;
+    int    *arr_ord;
+    Rcpp::ListOf<Rcpp::StringVector> *cat_levels;
+    Rcpp::ListOf<Rcpp::StringVector> *ord_levels;
+    Rcpp::StringVector *colnames_num;
+    Rcpp::StringVector *colnames_cat;
+    Rcpp::StringVector *colnames_ord;
+    Rcpp::NumericVector *min_date;
+    Rcpp::NumericVector *min_ts;
+};
+
+SEXP describe_outliers_wrapper(void *args_)
+{
+    args_describe_outliers *args = (args_describe_outliers*)args_;
+    return describe_outliers(*(args->model_outputs),
+                             args->arr_num,
+                             args->arr_cat,
+                             args->arr_ord,
+                             *(args->cat_levels),
+                             *(args->ord_levels),
+                             *(args->colnames_num),
+                             *(args->colnames_cat),
+                             *(args->colnames_ord),
+                             *(args->min_date),
+                             *(args->min_ts));
+}
+
+
 /* for extracting info about flaggable outliers */
 Rcpp::List extract_outl_bounds(ModelOutputs &model_outputs,
                                Rcpp::ListOf<Rcpp::StringVector> cat_levels,
@@ -1102,9 +1337,27 @@ Rcpp::List extract_outl_bounds(ModelOutputs &model_outputs,
     return outp;
 }
 
+struct args_extract_outl_bounds {
+    ModelOutputs *model_outputs;
+    Rcpp::ListOf<Rcpp::StringVector> *cat_levels;
+    Rcpp::ListOf<Rcpp::StringVector> *ord_levels;
+    Rcpp::NumericVector *min_date;
+    Rcpp::NumericVector *min_ts;
+};
+
+SEXP extract_outl_bounds_wrapper(void *args_)
+{
+    args_extract_outl_bounds *args = (args_extract_outl_bounds*)args_;
+    return extract_outl_bounds(*(args->model_outputs),
+                               *(args->cat_levels),
+                               *(args->ord_levels),
+                               *(args->min_date),
+                               *(args->min_ts));
+}
+
 
 /* external functions for fitting the model and predicting outliers */
-// [[Rcpp::export]]
+// [[Rcpp::export(rng = false)]]
 Rcpp::List fit_OutlierTree(Rcpp::NumericVector arr_num, size_t ncols_numeric,
                            Rcpp::IntegerVector arr_cat, size_t ncols_categ,   Rcpp::IntegerVector ncat,
                            Rcpp::IntegerVector arr_ord, size_t ncols_ord,     Rcpp::IntegerVector ncat_ord,
@@ -1121,8 +1374,16 @@ Rcpp::List fit_OutlierTree(Rcpp::NumericVector arr_num, size_t ncols_numeric,
                            Rcpp::NumericVector min_date,
                            Rcpp::NumericVector min_ts)
 {
+    Rcpp::List outp = Rcpp::List::create(
+        Rcpp::_["ptr_model"] = R_NilValue,
+        Rcpp::_["bounds"] = R_NilValue,
+        Rcpp::_["outliers_info"] = R_NilValue,
+        Rcpp::_["ntrees"] = R_NilValue,
+        Rcpp::_["nclust"] = R_NilValue,
+        Rcpp::_["found_outliers"] = R_NilValue
+    );
+
     bool found_outliers;
-    Rcpp::List outp;
     size_t tot_cols = ncols_numeric + ncols_categ + ncols_ord;
     std::vector<char> cols_ignore;
     char *cols_ignore_ptr = NULL;
@@ -1132,54 +1393,62 @@ Rcpp::List fit_OutlierTree(Rcpp::NumericVector arr_num, size_t ncols_numeric,
         cols_ignore_ptr = &cols_ignore[0];
     }
     std::vector<double> Xcpp;
-    double *arr_num_C = set_R_nan_as_C_nan(&arr_num[0], Xcpp, arr_num.size(), nthreads);
+    double *arr_num_C = set_R_nan_as_C_nan(REAL(arr_num), Xcpp, arr_num.size(), nthreads);
 
     std::unique_ptr<ModelOutputs> model_outputs = std::unique_ptr<ModelOutputs>(new ModelOutputs());
     found_outliers = fit_outliers_models(*model_outputs,
                                          arr_num_C, ncols_numeric,
-                                         &arr_cat[0], ncols_categ, &ncat[0],
-                                         &arr_ord[0], ncols_ord,   &ncat_ord[0],
+                                         INTEGER(arr_cat), ncols_categ, INTEGER(ncat),
+                                         INTEGER(arr_ord), ncols_ord,   INTEGER(ncat_ord),
                                          nrows, cols_ignore_ptr, nthreads,
                                          categ_as_bin, ord_as_bin, cat_bruteforce_subset, categ_from_maj, take_mid,
                                          max_depth, max_perc_outliers, min_size_numeric, min_size_categ,
                                          min_gain, gain_as_pct, follow_all, z_norm, z_outlier);
 
-    outp["bounds"] = extract_outl_bounds(*model_outputs,
-                                         cat_levels,
-                                         ord_levels,
-                                         min_date,
-                                         min_ts);
+    args_extract_outl_bounds temp = {
+        model_outputs.get(),
+        &cat_levels,
+        &ord_levels,
+        &min_date,
+        &min_ts
+    };
+    outp["bounds"] = Rcpp::unwindProtect(extract_outl_bounds_wrapper, (void*)&temp);
 
-    outp["serialized_obj"] = serialize_OutlierTree(model_outputs.get());
     if (return_outliers) {
-        outp["outliers_info"] = describe_outliers(*model_outputs,
-                                                  arr_num_C,
-                                                  &arr_cat[0],
-                                                  &arr_ord[0],
-                                                  cat_levels,
-                                                  ord_levels,
-                                                  colnames_num,
-                                                  colnames_cat,
-                                                  colnames_ord,
-                                                  min_date,
-                                                  min_ts);
+        args_describe_outliers temp = {
+            model_outputs.get(),
+            arr_num_C,
+            INTEGER(arr_cat),
+            INTEGER(arr_ord),
+            &cat_levels,
+            &ord_levels,
+            &colnames_num,
+            &colnames_cat,
+            &colnames_ord,
+            &min_date,
+            &min_ts
+        };
+        outp["outliers_info"] = Rcpp::unwindProtect(describe_outliers_wrapper, (void*)&temp);
     }
+    forget_row_outputs(*model_outputs);
+
     /* add number of trees and clusters */
     size_t ntrees = 0, nclust = 0;
     for (size_t col = 0; col < model_outputs->all_trees.size(); col++) {
     	ntrees += model_outputs->all_trees[col].size();
     	nclust += model_outputs->all_clusters[col].size();
     }
-    outp["ntrees"] = Rcpp::wrap((int) ntrees);
-    outp["nclust"] = Rcpp::wrap((int) nclust);
-    outp["found_outliers"] = Rcpp::wrap(found_outliers);
+    int ntrees_int = (int)ntrees;
+    int nclust_int = (int)nclust;
+    outp["ntrees"] = Rcpp::unwindProtect(safe_int, (void*)&ntrees_int);
+    outp["nclust"] = Rcpp::unwindProtect(safe_int, (void*)&nclust_int);
+    outp["found_outliers"] = Rcpp::unwindProtect(safe_bool, (void*)&found_outliers);
     
-    forget_row_outputs(*model_outputs);
-    outp["ptr_model"] = Rcpp::XPtr<ModelOutputs>(model_outputs.release(), true);
+    outp["ptr_model"] = Rcpp::unwindProtect(get_altrepped_pointer, &model_outputs);
     return outp;
 }
 
-// [[Rcpp::export]]
+// [[Rcpp::export(rng = false)]]
 Rcpp::List predict_OutlierTree(SEXP ptr_model, size_t nrows, int nthreads,
                                Rcpp::NumericVector arr_num, Rcpp::IntegerVector arr_cat, Rcpp::IntegerVector arr_ord,
                                Rcpp::ListOf<Rcpp::StringVector> cat_levels,
@@ -1190,36 +1459,59 @@ Rcpp::List predict_OutlierTree(SEXP ptr_model, size_t nrows, int nthreads,
                                Rcpp::NumericVector min_date,
                                Rcpp::NumericVector min_ts)
 {
-    std::vector<double> Xcpp;
-    double *arr_num_C = set_R_nan_as_C_nan(&arr_num[0], Xcpp, arr_num.size(), nthreads);
+    Rcpp::NumericVector Xcpp;
+    double *arr_num_C = set_R_nan_as_C_nan(REAL(arr_num), Xcpp, arr_num.size(), nthreads);
 
     ModelOutputs *model_outputs = static_cast<ModelOutputs*>(R_ExternalPtrAddr(ptr_model));
-    bool found_outliers = find_new_outliers(&arr_num[0], &arr_cat[0], &arr_ord[0],
+    bool found_outliers = find_new_outliers(arr_num_C, INTEGER(arr_cat), INTEGER(arr_ord),
                                             nrows, nthreads, *model_outputs);
-    Rcpp::List outp = describe_outliers(*model_outputs,
-                                        arr_num_C,
-                                        &arr_cat[0],
-                                        &arr_ord[0],
-                                        cat_levels,
-                                        ord_levels,
-                                        colnames_num,
-                                        colnames_cat,
-                                        colnames_ord,
-                                        min_date,
-                                        min_ts);
-    outp["found_outliers"] = Rcpp::LogicalVector(found_outliers);
+    args_describe_outliers temp = {
+        model_outputs,
+        arr_num_C,
+        INTEGER(arr_cat),
+        INTEGER(arr_ord),
+        &cat_levels,
+        &ord_levels,
+        &colnames_num,
+        &colnames_cat,
+        &colnames_ord,
+        &min_date,
+        &min_ts
+    };
+
+    Rcpp::List outp;
+    try {
+        outp = Rcpp::unwindProtect(describe_outliers_wrapper, (void*)&temp);
+    } catch(...) {
+        forget_row_outputs(*model_outputs);
+        throw;
+    }
     forget_row_outputs(*model_outputs);
+    outp["found_outliers"] = Rcpp::LogicalVector(found_outliers);
     return outp;
 }
 
-// [[Rcpp::export]]
+// [[Rcpp::export(rng = false)]]
 Rcpp::LogicalVector check_few_values(Rcpp::NumericVector arr_num, size_t nrows, size_t ncols, int nthreads)
 {
-    std::vector<char> too_few_vals(ncols, 0);
-    check_more_two_values(&arr_num[0], nrows, ncols, nthreads, too_few_vals.data());
     Rcpp::LogicalVector outp(ncols);
+    std::vector<char> too_few_vals(ncols, 0);
+    check_more_two_values(REAL(arr_num), nrows, ncols, nthreads, too_few_vals.data());
     for (size_t col = 0; col < ncols; col++) {
         outp[col] = (bool) too_few_vals[col];
     }
     return outp;
 }
+
+
+// [[Rcpp::export(rng = false)]]
+bool R_has_openmp()
+{
+    #ifdef _OPENMP
+    return true;
+    #else
+    return false;
+    #endif
+}
+
+#endif /* _FOR_R */

data/vendor/outliertree/src/cat_outlier.cpp

@@ -74,7 +74,7 @@
 */
 void find_outlier_categories(size_t categ_counts[], size_t ncateg, size_t tot, double max_perc_outliers,
                              long double perc_threshold[], size_t buffer_ix[], long double buffer_perc[],
-                             double z_norm, char is_outlier[], bool *found_outliers, bool *new_is_outlier,
+                             double z_norm, signed char is_outlier[], bool *found_outliers, bool *new_is_outlier,
                              double *next_most_comm)
 {
     //TODO: must also establish bounds for new, unseen categories
@@ -90,7 +90,7 @@ void find_outlier_categories(size_t categ_counts[], size_t ncateg, size_t tot, d
     size_t size_tail = 0;
 
     /* reset the temporary arrays and fill them */
-    memset(is_outlier, 0, ncateg * sizeof(char));
+    memset(is_outlier, 0, ncateg * sizeof(signed char));
     for (size_t cat = 0; cat < ncateg; cat++) {
         buffer_ix[cat] = cat;
         buffer_perc[cat] = (categ_counts[cat] > 0)? ((long double)categ_counts[cat] / tot_dbl) : 0;
@@ -225,13 +225,13 @@ void find_outlier_categories(size_t categ_counts[], size_t ncateg, size_t tot, d
 *        Category to which the majority of the observations belong.
 */
 void find_outlier_categories_by_maj(size_t categ_counts[], size_t ncateg, size_t tot, double max_perc_outliers,
-                                    long double prior_prob[], double z_outlier, char is_outlier[],
+                                    long double prior_prob[], double z_outlier, signed char is_outlier[],
                                     bool *found_outliers, bool *new_is_outlier, int *categ_maj)
 {
     /* initialize parameters as needed */
     *found_outliers = false;
     *new_is_outlier = false;
-    memset(is_outlier, 0, ncateg * sizeof(char));
+    memset(is_outlier, 0, ncateg * sizeof(signed char));
     size_t max_outliers = (size_t) calculate_max_outliers((long double)tot, max_perc_outliers);
     long double tot_dbl = (long double) (tot + 1);
     size_t n_non_maj;
@@ -283,7 +283,7 @@ void find_outlier_categories_by_maj(size_t categ_counts[], size_t ncateg, size_t
 *        Proportion of the least common non-outlier category.
 */
 bool find_outlier_categories_no_cond(size_t categ_counts[], size_t ncateg, size_t tot,
-                                     char is_outlier[], double *next_most_comm)
+                                     signed char is_outlier[], double *next_most_comm)
 {
     /* if sample is too small, don't flag any as outliers */
     if (tot < 1000) return false;
@@ -296,7 +296,7 @@ bool find_outlier_categories_no_cond(size_t categ_counts[], size_t ncateg, size_
 
     /* look if there's any category meeting the first condition and none meeting the second one */
     bool has_outlier_cat = false;
-    memset(is_outlier, 0, sizeof(char) * ncateg);
+    memset(is_outlier, 0, sizeof(signed char) * ncateg);
     for (size_t cat = 0; cat < ncateg; cat++) {
         if (categ_counts[cat] > max_outliers && categ_counts[cat] < max_next_most_comm) {
             has_outlier_cat = false;