ordered and unordered C++ maps are converted to R lists - replaces r-lib#437

Author: pachadotdev

cpp11test/R/cpp11.R

@@ -88,6 +88,14 @@ cpp11_insert_ <- function(num_sxp) {
   .Call(`_cpp11test_cpp11_insert_`, num_sxp)
 }
 
+ordered_map_to_list_ <- function(x) {
+  .Call(`_cpp11test_ordered_map_to_list_`, x)
+}
+
+unordered_map_to_list_ <- function(x) {
+  .Call(`_cpp11test_unordered_map_to_list_`, x)
+}
+
 gibbs_cpp <- function(N, thin) {
   .Call(`_cpp11test_gibbs_cpp`, N, thin)
 }

cpp11test/src/cpp11.cpp

@@ -173,6 +173,20 @@ extern "C" SEXP _cpp11test_cpp11_insert_(SEXP num_sxp) {
     return cpp11::as_sexp(cpp11_insert_(cpp11::as_cpp<cpp11::decay_t<SEXP>>(num_sxp)));
   END_CPP11
 }
+// map.cpp
+SEXP ordered_map_to_list_(cpp11::doubles x);
+extern "C" SEXP _cpp11test_ordered_map_to_list_(SEXP x) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(ordered_map_to_list_(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles>>(x)));
+  END_CPP11
+}
+// map.cpp
+SEXP unordered_map_to_list_(cpp11::doubles x);
+extern "C" SEXP _cpp11test_unordered_map_to_list_(SEXP x) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(unordered_map_to_list_(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles>>(x)));
+  END_CPP11
+}
 // matrix.cpp
 SEXP gibbs_cpp(int N, int thin);
 extern "C" SEXP _cpp11test_gibbs_cpp(SEXP N, SEXP thin) {
@@ -500,6 +514,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_cpp11test_my_warning_n1",            (DL_FUNC) &_cpp11test_my_warning_n1,            1},
     {"_cpp11test_my_warning_n1fmt",         (DL_FUNC) &_cpp11test_my_warning_n1fmt,         1},
     {"_cpp11test_my_warning_n2fmt",         (DL_FUNC) &_cpp11test_my_warning_n2fmt,         2},
+    {"_cpp11test_ordered_map_to_list_",     (DL_FUNC) &_cpp11test_ordered_map_to_list_,     1},
     {"_cpp11test_protect_many_",            (DL_FUNC) &_cpp11test_protect_many_,            1},
     {"_cpp11test_protect_many_cpp11_",      (DL_FUNC) &_cpp11test_protect_many_cpp11_,      1},
     {"_cpp11test_protect_many_preserve_",   (DL_FUNC) &_cpp11test_protect_many_preserve_,   1},
@@ -533,6 +548,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_cpp11test_sum_int_foreach_",         (DL_FUNC) &_cpp11test_sum_int_foreach_,         1},
     {"_cpp11test_test_destruction_inner",   (DL_FUNC) &_cpp11test_test_destruction_inner,   0},
     {"_cpp11test_test_destruction_outer",   (DL_FUNC) &_cpp11test_test_destruction_outer,   0},
+    {"_cpp11test_unordered_map_to_list_",   (DL_FUNC) &_cpp11test_unordered_map_to_list_,   1},
     {"_cpp11test_upper_bound",              (DL_FUNC) &_cpp11test_upper_bound,              2},
     {"run_testthat_tests",                  (DL_FUNC) &run_testthat_tests,                  1},
     {NULL, NULL, 0}

cpp11test/src/map.cpp

@@ -0,0 +1,20 @@
+#include "cpp11/as.hpp"
+#include "cpp11/doubles.hpp"
+
+[[cpp11::register]] SEXP ordered_map_to_list_(cpp11::doubles x) {
+  std::map<double, int> counts;
+  int n = x.size();
+  for (int i = 0; i < n; i++) {
+    counts[x[i]]++;
+  }
+  return cpp11::as_sexp(counts);
+}
+
+[[cpp11::register]] SEXP unordered_map_to_list_(cpp11::doubles x) {
+  std::unordered_map<double, int> counts;
+  int n = x.size();
+  for (int i = 0; i < n; i++) {
+    counts[x[i]]++;
+  }
+  return cpp11::as_sexp(counts);
+}

cpp11test/tests/testthat/test-map-to-list.R

@@ -0,0 +1,18 @@
+test_that("ordered and unordered C++ maps are converted to R lists", {
+  set.seed(42L)
+  x <- rnorm(10L)
+  xprime <- c(x, x[1])
+
+  om <- ordered_map_to_list_(x)
+  expect_type(om, "list")
+
+  om_doubles <- as.double(names(om))
+  expect_equal(om_doubles, sort(om_doubles))
+
+  omprime <- ordered_map_to_list_(xprime)
+  expect_equal(unlist(unique(omprime)), 1:2)
+
+  um <- unordered_map_to_list_(xprime)
+  expect_type(um, "list")
+  expect_equal(unlist(unique(um)), 1:2)
+})

inst/include/cpp11/as.hpp

@@ -2,10 +2,13 @@
 
 #include <cmath>             // for modf
 #include <initializer_list>  // for initializer_list
+#include <map>               // for std::map
 #include <memory>            // for std::shared_ptr, std::weak_ptr, std::unique_ptr
 #include <stdexcept>
-#include <string>       // for string, basic_string
-#include <type_traits>  // for decay, enable_if, is_same, is_convertible
+#include <string>         // for string, basic_string
+#include <type_traits>    // for decay, enable_if, is_same, is_convertible
+#include <unordered_map>  // for std::unordered_map
+#include <vector>         // for std::vector
 
 #include "cpp11/R.hpp"        // for SEXP, SEXPREC, Rf_xlength, R_xlen_t
 #include "cpp11/protect.hpp"  // for stop, protect, safe, protect::function
@@ -243,7 +246,7 @@ enable_if_integral<T, SEXP> as_sexp(const Container& from) {
 }
 
 inline SEXP as_sexp(std::initializer_list<int> from) {
-  return as_sexp<std::initializer_list<int>>(from);
+  return as_sexp(std::vector<int>(from));
 }
 
 template <typename Container, typename T = typename Container::value_type,
@@ -261,7 +264,7 @@ enable_if_floating_point<T, SEXP> as_sexp(const Container& from) {
 }
 
 inline SEXP as_sexp(std::initializer_list<double> from) {
-  return as_sexp<std::initializer_list<double>>(from);
+  return as_sexp(std::vector<double>(from));
 }
 
 template <typename Container, typename T = typename Container::value_type,
@@ -279,7 +282,7 @@ enable_if_bool<T, SEXP> as_sexp(const Container& from) {
 }
 
 inline SEXP as_sexp(std::initializer_list<bool> from) {
-  return as_sexp<std::initializer_list<bool>>(from);
+  return as_sexp(std::vector<bool>(from));
 }
 
 namespace detail {
@@ -325,12 +328,81 @@ enable_if_c_string<T, SEXP> as_sexp(const Container& from) {
 }
 
 inline SEXP as_sexp(std::initializer_list<const char*> from) {
-  return as_sexp<std::initializer_list<const char*>>(from);
+  return as_sexp(std::vector<const char*>(from));
 }
 
 template <typename T, typename = disable_if_r_string<T>>
 enable_if_convertible_to_sexp<T, SEXP> as_sexp(const T& from) {
   return from;
 }
 
+// Pacha: Specialization for std::map
+// NOTE: I did not use templates to avoid clashes with doubles/function/etc.
+inline SEXP as_sexp(const std::map<std::string, SEXP>& map) {
+  R_xlen_t size = map.size();
+  SEXP result = PROTECT(Rf_allocVector(VECSXP, size));
+  SEXP names = PROTECT(Rf_allocVector(STRSXP, size));
+
+  auto it = map.begin();
+  for (R_xlen_t i = 0; i < size; ++i, ++it) {
+    SET_VECTOR_ELT(result, i, it->second);
+    SET_STRING_ELT(names, i, Rf_mkCharCE(it->first.c_str(), CE_UTF8));
+  }
+
+  Rf_setAttrib(result, R_NamesSymbol, names);
+  UNPROTECT(2);
+  return result;
+}
+
+// Specialization for std::map<double, int>
+inline SEXP as_sexp(const std::map<double, int>& map) {
+  R_xlen_t size = map.size();
+  SEXP result = PROTECT(Rf_allocVector(VECSXP, size));
+  SEXP names = PROTECT(Rf_allocVector(REALSXP, size));
+
+  auto it = map.begin();
+  for (R_xlen_t i = 0; i < size; ++i, ++it) {
+    SET_VECTOR_ELT(result, i, Rf_ScalarInteger(it->second));
+    REAL(names)[i] = it->first;
+  }
+
+  Rf_setAttrib(result, R_NamesSymbol, names);
+  UNPROTECT(2);
+  return result;
+}
+
+// Pacha: Specialization for std::unordered_map
+inline SEXP as_sexp(const std::unordered_map<std::string, SEXP>& map) {
+  R_xlen_t size = map.size();
+  SEXP result = PROTECT(Rf_allocVector(VECSXP, size));
+  SEXP names = PROTECT(Rf_allocVector(STRSXP, size));
+
+  auto it = map.begin();
+  for (R_xlen_t i = 0; i < size; ++i, ++it) {
+    SET_VECTOR_ELT(result, i, it->second);
+    SET_STRING_ELT(names, i, Rf_mkCharCE(it->first.c_str(), CE_UTF8));
+  }
+
+  Rf_setAttrib(result, R_NamesSymbol, names);
+  UNPROTECT(2);
+  return result;
+}
+
+// Specialization for std::unordered_map<double, int>
+inline SEXP as_sexp(const std::unordered_map<double, int>& map) {
+  R_xlen_t size = map.size();
+  SEXP result = PROTECT(Rf_allocVector(VECSXP, size));
+  SEXP names = PROTECT(Rf_allocVector(REALSXP, size));
+
+  auto it = map.begin();
+  for (R_xlen_t i = 0; i < size; ++i, ++it) {
+    SET_VECTOR_ELT(result, i, Rf_ScalarInteger(it->second));
+    REAL(names)[i] = it->first;
+  }
+
+  Rf_setAttrib(result, R_NamesSymbol, names);
+  UNPROTECT(2);
+  return result;
+}
+
 }  // namespace cpp11