Correctly set dimnames for matrices

cpp11test/R/cpp11.R

@@ -108,6 +108,18 @@ row_sums <- function(x) {
   .Call(`_cpp11test_row_sums`, x)
 }
 
+mat_mat_copy_dimnames <- function(x) {
+  .Call(`_cpp11test_mat_mat_copy_dimnames`, x)
+}
+
+mat_sexp_copy_dimnames <- function(x) {
+  .Call(`_cpp11test_mat_sexp_copy_dimnames`, x)
+}
+
+mat_mat_create_dimnames <- function() {
+  .Call(`_cpp11test_mat_mat_create_dimnames`)
+}
+
 col_sums <- function(x) {
   .Call(`_cpp11test_col_sums`, x)
 }
@@ -156,34 +168,6 @@ rcpp_release_ <- function(n) {
   invisible(.Call(`_cpp11test_rcpp_release_`, n))
 }
 
-notroxcpp1_ <- function(x) {
-  .Call(`_cpp11test_notroxcpp1_`, x)
-}
-
-roxcpp2_ <- function(x) {
-  .Call(`_cpp11test_roxcpp2_`, x)
-}
-
-roxcpp3_ <- function(x) {
-  .Call(`_cpp11test_roxcpp3_`, x)
-}
-
-roxcpp4_ <- function(x) {
-  .Call(`_cpp11test_roxcpp4_`, x)
-}
-
-roxcpp5_ <- function(x) {
-  .Call(`_cpp11test_roxcpp5_`, x)
-}
-
-notroxcpp6_ <- function(x) {
-  .Call(`_cpp11test_notroxcpp6_`, x)
-}
-
-roxcpp7_ <- function(x) {
-  .Call(`_cpp11test_roxcpp7_`, x)
-}
-
 cpp11_safe_ <- function(x_sxp) {
   .Call(`_cpp11test_cpp11_safe_`, x_sxp)
 }
@@ -196,26 +180,6 @@ string_push_back_ <- function() {
   .Call(`_cpp11test_string_push_back_`)
 }
 
-grow_strings_cpp11_ <- function(n, seed) {
-  .Call(`_cpp11test_grow_strings_cpp11_`, n, seed)
-}
-
-grow_strings_rcpp_ <- function(n, seed) {
-  .Call(`_cpp11test_grow_strings_rcpp_`, n, seed)
-}
-
-grow_strings_manual_ <- function(n, seed) {
-  .Call(`_cpp11test_grow_strings_manual_`, n, seed)
-}
-
-assign_cpp11_ <- function(n, seed) {
-  .Call(`_cpp11test_assign_cpp11_`, n, seed)
-}
-
-assign_rcpp_ <- function(n, seed) {
-  .Call(`_cpp11test_assign_rcpp_`, n, seed)
-}
-
 sum_dbl_for_ <- function(x) {
   .Call(`_cpp11test_sum_dbl_for_`, x)
 }
@@ -284,14 +248,6 @@ rcpp_push_and_truncate_ <- function(size_sxp) {
   .Call(`_cpp11test_rcpp_push_and_truncate_`, size_sxp)
 }
 
-nullable_extptr_1 <- function() {
-  .Call(`_cpp11test_nullable_extptr_1`)
-}
-
-nullable_extptr_2 <- function() {
-  .Call(`_cpp11test_nullable_extptr_2`)
-}
-
 test_destruction_inner <- function() {
   invisible(.Call(`_cpp11test_test_destruction_inner`))
 }

cpp11test/src/cpp11.cpp

@@ -209,6 +209,27 @@ extern "C" SEXP _cpp11test_row_sums(SEXP x) {
   END_CPP11
 }
 // matrix.cpp
