fix #273

Author: pachadotdev

cpp11test/R/cpp11.R

@@ -112,6 +112,14 @@ col_sums <- function(x) {
   .Call(`_cpp11test_col_sums`, x)
 }
 
+log_mat_mat <- function(x) {
+  .Call(`_cpp11test_log_mat_mat`, x)
+}
+
+log_mat_sexp <- function(x) {
+  .Call(`_cpp11test_log_mat_sexp`, x)
+}
+
 protect_one_ <- function(x, n) {
   invisible(.Call(`_cpp11test_protect_one_`, x, n))
 }

cpp11test/src/cpp11.cpp

@@ -215,6 +215,20 @@ extern "C" SEXP _cpp11test_col_sums(SEXP x) {
     return cpp11::as_sexp(col_sums(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<cpp11::by_column>>>(x)));
   END_CPP11
 }
+// matrix.cpp
+cpp11::doubles_matrix<> log_mat_mat(cpp11::doubles_matrix<> x);
+extern "C" SEXP _cpp11test_log_mat_mat(SEXP x) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(log_mat_mat(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) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(log_mat_sexp(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<>>>(x)));
+  END_CPP11
+}
 // protect.cpp
 void protect_one_(SEXP x, int n);
 extern "C" SEXP _cpp11test_protect_one_(SEXP x, SEXP n) {
@@ -488,6 +502,8 @@ 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_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

@@ -104,3 +104,42 @@ 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));
+    }
+  }
+
+  // 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));
+    }
+  }
+
+  // SEXP dimnames = x.attr("dimnames");
+  // if (dimnames != R_NilValue) {
+  //   Rf_setAttrib(out.data(), R_DimNamesSymbol, dimnames);
+  // }
+
+  out.attr("dimnames") = x.attr("dimnames");
+
+  return out;
+}

cpp11test/tests/testthat/test-matrix.R

@@ -23,3 +23,16 @@ test_that("col_sums gives same result as colSums", {
   y[3, ] <- NA;
   expect_equal(col_sums(y), colSums(y))
 })
+
+test_that("log_mat_mat returns 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)
+})

inst/include/cpp11/matrix.hpp

@@ -1,5 +1,6 @@
 #pragma once
 
+#include <initializer_list>  // for initializer_list
 #include <iterator>
 #include <string>  // for string
 
@@ -188,13 +189,47 @@ class matrix : public matrix_slices<S> {
 
   operator SEXP() const { return SEXP(vector_); }
 
-  // operator sexp() { return sexp(vector_); }
+  auto attr(const char* name) { return vector_.attr(name); }
 
-  sexp attr(const char* name) const { return SEXP(vector_.attr(name)); }
+  auto attr(const std::string& name) { return vector_.attr(name); }
 
-  sexp attr(const std::string& name) const { return SEXP(vector_.attr(name)); }
+  auto attr(SEXP name) { return vector_.attr(name); }
 
-  sexp attr(SEXP name) const { return SEXP(vector_.attr(name)); }
+  void attr(const char* name, SEXP value) { vector_.attr(name) = value; }
+
+  void attr(const std::string& name, SEXP value) { vector_.attr(name) = value; }
+
+  void attr(SEXP name, SEXP value) { vector_.attr(name) = value; }
+
+  void attr(const char* name, std::initializer_list<SEXP> value) {
+    SEXP attr = PROTECT(Rf_allocVector(VECSXP, value.size()));
+    int i = 0;
+    for (SEXP v : value) {
+      SET_VECTOR_ELT(attr, i++, v);
+    }
+    vector_.attr(name) = attr;
+    UNPROTECT(1);
+  }
+
+  void attr(const std::string& name, std::initializer_list<SEXP> value) {
+    SEXP attr = PROTECT(Rf_allocVector(VECSXP, value.size()));
+    int i = 0;
+    for (SEXP v : value) {
+      SET_VECTOR_ELT(attr, i++, v);
+    }
+    vector_.attr(name) = attr;
+    UNPROTECT(1);
+  }
+
+  void attr(SEXP name, std::initializer_list<SEXP> value) {
+    SEXP attr = PROTECT(Rf_allocVector(VECSXP, value.size()));
+    int i = 0;
+    for (SEXP v : value) {
+      SET_VECTOR_ELT(attr, i++, v);
+    }
+    vector_.attr(name) = attr;
+    UNPROTECT(1);
+  }
 
   r_vector<r_string> names() const { return r_vector<r_string>(vector_.names()); }