From f7383a081e32883cc0fc75886d8d635720d1b748 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 04:42:21 -0500 Subject: [PATCH 1/7] fix #273 --- cpp11test/R/cpp11.R | 8 +++++ cpp11test/src/cpp11.cpp | 16 ++++++++++ cpp11test/src/matrix.cpp | 39 +++++++++++++++++++++++ cpp11test/tests/testthat/test-matrix.R | 13 ++++++++ inst/include/cpp11/matrix.hpp | 43 +++++++++++++++++++++++--- 5 files changed, 115 insertions(+), 4 deletions(-) diff --git a/cpp11test/R/cpp11.R b/cpp11test/R/cpp11.R index 038e7b76..a4222108 100644 --- a/cpp11test/R/cpp11.R +++ b/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)) } diff --git a/cpp11test/src/cpp11.cpp b/cpp11test/src/cpp11.cpp index 421de637..a9a2f674 100644 --- a/cpp11test/src/cpp11.cpp +++ b/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>>(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>>(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>>(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}, diff --git a/cpp11test/src/matrix.cpp b/cpp11test/src/matrix.cpp index 10348945..57cc7c38 100644 --- a/cpp11test/src/matrix.cpp +++ b/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; +} diff --git a/cpp11test/tests/testthat/test-matrix.R b/cpp11test/tests/testthat/test-matrix.R index a43f59b0..de1a346f 100644 --- a/cpp11test/tests/testthat/test-matrix.R +++ b/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) +}) diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 8345068f..99de0ed4 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -1,5 +1,6 @@ #pragma once +#include // for initializer_list #include #include // for string @@ -188,13 +189,47 @@ class matrix : public matrix_slices { 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 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 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 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 names() const { return r_vector(vector_.names()); } From 73231a58e79925f4564047ccf02a37caca3f9fa4 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 04:49:35 -0500 Subject: [PATCH 2/7] use sexp instead of auto for C++ older than 14 --- inst/include/cpp11/matrix.hpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 99de0ed4..b7545ae7 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -189,11 +189,11 @@ class matrix : public matrix_slices { operator SEXP() const { return SEXP(vector_); } - auto attr(const char* name) { return vector_.attr(name); } + sexp attr(const char* name) { return vector_.attr(name); } - auto attr(const std::string& name) { return vector_.attr(name); } + sexp attr(const std::string& name) { return vector_.attr(name); } - auto attr(SEXP name) { return vector_.attr(name); } + sexp attr(SEXP name) { return vector_.attr(name); } void attr(const char* name, SEXP value) { vector_.attr(name) = value; } From 812e6cead6072e87b8c801cbdb4ca0cd1dca1025 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 04:55:20 -0500 Subject: [PATCH 3/7] replace auto with attribute_proxy --- inst/include/cpp11/matrix.hpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index b7545ae7..25f772a4 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -189,11 +189,11 @@ class matrix : public matrix_slices { operator SEXP() const { return SEXP(vector_); } - sexp attr(const char* name) { return vector_.attr(name); } + attribute_proxy attr(const char* name) { return vector_.attr(name); } - sexp attr(const std::string& name) { return vector_.attr(name); } + attribute_proxy attr(const std::string& name) { return vector_.attr(name); } - sexp attr(SEXP name) { return vector_.attr(name); } + attribute_proxy attr(SEXP name) { return vector_.attr(name); } void attr(const char* name, SEXP value) { vector_.attr(name) = value; } From 5217ded5071e7656e4e66a0fb235c9558614a1e3 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 04:59:15 -0500 Subject: [PATCH 4/7] use SEXP --- inst/include/cpp11/matrix.hpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 25f772a4..4b7e6ac6 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -189,11 +189,11 @@ class matrix : public matrix_slices { operator SEXP() const { return SEXP(vector_); } - attribute_proxy attr(const char* name) { return vector_.attr(name); } + SEXP attr(const char* name) { return vector_.attr(name); } - attribute_proxy attr(const std::string& name) { return vector_.attr(name); } + SEXP attr(const std::string& name) { return vector_.attr(name); } - attribute_proxy attr(SEXP name) { return vector_.attr(name); } + SEXP attr(SEXP name) { return vector_.attr(name); } void attr(const char* name, SEXP value) { vector_.attr(name) = value; } From 1b51d23341c48ada84fa9af4129819a9cf5e1810 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 12:16:14 -0500 Subject: [PATCH 5/7] test again --- inst/include/cpp11/matrix.hpp | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 4b7e6ac6..5ae956a1 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -4,11 +4,12 @@ #include #include // for string -#include "cpp11/R.hpp" // for SEXP, SEXPREC, R_xlen_t, INT... -#include "cpp11/r_bool.hpp" // for r_bool -#include "cpp11/r_string.hpp" // for r_string -#include "cpp11/r_vector.hpp" // for r_vector -#include "cpp11/sexp.hpp" // for sexp +#include "cpp11/R.hpp" // for SEXP, SEXPREC, R_xlen_t, INT... +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/r_bool.hpp" // for r_bool +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { @@ -189,11 +190,11 @@ class matrix : public matrix_slices { operator SEXP() const { return SEXP(vector_); } - SEXP attr(const char* name) { return vector_.attr(name); } + attribute_proxy attr(const char* name) { return vector_.attr(name); } - SEXP attr(const std::string& name) { return vector_.attr(name); } + attribute_proxy attr(const std::string& name) { return vector_.attr(name); } - SEXP attr(SEXP name) { return vector_.attr(name); } + attribute_proxy attr(SEXP name) { return vector_.attr(name); } void attr(const char* name, SEXP value) { vector_.attr(name) = value; } From b919f413d3f4ceb3f26f4f07587ea418ff4c2505 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 12:37:02 -0500 Subject: [PATCH 6/7] try to fix build error on gh actions --- inst/include/cpp11/matrix.hpp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 5ae956a1..92113d50 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -190,11 +190,13 @@ class matrix : public matrix_slices { operator SEXP() const { return SEXP(vector_); } - attribute_proxy attr(const char* name) { return vector_.attr(name); } + attribute_proxy attr(const char* name) { return attribute_proxy(vector_, name); } - attribute_proxy attr(const std::string& name) { return vector_.attr(name); } + attribute_proxy attr(const std::string& name) { + return attribute_proxy(vector_, name.c_str()); + } - attribute_proxy attr(SEXP name) { return vector_.attr(name); } + attribute_proxy attr(SEXP name) { return attribute_proxy(vector_, name); } void attr(const char* name, SEXP value) { vector_.attr(name) = value; } From 814b40870d91eb6b9151ddcd1386f38da858374b Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Sat, 28 Dec 2024 01:39:43 -0500 Subject: [PATCH 7/7] implement @stephematician suggestion --- cpp11test/R/cpp11.R | 12 +++++--- cpp11test/src/cpp11.cpp | 24 ++++++++++----- cpp11test/src/matrix.cpp | 41 +++++++++++++++----------- cpp11test/tests/testthat/test-matrix.R | 17 ++++++----- 4 files changed, 58 insertions(+), 36 deletions(-) diff --git a/cpp11test/R/cpp11.R b/cpp11test/R/cpp11.R index a4222108..93804a44 100644 --- 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 index a9a2f674..32487473 100644 --- 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>>(x))); + return cpp11::as_sexp(mat_mat_copy_dimnames(cpp11::as_cpp>>(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>>(x))); + return cpp11::as_sexp(mat_sexp_copy_dimnames(cpp11::as_cpp>>(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 index 57cc7c38..a875d73d 100644 --- 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,19 +107,13 @@ 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"); @@ -125,14 +121,8 @@ using namespace Rcpp; 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 index de1a346f..942d5ed8 100644 --- 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")) })