implement @stephematician suggestion

r-lib · Dec 28, 2024 · 814b408 · 814b408
1 parent b919f41
commit 814b408
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 36 deletions.
diff --git a/cpp11test/R/cpp11.R b/cpp11test/R/cpp11.R
@@ -112,12 +112,16 @@ col_sums <- function(x) {
   .Call(`_cpp11test_col_sums`, x)
 }
 
-log_mat_mat <- function(x) {
-  .Call(`_cpp11test_log_mat_mat`, x)
+mat_mat_copy_dimnames <- function(x) {
+  .Call(`_cpp11test_mat_mat_copy_dimnames`, x)
 }
 
-log_mat_sexp <- function(x) {
-  .Call(`_cpp11test_log_mat_sexp`, 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`)
 }
 
 protect_one_ <- function(x, n) {

diff --git a/cpp11test/src/cpp11.cpp b/cpp11test/src/cpp11.cpp
@@ -216,17 +216,24 @@ extern "C" SEXP _cpp11test_col_sums(SEXP x) {
   END_CPP11
 }
 // matrix.cpp
-cpp11::doubles_matrix<> log_mat_mat(cpp11::doubles_matrix<> x);
-extern "C" SEXP _cpp11test_log_mat_mat(SEXP x) {
+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(log_mat_mat(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<>>>(x)));
+    return cpp11::as_sexp(mat_mat_copy_dimnames(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<>>>(x)));
   END_CPP11
 }
 // matrix.cpp
-SEXP log_mat_sexp(cpp11::doubles_matrix<> x);
-extern "C" SEXP _cpp11test_log_mat_sexp(SEXP x) {
+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(log_mat_sexp(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<>>>(x)));
+    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
 }
 // protect.cpp
@@ -502,8 +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_log_mat_mat",              (DL_FUNC) &_cpp11test_log_mat_mat,              1},
-    {"_cpp11test_log_mat_sexp",             (DL_FUNC) &_cpp11test_log_mat_sexp,             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},

diff --git a/cpp11test/src/matrix.cpp b/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) {
@@ -105,34 +107,22 @@ using namespace Rcpp;
   return sums;
 }
 
-[[cpp11::register]] cpp11::doubles_matrix<> log_mat_mat(cpp11::doubles_matrix<> x) {
-  cpp11::writable::doubles_matrix<> out(x.nrow(), x.ncol());
-
-  for (int i = 0; i < x.nrow(); i++) {
-    for (int j = 0; j < x.ncol(); j++) {
-      out(i, j) = log(x(i, j));
-    }
-  }
+[[cpp11::register]] cpp11::doubles_matrix<> mat_mat_copy_dimnames(
+    cpp11::doubles_matrix<> x) {
+  cpp11::writable::doubles_matrix<> out = x;
 
   // SEXP dimnames = x.attr("dimnames");
   // if (dimnames != R_NilValue) {
   //   Rf_setAttrib(out.data(), R_DimNamesSymbol, dimnames);
-  //   std::cout << "dimnames set successfully" << std::endl;
   // }
 
   out.attr("dimnames") = x.attr("dimnames");
 
   return out;
 }
 
-[[cpp11::register]] SEXP log_mat_sexp(cpp11::doubles_matrix<> x) {
-  cpp11::writable::doubles_matrix<> out(x.nrow(), x.ncol());
-
-  for (int i = 0; i < x.nrow(); i++) {
-    for (int j = 0; j < x.ncol(); j++) {
-      out(i, j) = log(x(i, j));
-    }
-  }
+[[cpp11::register]] SEXP mat_sexp_copy_dimnames(cpp11::doubles_matrix<> x) {
+  cpp11::writable::doubles_matrix<> out = x;
 
   // SEXP dimnames = x.attr("dimnames");
   // if (dimnames != R_NilValue) {
@@ -143,3 +133,20 @@ using namespace Rcpp;
 
   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;
+}
diff --git a/cpp11test/tests/testthat/test-matrix.R b/cpp11test/tests/testthat/test-matrix.R
@@ -24,15 +24,18 @@ test_that("col_sums gives same result as colSums", {
   expect_equal(col_sums(y), colSums(y))
 })
 
-test_that("log_mat_mat returns a matrix with colnames and rownames", {
+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 <- log_mat_mat(x)
-  z <- log_mat_sexp(x)
-  r <- log(x)
-
-  expect_equal(y, r)
-  expect_equal(z, r)
+  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"))
 })