+cpp11::doubles_matrix<> mat_mat_copy_dimnames(cpp11::doubles_matrix<> x);
+extern "C" SEXP _cpp11test_mat_mat_copy_dimnames(SEXP x) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(mat_mat_copy_dimnames(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<>>>(x)));
+  END_CPP11
+}
+// matrix.cpp
+SEXP mat_sexp_copy_dimnames(cpp11::doubles_matrix<> x);
+extern "C" SEXP _cpp11test_mat_sexp_copy_dimnames(SEXP x) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(mat_sexp_copy_dimnames(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<>>>(x)));
+  END_CPP11
+}
+// matrix.cpp
+cpp11::doubles_matrix<> mat_mat_create_dimnames();
+extern "C" SEXP _cpp11test_mat_mat_create_dimnames() {
+  BEGIN_CPP11
+    return cpp11::as_sexp(mat_mat_create_dimnames());
+  END_CPP11
+}
+// matrix.cpp
 cpp11::doubles col_sums(cpp11::doubles_matrix<cpp11::by_column> x);
 extern "C" SEXP _cpp11test_col_sums(SEXP x) {
   BEGIN_CPP11
@@ -488,6 +509,9 @@ static const R_CallMethodDef CallEntries[] = {
     {"_cpp11test_gibbs_rcpp",               (DL_FUNC) &_cpp11test_gibbs_rcpp,               2},
     {"_cpp11test_gibbs_rcpp2",              (DL_FUNC) &_cpp11test_gibbs_rcpp2,              2},
     {"_cpp11test_grow_",                    (DL_FUNC) &_cpp11test_grow_,                    1},
+    {"_cpp11test_mat_mat_copy_dimnames",    (DL_FUNC) &_cpp11test_mat_mat_copy_dimnames,    1},
+    {"_cpp11test_mat_mat_create_dimnames",  (DL_FUNC) &_cpp11test_mat_mat_create_dimnames,  0},
+    {"_cpp11test_mat_sexp_copy_dimnames",   (DL_FUNC) &_cpp11test_mat_sexp_copy_dimnames,   1},
     {"_cpp11test_my_message",               (DL_FUNC) &_cpp11test_my_message,               2},
     {"_cpp11test_my_message_n1",            (DL_FUNC) &_cpp11test_my_message_n1,            1},
     {"_cpp11test_my_message_n1fmt",         (DL_FUNC) &_cpp11test_my_message_n1fmt,         1},

cpp11test/src/matrix.cpp

@@ -1,6 +1,8 @@
 #include "cpp11/matrix.hpp"
 #include "Rmath.h"
 #include "cpp11/doubles.hpp"
+#include "cpp11/list.hpp"
+#include "cpp11/strings.hpp"
 using namespace cpp11;
 
 [[cpp11::register]] SEXP gibbs_cpp(int N, int thin) {
@@ -86,6 +88,40 @@ using namespace Rcpp;
   return sums;
 }
 
+[[cpp11::register]] cpp11::doubles_matrix<> mat_mat_copy_dimnames(
+    cpp11::doubles_matrix<> x) {
+  cpp11::writable::doubles_matrix<> out = x;
+
+  out.attr("dimnames") = x.attr("dimnames");
+
+  return out;
+}
+
+[[cpp11::register]] SEXP mat_sexp_copy_dimnames(cpp11::doubles_matrix<> x) {
+  cpp11::writable::doubles_matrix<> out = x;
+
+  out.attr("dimnames") = x.attr("dimnames");
+
+  return out;
+}
+
+[[cpp11::register]] cpp11::doubles_matrix<> mat_mat_create_dimnames() {
+  cpp11::writable::doubles_matrix<> out(2, 2);
+
+  out(0, 0) = 1;
+  out(0, 1) = 2;
+  out(1, 0) = 3;
+  out(1, 1) = 4;
+
+  cpp11::writable::list dimnames(2);
+  dimnames[0] = cpp11::strings({"a", "b"});
+  dimnames[1] = cpp11::strings({"c", "d"});
+
+  out.attr("dimnames") = dimnames;
+
+  return out;
+}
+
 [[cpp11::register]] cpp11::doubles col_sums(cpp11::doubles_matrix<cpp11::by_column> x) {
   cpp11::writable::doubles sums(x.ncol());
 

cpp11test/tests/testthat/test-matrix.R

@@ -23,3 +23,19 @@ test_that("col_sums gives same result as colSums", {
   y[3, ] <- NA;
   expect_equal(col_sums(y), colSums(y))
 })
+
+test_that("doubles_matrix<> can return a matrix with colnames and rownames", {
+  x <- matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2)
+  colnames(x) <- letters[1:2]
+  rownames(x) <- letters[3:4]
+
+  y <- mat_mat_copy_dimnames(x)
+  z <- mat_sexp_copy_dimnames(x)
+
+  expect_equal(x, y)
+  expect_equal(x, z)
+
+  r <- mat_mat_create_dimnames()
+  expect_equal(rownames(r), c("a", "b"))
+  expect_equal(colnames(r), c("c", "d"))
+})