From b1d8858ae8128550d74b1dd53122da16ce30d2cd Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 20 Dec 2024 02:44:30 -0500 Subject: [PATCH 01/14] almost complete implementation of r_complex --- DESCRIPTION | 2 +- cpp11test/DESCRIPTION | 2 +- cpp11test/R/cpp11.R | 24 ++ cpp11test/src/cpp11.cpp | 48 +++ cpp11test/src/sum.cpp | 75 ++++ cpp11test/src/test-complex.cpp | 500 ++++++++++++++++++++++++ cpp11test/src/test-r_complex.cpp | 94 +++++ cpp11test/tests/testthat/test-complex.R | 38 ++ inst/include/cpp11.hpp | 2 + inst/include/cpp11/complexes.hpp | 182 +++++++++ inst/include/cpp11/matrix.hpp | 15 +- inst/include/cpp11/r_complex.hpp | 143 +++++++ inst/include/cpp11/sexp.hpp | 11 + 13 files changed, 1129 insertions(+), 7 deletions(-) create mode 100644 cpp11test/src/test-complex.cpp create mode 100644 cpp11test/src/test-r_complex.cpp create mode 100644 cpp11test/tests/testthat/test-complex.R create mode 100644 inst/include/cpp11/complexes.hpp create mode 100644 inst/include/cpp11/r_complex.hpp diff --git a/DESCRIPTION b/DESCRIPTION index 7a418560..c14125a9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cpp11 Title: A C++11 Interface for R's C Interface -Version: 0.5.1.9000 +Version: 0.6.0.9000 Authors@R: c( person("Davis", "Vaughan", email = "davis@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4777-038X")), diff --git a/cpp11test/DESCRIPTION b/cpp11test/DESCRIPTION index d1d05665..70c5649f 100644 --- a/cpp11test/DESCRIPTION +++ b/cpp11test/DESCRIPTION @@ -20,4 +20,4 @@ Suggests: xml2 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.1.1 +RoxygenNote: 7.3.2 diff --git a/cpp11test/R/cpp11.R b/cpp11test/R/cpp11.R index 038e7b76..8ea7cd42 100644 --- a/cpp11test/R/cpp11.R +++ b/cpp11test/R/cpp11.R @@ -196,6 +196,30 @@ sum_dbl_accumulate2_ <- function(x_sxp) { .Call(`_cpp11test_sum_dbl_accumulate2_`, x_sxp) } +sum_cplx_for_ <- function(x) { + .Call(`_cpp11test_sum_cplx_for_`, x) +} + +sum_cplx_for_2_ <- function(x) { + .Call(`_cpp11test_sum_cplx_for_2_`, x) +} + +sum_cplx_for_3_ <- function(x_sxp) { + .Call(`_cpp11test_sum_cplx_for_3_`, x_sxp) +} + +sum_cplx_for_4_ <- function(x_sxp) { + .Call(`_cpp11test_sum_cplx_for_4_`, x_sxp) +} + +sum_cplx_for_5_ <- function(x_sxp) { + .Call(`_cpp11test_sum_cplx_for_5_`, x_sxp) +} + +sum_cplx_for_6_ <- function(x_sxp) { + .Call(`_cpp11test_sum_cplx_for_6_`, x_sxp) +} + sum_int_for_ <- function(x) { .Call(`_cpp11test_sum_int_for_`, x) } diff --git a/cpp11test/src/cpp11.cpp b/cpp11test/src/cpp11.cpp index 421de637..7b858ddc 100644 --- a/cpp11test/src/cpp11.cpp +++ b/cpp11test/src/cpp11.cpp @@ -373,6 +373,48 @@ extern "C" SEXP _cpp11test_sum_dbl_accumulate2_(SEXP x_sxp) { return cpp11::as_sexp(sum_dbl_accumulate2_(cpp11::as_cpp>(x_sxp))); END_CPP11 } +// sum.cpp +cpp11::r_complex sum_cplx_for_(cpp11::complexes x); +extern "C" SEXP _cpp11test_sum_cplx_for_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for_(cpp11::as_cpp>(x))); + END_CPP11 +} +// sum.cpp +cpp11::complexes sum_cplx_for_2_(cpp11::complexes x); +extern "C" SEXP _cpp11test_sum_cplx_for_2_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for_2_(cpp11::as_cpp>(x))); + END_CPP11 +} +// sum.cpp +std::complex sum_cplx_for_3_(cpp11::complexes x_sxp); +extern "C" SEXP _cpp11test_sum_cplx_for_3_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for_3_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} +// sum.cpp +std::complex sum_cplx_for_4_(SEXP x_sxp); +extern "C" SEXP _cpp11test_sum_cplx_for_4_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for_4_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} +// sum.cpp +SEXP sum_cplx_for_5_(SEXP x_sxp); +extern "C" SEXP _cpp11test_sum_cplx_for_5_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for_5_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} +// sum.cpp +cpp11::complexes sum_cplx_for_6_(SEXP x_sxp); +extern "C" SEXP _cpp11test_sum_cplx_for_6_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for_6_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} // sum_int.cpp double sum_int_for_(cpp11::integers x); extern "C" SEXP _cpp11test_sum_int_for_(SEXP x) { @@ -520,6 +562,12 @@ static const R_CallMethodDef CallEntries[] = { {"_cpp11test_row_sums", (DL_FUNC) &_cpp11test_row_sums, 1}, {"_cpp11test_string_proxy_assignment_", (DL_FUNC) &_cpp11test_string_proxy_assignment_, 0}, {"_cpp11test_string_push_back_", (DL_FUNC) &_cpp11test_string_push_back_, 0}, + {"_cpp11test_sum_cplx_for_", (DL_FUNC) &_cpp11test_sum_cplx_for_, 1}, + {"_cpp11test_sum_cplx_for_2_", (DL_FUNC) &_cpp11test_sum_cplx_for_2_, 1}, + {"_cpp11test_sum_cplx_for_3_", (DL_FUNC) &_cpp11test_sum_cplx_for_3_, 1}, + {"_cpp11test_sum_cplx_for_4_", (DL_FUNC) &_cpp11test_sum_cplx_for_4_, 1}, + {"_cpp11test_sum_cplx_for_5_", (DL_FUNC) &_cpp11test_sum_cplx_for_5_, 1}, + {"_cpp11test_sum_cplx_for_6_", (DL_FUNC) &_cpp11test_sum_cplx_for_6_, 1}, {"_cpp11test_sum_dbl_accumulate2_", (DL_FUNC) &_cpp11test_sum_dbl_accumulate2_, 1}, {"_cpp11test_sum_dbl_accumulate_", (DL_FUNC) &_cpp11test_sum_dbl_accumulate_, 1}, {"_cpp11test_sum_dbl_for2_", (DL_FUNC) &_cpp11test_sum_dbl_for2_, 1}, diff --git a/cpp11test/src/sum.cpp b/cpp11test/src/sum.cpp index e685c7d1..0cc08848 100644 --- a/cpp11test/src/sum.cpp +++ b/cpp11test/src/sum.cpp @@ -1,4 +1,5 @@ #include +#include "cpp11/complexes.hpp" #include "cpp11/doubles.hpp" [[cpp11::register]] double sum_dbl_for_(cpp11::doubles x) { @@ -58,3 +59,77 @@ const cpp11::doubles x(x_sxp, false); return std::accumulate(x.cbegin(), x.cend(), 0.); } + +// Functions for complex data type + +[[cpp11::register]] cpp11::r_complex sum_cplx_for_(cpp11::complexes x) { + std::complex sum = {0.0, 0.0}; + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum.real(sum.real() + x[i].real()); + sum.imag(sum.imag() + x[i].imag()); + } + + return cpp11::r_complex(sum.real(), sum.imag()); +} + +[[cpp11::register]] cpp11::complexes sum_cplx_for_2_(cpp11::complexes x) { + std::complex sum = {0.0, 0.0}; + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum.real(sum.real() + x[i].real()); + sum.imag(sum.imag() + x[i].imag()); + } + + cpp11::writable::complexes result(1); + result[0] = cpp11::r_complex(sum.real(), sum.imag()); + return result; +} + +[[cpp11::register]] std::complex sum_cplx_for_3_(cpp11::complexes x_sxp) { + std::complex sum = {0.0, 0.0}; + const cpp11::complexes x(x_sxp, false); + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum.real(sum.real() + x[i].real()); + sum.imag(sum.imag() + x[i].imag()); + } + + return sum; +} + +[[cpp11::register]] std::complex sum_cplx_for_4_(SEXP x_sxp) { + std::complex sum = {0.0, 0.0}; + const cpp11::complexes x(x_sxp, false); + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum.real(sum.real() + x[i].real()); + sum.imag(sum.imag() + x[i].imag()); + } + + return sum; +} + +[[cpp11::register]] SEXP sum_cplx_for_5_(SEXP x_sxp) { + std::complex sum = {0.0, 0.0}; + const cpp11::complexes x(x_sxp, false); + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum.real(sum.real() + x[i].real()); + sum.imag(sum.imag() + x[i].imag()); + } + + return cpp11::as_sexp(sum); +} + +[[cpp11::register]] cpp11::complexes sum_cplx_for_6_(SEXP x_sxp) { + std::complex sum = {0.0, 0.0}; + const cpp11::complexes x(x_sxp, false); + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum.real(sum.real() + x[i].real()); + sum.imag(sum.imag() + x[i].imag()); + } + + return cpp11::as_sexp(sum); +} diff --git a/cpp11test/src/test-complex.cpp b/cpp11test/src/test-complex.cpp new file mode 100644 index 00000000..21bf174b --- /dev/null +++ b/cpp11test/src/test-complex.cpp @@ -0,0 +1,500 @@ +#include "cpp11/complexes.hpp" + +#include "cpp11/strings.hpp" + +#include + +context("complexes-C++") { + test_that("complexes::r_vector(SEXP)") { + cpp11::complexes x(Rf_allocVector(CPLXSXP, 2)); + expect_true(x.size() == 2); + + expect_error(cpp11::complexes(Rf_allocVector(INTSXP, 2))); + } + + test_that("complexes::r_vector::const_iterator()") { + cpp11::complexes x(Rf_allocVector(CPLXSXP, 100)); + COMPLEX(x)[0] = Rcomplex{1, 1}; + COMPLEX(x)[1] = Rcomplex{2, 2}; + COMPLEX(x)[2] = Rcomplex{3, 3}; + COMPLEX(x)[3] = Rcomplex{4, 4}; + COMPLEX(x)[4] = Rcomplex{5, 5}; + COMPLEX(x)[97] = Rcomplex{98, 98}; + COMPLEX(x)[98] = Rcomplex{99, 99}; + COMPLEX(x)[99] = Rcomplex{100, 100}; + expect_true(x.size() == 100); + + auto it = x.begin(); + auto it2 = x.begin(); + expect_true(it == it2); + + ++it; + expect_true(!(it == it2)); + expect_true(it != it2); + + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + cpp11::r_complex ninety_nine{99, 99}; + cpp11::r_complex ninety_eight{98, 98}; + cpp11::r_complex one_hundred{100, 100}; + + ++it; + expect_true(*it == three); + --it; + expect_true(*it == two); + --it; + + it += 99; + expect_true(*it == one_hundred); + --it; + expect_true(*it == ninety_nine); + --it; + expect_true(*it == ninety_eight); + it -= 95; + expect_true(*it == three); + } + + test_that("complexes.push_back()") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + cpp11::writable::complexes x; + x.push_back(one); + x.push_back(two); + x.push_back(three); + + expect_true(x.size() == 3); + expect_true(x[0] == one); + expect_true(x[1] == two); + expect_true(x[2] == three); + } + test_that("complexes.resize()") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + cpp11::writable::complexes x; + x.resize(3); + x[0] = one; + x[1] = two; + x[2] = three; + + expect_true(x.size() == 3); + expect_true(x[0] == one); + expect_true(x[1] == two); + expect_true(x[2] == three); + } + test_that("complexes.at()") { + cpp11::writable::complexes x; + + expect_error(x.at(-1)); + + expect_error(x.at(0)); + + cpp11::r_complex one{1, 1}; + + x.push_back(one); + expect_true(x.at(0) == one); + expect_error(x.at(1)); + } + test_that("complexes.pop_back()") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + cpp11::writable::complexes x; + + x.push_back(one); + x.push_back(two); + x.pop_back(); + + expect_true(x.size() == 1); + expect_true(x[0] == one); + + expect_error(x.at(1)); + } + test_that("complexes.insert()") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + cpp11::writable::complexes x; + + x.insert(0, one); + x.insert(0, two); + x.insert(1, three); + expect_true(x.size() == 3); + + expect_true(x[0] == two); + expect_true(x[1] == three); + expect_true(x[2] == one); + } + test_that("complexes.erase()") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + cpp11::r_complex four{4, 4}; + cpp11::r_complex five{5, 5}; + + cpp11::writable::complexes x; + + x.push_back(one); + x.push_back(two); + x.push_back(three); + x.push_back(four); + x.push_back(five); + + expect_true(x.size() == 5); + + x.erase(0); + + expect_true(x.size() == 4); + expect_true(x[0] == two); + expect_true(x[1] == three); + expect_true(x[2] == four); + expect_true(x[3] == five); + + x.erase(2); + + expect_true(x.size() == 3); + expect_true(x[0] == two); + expect_true(x[1] == three); + expect_true(x[2] == five); + } + test_that("complexes.iterator* = ") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + cpp11::r_complex four{4, 4}; + + cpp11::writable::complexes x; + x.push_back(one); + x.push_back(two); + x.push_back(three); + auto it = x.begin() + 1; + *it = three; + ++it; + *it = four; + + expect_true(x.size() == 3); + expect_true(x[0] == one); + expect_true(x[1] == three); + expect_true(x[2] == four); + } + + test_that("writable::complexes(SEXP)") { + Rcomplex one{1, 1}; + Rcomplex two{2, 2}; + Rcomplex three{3, 3}; + Rcomplex four{4, 4}; + Rcomplex five{5, 5}; + Rcomplex six{6, 6}; + Rcomplex seven{7, 7}; + + SEXP x = PROTECT(Rf_allocVector(CPLXSXP, 5)); + + COMPLEX(x)[0] = one; + COMPLEX(x)[1] = two; + COMPLEX(x)[2] = three; + COMPLEX(x)[3] = four; + COMPLEX(x)[4] = five; + + cpp11::writable::complexes y(x); + y[0] = cpp11::r_complex(six); + + expect_true(x != y.data()); + + expect_true(COMPLEX(x)[0].r == one.r); + expect_true(COMPLEX(x)[0].i == one.i); + expect_true(y[0] == cpp11::r_complex(six)); + + cpp11::writable::complexes z(y); + z[0] = cpp11::r_complex(seven); + + expect_true(z.data() != y.data()); + + expect_true(COMPLEX(x)[0].r == one.r); + expect_true(COMPLEX(x)[0].i == one.i); + expect_true(y[0] == cpp11::r_complex(six)); + expect_true(z[0] == cpp11::r_complex(seven)); + + UNPROTECT(1); + } + test_that("writable::complexes(SEXP, bool)") { + Rcomplex five{5, 5}; + SEXP x = PROTECT(Rf_ScalarComplex(five)); + cpp11::writable::complexes y(x, false); + + expect_true(COMPLEX(y)[0].r == five.r); + expect_true(COMPLEX(y)[0].i == five.i); + UNPROTECT(1); + } + + test_that("writable::complexes(SEXP) assignment") { + cpp11::r_complex zero{0, 0}; + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + cpp11::writable::complexes x({one, two, three}); + cpp11::writable::complexes y({zero}); + y = x; + expect_true(y.size() == 3); + expect_true(y.data() != x.data()); + expect_true(y.is_altrep() == x.is_altrep()); + } + + test_that("writable::complexes(SEXP) move assignment") { + cpp11::r_complex zero{0, 0}; + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + cpp11::writable::complexes x({one, two, three}); + cpp11::writable::complexes y({zero}); + auto x_data = x.data(); + + y = std::move(x); + expect_true(y.size() == 3); + expect_true(y.data() == x_data); + expect_true(y.is_altrep() == false); + } + + test_that("complexes::names(empty)") { + cpp11::complexes x; + auto nms = x.names(); + expect_true(nms.size() == 0); + } + + test_that("complexes::names") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + using namespace cpp11::literals; + cpp11::writable::complexes x({"a"_nm = one, "b"_nm = two, "c"_nm = three}); + expect_true(x[0] == one); + expect_true(x[1] == two); + expect_true(x[2] == three); + + expect_true(x.contains("a")); + expect_true(!x.contains("d")); + + expect_true(x["a"] == one); + expect_true(x["b"] == two); + expect_true(x["c"] == three); + + cpp11::sexp nms(x.names()); + expect_true(Rf_xlength(nms) == 3); + auto nms0 = CHAR(STRING_ELT(nms, 0)); + auto nms1 = CHAR(STRING_ELT(nms, 1)); + auto nms2 = CHAR(STRING_ELT(nms, 2)); + expect_true(strcmp(nms0, "a") == 0); + expect_true(strcmp(nms1, "b") == 0); + expect_true(strcmp(nms2, "c") == 0); + } + + test_that("complexes::attr") { + cpp11::complexes x(PROTECT(Rf_allocVector(CPLXSXP, 2))); + COMPLEX(x)[0] = Rcomplex{1, 1}; + COMPLEX(x)[1] = Rcomplex{2, 2}; + + SEXP foo = Rf_install("foo"); + Rf_setAttrib(x, foo, Rf_mkString("bar")); + + // This doesn't compile by design + // x.attr("foo") = "bar"; + + // But this will + cpp11::writable::complexes y(x); + y.attr("foo") = "baz"; + + expect_true(strcmp(CHAR(STRING_ELT(x.attr("foo"), 0)), "bar") == 0); + expect_true(strcmp(CHAR(STRING_ELT(y.attr("foo"), 0)), "baz") == 0); + + UNPROTECT(1); + } + + test_that("writable::complexes(std::vector::iterator)") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + std::vector x({one, two}); + cpp11::writable::complexes y(x.begin(), x.end()); + + expect_true(y.size() == 2); + expect_true(y[0] == one); + expect_true(y[1] == two); + } + + test_that("writable::complexes(std::vector)") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + std::vector x({one, two, three}); + cpp11::writable::complexes y(x); + + expect_true(y.size() == 3); + expect_true(y[0] == one); + expect_true(y[2] == three); + } + + test_that("writable::complexes attributes are kept when converted to complexes") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + cpp11::writable::complexes x({one, two}); + x.names() = {"a", "b"}; + cpp11::strings x_nms(x.names()); + expect_true(x_nms[0] == "a"); + expect_true(x_nms[1] == "b"); + + cpp11::complexes y(x); + cpp11::strings y_nms(y.names()); + expect_true(y_nms[0] == "a"); + expect_true(y_nms[1] == "b"); + } + + test_that("comparison operator works") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + using namespace cpp11; + cpp11::complexes base({one, two}); + cpp11::complexes same_values({one, two}); + cpp11::complexes diff_length({one}); + cpp11::complexes diff_values({one, three}); + + expect_true(base == base); + expect_true(base == base); + expect_true(base == same_values); + expect_true(!(base == diff_length)); + expect_true(!(base == diff_values)); + + expect_true(!(base != base)); + expect_true(!(base != same_values)); + expect_true(base != diff_length); + expect_true(base != diff_values); + } + + test_that("proxy comparison works symmetrically") { + cpp11::r_complex x{1, 2}; + cpp11::writable::complexes y({x}); + + expect_true(x == y[0]); + expect_true(y[0] == x); + } + + test_that("complexes operator[] and at") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + cpp11::complexes x(Rf_allocVector(CPLXSXP, 2)); + COMPLEX(x)[0] = Rcomplex(one); + COMPLEX(x)[1] = Rcomplex(two); + + int i0 = 0; + R_xlen_t x0 = 0; + size_t s0 = 0; + + expect_true(x[i0] == one); + expect_true(x[x0] == one); + expect_true(x[s0] == one); + + expect_true(x.at(i0) == one); + expect_true(x.at(x0) == one); + expect_true(x.at(s0) == one); + } + + test_that("writable::complexes operator[] and at") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + cpp11::writable::complexes x(Rf_allocVector(CPLXSXP, 2)); + COMPLEX(x)[0] = Rcomplex(one); + COMPLEX(x)[1] = Rcomplex(two); + + int i0 = 0; + R_xlen_t x0 = 0; + size_t s0 = 0; + + expect_true(x[i0] == one); + expect_true(x[x0] == one); + expect_true(x[s0] == one); + + expect_true(x.at(i0) == one); + expect_true(x.at(x0) == one); + expect_true(x.at(s0) == one); + } + + test_that("operator[] and at with names") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + using namespace cpp11::literals; + cpp11::writable::complexes x({"a"_nm = one, "b"_nm = two}); + cpp11::complexes y(x); + + expect_true(x["a"] == one); + expect_true(x["b"] == two); + expect_error(x["c"] == two); + + expect_true(y["a"] == one); + expect_true(y["b"] == two); + expect_error(y["c"] == two); + } + + test_that("complexes::find") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + using namespace cpp11::literals; + cpp11::writable::complexes x({"a"_nm = one, "b"_nm = two}); + cpp11::complexes y(x); + + expect_true(x.find("a") == x.begin()); + expect_true(x.find("b") == x.begin() + 1); + expect_true(x.find("c") == x.end()); + + expect_true(y.find("a") == y.begin()); + expect_true(y.find("b") == y.begin() + 1); + expect_true(y.find("c") == y.end()); + } + + test_that("writable::complexes compound assignments") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + + cpp11::writable::complexes x({one}); + + auto x0 = x[0]; + expect_true(x0 == one); + + // Arithmetic is not defined on Rcomplex or r_complex, + // so using it on a proxy also fails and is not defined + // expect_error(x0 += two); + // expect_error(x0 -= two); + // expect_error(x0 *= two); + // expect_error(x0 /= two); + // expect_error(x0--); + // expect_error(x0++); + // expect_error(++x0); + // expect_error(--x0); + } + + test_that("writable::complexes convert to complexes with correct size (#128)") { + cpp11::r_complex one{1, 1}; + cpp11::r_complex two{2, 2}; + cpp11::r_complex three{3, 3}; + + cpp11::writable::complexes foo; + foo.push_back(one); + foo.push_back(two); + foo.push_back(three); + + cpp11::complexes bar(foo); + expect_true(Rf_xlength(bar) == 3); + } +} diff --git a/cpp11test/src/test-r_complex.cpp b/cpp11test/src/test-r_complex.cpp new file mode 100644 index 00000000..3533eed6 --- /dev/null +++ b/cpp11test/src/test-r_complex.cpp @@ -0,0 +1,94 @@ +#include "cpp11/r_complex.hpp" + +#include "cpp11/sexp.hpp" + +#include + +context("r_complex-C++") { + test_that("r_complex() zero initialization") { + // `cpp11::r_complex x;` is "not initialized", this is "zero initialized" + cpp11::r_complex x{}; + expect_true(x.real() == 0.); + expect_true(x.imag() == 0.); + } + + test_that("r_complex(double, double) and accessors") { + cpp11::r_complex x(1., 2.); + expect_true(x.real() == 1.); + expect_true(x.imag() == 2.); + } + + test_that("r_complex(SEXP)") { + cpp11::r_complex x(1, 2); + + cpp11::sexp value = Rf_allocVector(CPLXSXP, 1); + COMPLEX(value)[0] = static_cast(x); + + cpp11::r_complex x2(value); + + expect_true(x2 == x); + } + + test_that("explicit construction from Rcomplex") { + Rcomplex x{1, 2}; + cpp11::r_complex y(x); + expect_true(y.real() == x.r); + expect_true(y.imag() == x.i); + } + + test_that("explicit construction from std::complex") { + std::complex x{1, 2}; + cpp11::r_complex y(x); + expect_true(y.real() == x.real()); + expect_true(y.imag() == x.imag()); + } + + test_that("explicit conversion to Rcomplex") { + cpp11::r_complex x(1, 2); + Rcomplex y(x); + expect_true(y.r == x.real()); + expect_true(y.i == x.imag()); + } + + test_that("explicit conversion to std::complex") { + cpp11::r_complex x(1, 2); + std::complex y(x); + expect_true(y.real() == x.real()); + expect_true(y.imag() == x.imag()); + } + + test_that("equality comparison of two r_complex") { + expect_true(cpp11::r_complex(1, 3) == cpp11::r_complex(1, 3)); + expect_false(cpp11::r_complex(1, 3) == cpp11::r_complex(2, 3)); + expect_false(cpp11::r_complex(1, 3) == cpp11::r_complex(1, 4)); + } + + test_that("na()") { + cpp11::r_complex x = cpp11::na(); + // Not `ISNA()`, checking specifically for `NA_REAL` + expect_true(R_IsNA(x.real())); + expect_true(R_IsNA(x.imag())); + } + + test_that("is_na(r_complex)") { + cpp11::r_complex x{1, 2}; + expect_false(cpp11::is_na(x)); + + cpp11::r_complex na_na{NA_REAL, NA_REAL}; + cpp11::r_complex na_real{NA_REAL, 1}; + cpp11::r_complex real_na{1, NA_REAL}; + + expect_true(cpp11::is_na(na_na)); + expect_true(cpp11::is_na(na_real)); + expect_true(cpp11::is_na(real_na)); + } + + test_that("as_sexp(r_complex)") { + cpp11::r_complex x{1, 2}; + cpp11::sexp value = cpp11::as_sexp(x); + + expect_true(Rf_xlength(value) == 1); + expect_true(COMPLEX(value)[0].r == x.real()); + expect_true(COMPLEX(value)[0].i == x.imag()); + } +} diff --git a/cpp11test/tests/testthat/test-complex.R b/cpp11test/tests/testthat/test-complex.R new file mode 100644 index 00000000..f09ca00d --- /dev/null +++ b/cpp11test/tests/testthat/test-complex.R @@ -0,0 +1,38 @@ +test_that("complex iterators work with normal vectors", { + len <- 1e5 + set.seed(42) + x <- complex(real = rnorm(len), imaginary = rnorm(len)) + sum_base <- sum(x) + + expect_equal(sum_cplx_for_(x), sum_base) + expect_equal(sum_cplx_for_2_(x), sum_base) + expect_equal(sum_cplx_for_3_(x), sum_base) + expect_equal(sum_cplx_for_4_(x), sum_base) + expect_equal(sum_cplx_for_5_(x), sum_base) + expect_equal(sum_cplx_for_6_(x), sum_base) + # expect_equal(sum_cplx_foreach_(x), sum_base) + # expect_equal(sum_cplx_accumulate_(x), sum_base) + # expect_equal(sum_cplx_for2_(x), sum_base) +}) + +test_that("complex iterators work with altrep vectors", { + len <- 1e5 + seq_complex <- function(x) complex(real = as.double(seq_len(x)), imaginary = as.double(seq_len(x))) + + x <- seq_complex(len) + + sum_base <- sum(x) + + expect_equal(sum_cplx_for_(x), sum_base) + # expect_equal(sum_cplx_foreach_(x), sum_base) + # expect_equal(sum_cplx_accumulate_(x), sum_base) + # expect_equal(sum_cplx_for2_(x), sum_base) +}) + +# test_that("writable::complex grow", { +# len <- 1e5L +# expect_equal(grow_cplx_(len), complex( +# real = as.numeric(seq(0, len - 1)), +# imaginary = as.numeric(seq(0, len - 1)) +# )) +# }) diff --git a/inst/include/cpp11.hpp b/inst/include/cpp11.hpp index 71e1cf1d..95b7db3b 100644 --- a/inst/include/cpp11.hpp +++ b/inst/include/cpp11.hpp @@ -4,6 +4,7 @@ #include "cpp11/altrep.hpp" #include "cpp11/as.hpp" #include "cpp11/attribute_proxy.hpp" +#include "cpp11/complexes.hpp" #include "cpp11/data_frame.hpp" #include "cpp11/doubles.hpp" #include "cpp11/environment.hpp" @@ -17,6 +18,7 @@ #include "cpp11/named_arg.hpp" #include "cpp11/protect.hpp" #include "cpp11/r_bool.hpp" +#include "cpp11/r_complex.hpp" #include "cpp11/r_string.hpp" #include "cpp11/r_vector.hpp" #include "cpp11/raws.hpp" diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp new file mode 100644 index 00000000..9166d94a --- /dev/null +++ b/inst/include/cpp11/complexes.hpp @@ -0,0 +1,182 @@ +#pragma once + +#include // for min +#include // for array +#include // for initializer_list + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_allocVector +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_complex.hpp" // for r_complex +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +// Specializations for complex numbers + +template <> +inline SEXPTYPE r_vector::get_sexptype() { + return CPLXSXP; +} + +template <> +inline typename r_vector::underlying_type r_vector::get_elt( + SEXP x, R_xlen_t i) { + return COMPLEX_ELT(x, i); +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p( + bool is_altrep, SEXP data) { + if (is_altrep) { + return nullptr; + } else { + return COMPLEX(data); + } +} + +template <> +inline typename r_vector::underlying_type const* +r_vector::get_const_p(bool is_altrep, SEXP data) { + return COMPLEX_OR_NULL(data); +} + +template <> +inline void r_vector::get_region(SEXP x, R_xlen_t i, R_xlen_t n, + typename r_vector::underlying_type* buf) { + COMPLEX_GET_REGION(x, i, n, buf); +} + +template <> +inline bool r_vector::const_iterator::use_buf(bool is_altrep) { + return is_altrep; +} + +typedef r_vector complexes; + +namespace writable { + +template <> +inline void r_vector::set_elt( + SEXP x, R_xlen_t i, typename r_vector::underlying_type value) { + SET_COMPLEX_ELT(x, i, value); +} + +typedef r_vector complexes; + +} // namespace writable + +inline complexes as_complexes(SEXP x) { + if (detail::r_typeof(x) == CPLXSXP) { + return complexes(x); + } + + else if (detail::r_typeof(x) == INTSXP) { + r_vector xn(x); + size_t len = xn.size(); + writable::complexes ret(len); + std::transform(xn.begin(), xn.end(), ret.begin(), [](int value) { + return value == NA_INTEGER ? r_complex(NA_REAL, NA_REAL) + : r_complex(static_cast(value), 0.0); + }); + return ret; + } + + throw type_error(CPLXSXP, detail::r_typeof(x)); +} + +// Define comparison operators within the proxy class +namespace writable { + +template <> +class r_vector::proxy { + public: + proxy(SEXP data, R_xlen_t index) + : data_(data), index_(index), buf_(nullptr), is_altrep_(false) {} + + proxy(SEXP data, R_xlen_t index, Rcomplex* buf, bool is_altrep) + : data_(data), index_(index), buf_(buf), is_altrep_(is_altrep) {} + + operator r_complex() const { + if (is_altrep_ && buf_ != nullptr) { + return r_complex(buf_->r, buf_->i); + } else { + Rcomplex r = COMPLEX_ELT(data_, index_); + return r_complex(r.r, r.i); + } + } + + proxy& operator=(const r_complex& value) { + if (is_altrep_ && buf_ != nullptr) { + buf_->r = value.real(); + buf_->i = value.imag(); + } else { + Rcomplex r; + r.r = value.real(); + r.i = value.imag(); + SET_COMPLEX_ELT(data_, index_, r); + } + return *this; + } + + proxy& operator+=(const r_complex& value) { + *this = static_cast(*this) + value; + return *this; + } + + proxy& operator-=(const r_complex& value) { + *this = static_cast(*this) - value; + return *this; + } + + proxy& operator*=(const r_complex& value) { + *this = static_cast(*this) * value; + return *this; + } + + proxy& operator/=(const r_complex& value) { + *this = static_cast(*this) / value; + return *this; + } + + proxy& operator++() { + *this += r_complex(1, 0); + return *this; + } + + proxy operator++(int) { + proxy tmp(*this); + operator++(); + return tmp; + } + + proxy& operator--() { + *this -= r_complex(1, 0); + return *this; + } + + proxy operator--(int) { + proxy tmp(*this); + operator--(); + return tmp; + } + + friend bool operator==(const proxy& lhs, const r_complex& rhs) { + return static_cast(lhs) == rhs; + } + + friend bool operator!=(const proxy& lhs, const r_complex& rhs) { return !(lhs == rhs); } + + private: + SEXP data_; + R_xlen_t index_; + Rcomplex* buf_; + bool is_altrep_; +}; + +} // namespace writable + +} // namespace cpp11 diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 8345068f..78deea53 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -3,11 +3,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/r_bool.hpp" // for r_bool +#include "cpp11/r_complex.hpp" // for r_complex +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { @@ -214,6 +215,8 @@ template using logicals_matrix = matrix, r_bool, S>; template using strings_matrix = matrix, r_string, S>; +template +using complex_matrix = matrix, r_complex, S>; namespace writable { template @@ -224,6 +227,8 @@ template using logicals_matrix = matrix, r_vector::proxy, S>; template using strings_matrix = matrix, r_vector::proxy, S>; +template +using complex_matrix = matrix, r_vector::proxy, S>; } // namespace writable // TODO: Add tests for Matrix class diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp new file mode 100644 index 00000000..cfda9340 --- /dev/null +++ b/inst/include/cpp11/r_complex.hpp @@ -0,0 +1,143 @@ +#pragma once + +#include // for complex +#include +#include // for is_convertible, enable_if + +#include "R_ext/Arith.h" // for NA_REAL +#include "R_ext/Complex.h" // for Rcomplex +#include "cpp11/R.hpp" // for SEXP, SEXPREC, ... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for unwind_protect, preserved +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +class r_complex { + public: + r_complex() = default; + + r_complex(SEXP data) { + if (Rf_isComplex(data) && Rf_xlength(data) == 1) { + Rcomplex elt = COMPLEX_ELT(data, 0); + real_ = elt.r; + imag_ = elt.i; + } else { + throw std::invalid_argument("Invalid r_complex value"); + } + } + + r_complex(double real, double imag) : real_(real), imag_(imag) {} + + explicit r_complex(Rcomplex value) : real_(value.r), imag_(value.i) {} + explicit r_complex(std::complex value) + : real_(value.real()), imag_(value.imag()) {} + + explicit operator Rcomplex() const { return Rcomplex{real_, imag_}; } + explicit operator std::complex() const { + return std::complex(real_, imag_); + } + + double real() const { return real_; } + double imag() const { return imag_; } + + r_complex& operator+=(const r_complex& other) { + real_ += other.real_; + imag_ += other.imag_; + return *this; + } + + r_complex& operator-=(const r_complex& other) { + real_ -= other.real_; + imag_ -= other.imag_; + return *this; + } + + r_complex& operator*=(const r_complex& other) { + double r = real_ * other.real_ - imag_ * other.imag_; + double i = real_ * other.imag_ + imag_ * other.real_; + real_ = r; + imag_ = i; + return *this; + } + + r_complex& operator/=(const r_complex& other) { + double denom = other.real_ * other.real_ + other.imag_ * other.imag_; + double r = (real_ * other.real_ + imag_ * other.imag_) / denom; + double i = (imag_ * other.real_ - real_ * other.imag_) / denom; + real_ = r; + imag_ = i; + return *this; + } + + private: + double real_; + double imag_; +}; + +inline r_complex operator+(r_complex lhs, const r_complex& rhs) { + lhs += rhs; + return lhs; +} + +inline r_complex operator-(r_complex lhs, const r_complex& rhs) { + lhs -= rhs; + return lhs; +} + +inline r_complex operator*(r_complex lhs, const r_complex& rhs) { + lhs *= rhs; + return lhs; +} + +inline r_complex operator/(r_complex lhs, const r_complex& rhs) { + lhs /= rhs; + return lhs; +} + +inline bool operator==(const r_complex& x, const r_complex& y) { + return (x.real() == y.real()) && (x.imag() == y.imag()); +} + +inline std::ostream& operator<<(std::ostream& os, const r_complex& value) { + os << value.real() << "+" << value.imag() << "i"; + return os; +} + +template <> +inline r_complex na() { + return r_complex(NA_REAL, NA_REAL); +} + +template <> +inline bool is_na(const r_complex& x) { + return ISNA(x.real()) || ISNA(x.imag()); +} + +template +struct is_r_complex : std::false_type {}; + +template <> +struct is_r_complex : std::true_type {}; + +template +using enable_if_r_complex = std::enable_if_t::value, R>; + +template +enable_if_r_complex as_sexp(T from) { + SEXP res = PROTECT(Rf_allocVector(CPLXSXP, 1)); + Rcomplex* r = COMPLEX(res); + r[0].r = from.real(); + r[0].i = from.imag(); + UNPROTECT(1); + return res; +} + +namespace traits { +template <> +struct get_underlying_type { + using type = Rcomplex; +}; +} // namespace traits + +} // namespace cpp11 diff --git a/inst/include/cpp11/sexp.hpp b/inst/include/cpp11/sexp.hpp index 74205e69..03e75937 100644 --- a/inst/include/cpp11/sexp.hpp +++ b/inst/include/cpp11/sexp.hpp @@ -3,6 +3,7 @@ #include // for size_t #include // for string, basic_string +#include // for complex #include "cpp11/R.hpp" // for SEXP, SEXPREC, REAL_ELT, R_NilV... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy @@ -75,4 +76,14 @@ class sexp { operator bool() const { return LOGICAL_ELT(data_, 0); } }; +// Specialization for converting std::complex to SEXP +template <> +inline SEXP as_sexp(const std::complex& from) { + SEXP result = PROTECT(Rf_allocVector(CPLXSXP, 1)); + COMPLEX(result)[0].r = from.real(); + COMPLEX(result)[0].i = from.imag(); + UNPROTECT(1); + return result; +} + } // namespace cpp11 From 628ae8f5f78bf396f390fb500bcb0a8362ce2132 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 25 Dec 2024 14:31:23 -0500 Subject: [PATCH 02/14] UPDATE AS.HPP --- inst/include/cpp11/as.hpp | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/inst/include/cpp11/as.hpp b/inst/include/cpp11/as.hpp index 682f12b5..43aa7be5 100644 --- a/inst/include/cpp11/as.hpp +++ b/inst/include/cpp11/as.hpp @@ -1,6 +1,7 @@ #pragma once #include // for modf +#include // for std::complex #include // for initializer_list #include // for std::shared_ptr, std::weak_ptr, std::unique_ptr #include @@ -333,4 +334,24 @@ enable_if_convertible_to_sexp as_sexp(const T& from) { return from; } +// Specialization for converting std::complex to SEXP +template <> +inline SEXP as_sexp(const std::complex& x) { + SEXP result = PROTECT(Rf_allocVector(CPLXSXP, 1)); + COMPLEX(result)[0].r = x.real(); + COMPLEX(result)[0].i = x.imag(); + UNPROTECT(1); + return result; +} + +// Specialization for converting SEXP to std::complex +template <> +inline std::complex as_cpp(SEXP x) { + if (TYPEOF(x) != CPLXSXP || Rf_length(x) != 1) { + throw std::invalid_argument("Expected a single complex number."); + } + Rcomplex c = COMPLEX(x)[0]; + return {c.r, c.i}; +} + } // namespace cpp11 From ca9c11ecd2a63a456a430cc9f168eb3a62466912 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 25 Dec 2024 15:21:31 -0500 Subject: [PATCH 03/14] temporary as.hpp --- inst/include/cpp11/as.hpp | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/inst/include/cpp11/as.hpp b/inst/include/cpp11/as.hpp index 43aa7be5..1ef0abc9 100644 --- a/inst/include/cpp11/as.hpp +++ b/inst/include/cpp11/as.hpp @@ -344,9 +344,13 @@ inline SEXP as_sexp(const std::complex& x) { return result; } -// Specialization for converting SEXP to std::complex +// Declaration for converting SEXP to std::complex template <> -inline std::complex as_cpp(SEXP x) { +std::complex as_cpp(SEXP x); + +// Specialization for as_cpp with std::complex +template <> +inline std::complex as_cpp>(SEXP x) { if (TYPEOF(x) != CPLXSXP || Rf_length(x) != 1) { throw std::invalid_argument("Expected a single complex number."); } From 17ba5195141000c4d0ca6c0d341c4de1c08f9603 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 25 Dec 2024 16:37:35 -0500 Subject: [PATCH 04/14] handle cpp complex <-> R sexp --- inst/include/cpp11/complexes.hpp | 37 ++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp index 9166d94a..138c0319 100644 --- a/inst/include/cpp11/complexes.hpp +++ b/inst/include/cpp11/complexes.hpp @@ -2,6 +2,7 @@ #include // for min #include // for array +#include // for std::complex #include // for initializer_list #include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_allocVector @@ -122,6 +123,19 @@ class r_vector::proxy { return *this; } + proxy& operator=(const std::complex& value) { + if (is_altrep_ && buf_ != nullptr) { + buf_->r = value.real(); + buf_->i = value.imag(); + } else { + Rcomplex r; + r.r = value.real(); + r.i = value.imag(); + SET_COMPLEX_ELT(data_, index_, r); + } + return *this; + } + proxy& operator+=(const r_complex& value) { *this = static_cast(*this) + value; return *this; @@ -179,4 +193,27 @@ class r_vector::proxy { } // namespace writable +// New complex_vector class for handling complex numbers in SEXP +class complex_vector { + public: + explicit complex_vector(SEXP x) + : data_(reinterpret_cast(DATAPTR(x))), size_(Rf_length(x)) {} + + std::complex operator[](R_xlen_t i) const { return {data_[i].r, data_[i].i}; } + + size_t size() const { return size_; } + + private: + Rcomplex* data_; + size_t size_; +}; + +// Template specialization for adding cpp11::r_complex to std::complex +template +inline std::complex& operator+=(std::complex& lhs, const cpp11::r_complex& rhs) { + lhs.real(lhs.real() + rhs.real()); + lhs.imag(lhs.imag() + rhs.imag()); + return lhs; +} + } // namespace cpp11 From ea98a872eed9fec8d4eb1c8ee7ea6117a4beb22a Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 25 Dec 2024 19:15:43 -0500 Subject: [PATCH 05/14] almost ok, push_back for complexes is pending --- cpp11test/R/cpp11.R | 16 +++++++ cpp11test/src/cpp11.cpp | 32 +++++++++++++ cpp11test/src/grow.cpp | 12 +++++ cpp11test/src/sum.cpp | 62 +++++++++++++++++++------ cpp11test/src/test-complex.cpp | 2 +- cpp11test/tests/testthat/test-complex.R | 29 ++++++------ inst/include/cpp11/as.hpp | 25 ++++------ inst/include/cpp11/r_complex.hpp | 11 +++++ inst/include/cpp11/sexp.hpp | 10 ---- 9 files changed, 145 insertions(+), 54 deletions(-) diff --git a/cpp11test/R/cpp11.R b/cpp11test/R/cpp11.R index 8ea7cd42..71eb6903 100644 --- a/cpp11test/R/cpp11.R +++ b/cpp11test/R/cpp11.R @@ -84,6 +84,10 @@ grow_ <- function(n) { .Call(`_cpp11test_grow_`, n) } +grow_cplx_ <- function(n) { + .Call(`_cpp11test_grow_cplx_`, n) +} + cpp11_insert_ <- function(num_sxp) { .Call(`_cpp11test_cpp11_insert_`, num_sxp) } @@ -220,6 +224,18 @@ sum_cplx_for_6_ <- function(x_sxp) { .Call(`_cpp11test_sum_cplx_for_6_`, x_sxp) } +sum_cplx_foreach_ <- function(x) { + .Call(`_cpp11test_sum_cplx_foreach_`, x) +} + +sum_cplx_accumulate_ <- function(x) { + .Call(`_cpp11test_sum_cplx_accumulate_`, x) +} + +sum_cplx_for2_ <- function(x_sxp) { + .Call(`_cpp11test_sum_cplx_for2_`, x_sxp) +} + sum_int_for_ <- function(x) { .Call(`_cpp11test_sum_int_for_`, x) } diff --git a/cpp11test/src/cpp11.cpp b/cpp11test/src/cpp11.cpp index 7b858ddc..baadc2a2 100644 --- a/cpp11test/src/cpp11.cpp +++ b/cpp11test/src/cpp11.cpp @@ -166,6 +166,13 @@ extern "C" SEXP _cpp11test_grow_(SEXP n) { return cpp11::as_sexp(grow_(cpp11::as_cpp>(n))); END_CPP11 } +// grow.cpp +cpp11::writable::complexes grow_cplx_(R_xlen_t n); +extern "C" SEXP _cpp11test_grow_cplx_(SEXP n) { + BEGIN_CPP11 + return cpp11::as_sexp(grow_cplx_(cpp11::as_cpp>(n))); + END_CPP11 +} // insert.cpp SEXP cpp11_insert_(SEXP num_sxp); extern "C" SEXP _cpp11test_cpp11_insert_(SEXP num_sxp) { @@ -415,6 +422,27 @@ extern "C" SEXP _cpp11test_sum_cplx_for_6_(SEXP x_sxp) { return cpp11::as_sexp(sum_cplx_for_6_(cpp11::as_cpp>(x_sxp))); END_CPP11 } +// sum.cpp +std::complex sum_cplx_foreach_(cpp11::complexes x); +extern "C" SEXP _cpp11test_sum_cplx_foreach_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_foreach_(cpp11::as_cpp>(x))); + END_CPP11 +} +// sum.cpp +std::complex sum_cplx_accumulate_(cpp11::complexes x); +extern "C" SEXP _cpp11test_sum_cplx_accumulate_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_accumulate_(cpp11::as_cpp>(x))); + END_CPP11 +} +// sum.cpp +std::complex sum_cplx_for2_(SEXP x_sxp); +extern "C" SEXP _cpp11test_sum_cplx_for2_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(sum_cplx_for2_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} // sum_int.cpp double sum_int_for_(cpp11::integers x); extern "C" SEXP _cpp11test_sum_int_for_(SEXP x) { @@ -530,6 +558,7 @@ 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_grow_cplx_", (DL_FUNC) &_cpp11test_grow_cplx_, 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}, @@ -562,12 +591,15 @@ static const R_CallMethodDef CallEntries[] = { {"_cpp11test_row_sums", (DL_FUNC) &_cpp11test_row_sums, 1}, {"_cpp11test_string_proxy_assignment_", (DL_FUNC) &_cpp11test_string_proxy_assignment_, 0}, {"_cpp11test_string_push_back_", (DL_FUNC) &_cpp11test_string_push_back_, 0}, + {"_cpp11test_sum_cplx_accumulate_", (DL_FUNC) &_cpp11test_sum_cplx_accumulate_, 1}, + {"_cpp11test_sum_cplx_for2_", (DL_FUNC) &_cpp11test_sum_cplx_for2_, 1}, {"_cpp11test_sum_cplx_for_", (DL_FUNC) &_cpp11test_sum_cplx_for_, 1}, {"_cpp11test_sum_cplx_for_2_", (DL_FUNC) &_cpp11test_sum_cplx_for_2_, 1}, {"_cpp11test_sum_cplx_for_3_", (DL_FUNC) &_cpp11test_sum_cplx_for_3_, 1}, {"_cpp11test_sum_cplx_for_4_", (DL_FUNC) &_cpp11test_sum_cplx_for_4_, 1}, {"_cpp11test_sum_cplx_for_5_", (DL_FUNC) &_cpp11test_sum_cplx_for_5_, 1}, {"_cpp11test_sum_cplx_for_6_", (DL_FUNC) &_cpp11test_sum_cplx_for_6_, 1}, + {"_cpp11test_sum_cplx_foreach_", (DL_FUNC) &_cpp11test_sum_cplx_foreach_, 1}, {"_cpp11test_sum_dbl_accumulate2_", (DL_FUNC) &_cpp11test_sum_dbl_accumulate2_, 1}, {"_cpp11test_sum_dbl_accumulate_", (DL_FUNC) &_cpp11test_sum_dbl_accumulate_, 1}, {"_cpp11test_sum_dbl_for2_", (DL_FUNC) &_cpp11test_sum_dbl_for2_, 1}, diff --git a/cpp11test/src/grow.cpp b/cpp11test/src/grow.cpp index eb3f620b..ccc302e7 100644 --- a/cpp11test/src/grow.cpp +++ b/cpp11test/src/grow.cpp @@ -1,4 +1,5 @@ #include "cpp11/doubles.hpp" +#include "cpp11/complexes.hpp" [[cpp11::register]] cpp11::writable::doubles grow_(R_xlen_t n) { cpp11::writable::doubles x; @@ -9,3 +10,14 @@ return x; } + +[[cpp11::register]] cpp11::writable::complexes grow_cplx_(R_xlen_t n) { + cpp11::writable::complexes x; + R_xlen_t i = 0; + while (i < n) { + x.push_back(std::complex(i, i)); + i++; + } + + return x; +} diff --git a/cpp11test/src/sum.cpp b/cpp11test/src/sum.cpp index 0cc08848..cb8060b7 100644 --- a/cpp11test/src/sum.cpp +++ b/cpp11test/src/sum.cpp @@ -60,14 +60,15 @@ return std::accumulate(x.cbegin(), x.cend(), 0.); } -// Functions for complex data type +// Pacha: Functions for complex data type [[cpp11::register]] cpp11::r_complex sum_cplx_for_(cpp11::complexes x) { std::complex sum = {0.0, 0.0}; R_xlen_t n = x.size(); for (R_xlen_t i = 0; i < n; ++i) { - sum.real(sum.real() + x[i].real()); - sum.imag(sum.imag() + x[i].imag()); + // sum.real(sum.real() + x[i].real()); + // sum.imag(sum.imag() + x[i].imag()); + sum += x[i]; } return cpp11::r_complex(sum.real(), sum.imag()); @@ -77,12 +78,15 @@ std::complex sum = {0.0, 0.0}; R_xlen_t n = x.size(); for (R_xlen_t i = 0; i < n; ++i) { - sum.real(sum.real() + x[i].real()); - sum.imag(sum.imag() + x[i].imag()); + // sum.real(sum.real() + x[i].real()); + // sum.imag(sum.imag() + x[i].imag()); + sum += x[i]; } cpp11::writable::complexes result(1); - result[0] = cpp11::r_complex(sum.real(), sum.imag()); + // result[0] = cpp11::r_complex(sum.real(), sum.imag()); + result[0] = sum; + return result; } @@ -91,8 +95,9 @@ const cpp11::complexes x(x_sxp, false); R_xlen_t n = x.size(); for (R_xlen_t i = 0; i < n; ++i) { - sum.real(sum.real() + x[i].real()); - sum.imag(sum.imag() + x[i].imag()); + // sum.real(sum.real() + x[i].real()); + // sum.imag(sum.imag() + x[i].imag()); + sum += x[i]; } return sum; @@ -103,8 +108,9 @@ const cpp11::complexes x(x_sxp, false); R_xlen_t n = x.size(); for (R_xlen_t i = 0; i < n; ++i) { - sum.real(sum.real() + x[i].real()); - sum.imag(sum.imag() + x[i].imag()); + // sum.real(sum.real() + x[i].real()); + // sum.imag(sum.imag() + x[i].imag()); + sum += x[i]; } return sum; @@ -115,8 +121,9 @@ const cpp11::complexes x(x_sxp, false); R_xlen_t n = x.size(); for (R_xlen_t i = 0; i < n; ++i) { - sum.real(sum.real() + x[i].real()); - sum.imag(sum.imag() + x[i].imag()); + // sum.real(sum.real() + x[i].real()); + // sum.imag(sum.imag() + x[i].imag()); + sum += x[i]; } return cpp11::as_sexp(sum); @@ -127,9 +134,36 @@ const cpp11::complexes x(x_sxp, false); R_xlen_t n = x.size(); for (R_xlen_t i = 0; i < n; ++i) { - sum.real(sum.real() + x[i].real()); - sum.imag(sum.imag() + x[i].imag()); + // sum.real(sum.real() + x[i].real()); + // sum.imag(sum.imag() + x[i].imag()); + sum += x[i]; } return cpp11::as_sexp(sum); } + +[[cpp11::register]] std::complex sum_cplx_foreach_(cpp11::complexes x) { + std::complex sum = {0.0, 0.0}; + for (const auto&& val : x) { + // sum.real(sum.real() + val.real()); + // sum.imag(sum.imag() + val.imag()); + sum += val; + } + + return sum; +} + +[[cpp11::register]] std::complex sum_cplx_accumulate_(cpp11::complexes x) { + return std::accumulate(x.cbegin(), x.cend(), std::complex(0.0, 0.0)); +} + +[[cpp11::register]] std::complex sum_cplx_for2_(SEXP x_sxp) { + std::complex sum = {0.0, 0.0}; + const cpp11::complexes x(x_sxp); + R_xlen_t n = x.size(); + for (R_xlen_t i = 0; i < n; ++i) { + sum += x[i]; + } + + return sum; +} diff --git a/cpp11test/src/test-complex.cpp b/cpp11test/src/test-complex.cpp index 21bf174b..4210f079 100644 --- a/cpp11test/src/test-complex.cpp +++ b/cpp11test/src/test-complex.cpp @@ -484,7 +484,7 @@ context("complexes-C++") { // expect_error(--x0); } - test_that("writable::complexes convert to complexes with correct size (#128)") { + test_that("writable::complexes convert to complexes with correct size") { cpp11::r_complex one{1, 1}; cpp11::r_complex two{2, 2}; cpp11::r_complex three{3, 3}; diff --git a/cpp11test/tests/testthat/test-complex.R b/cpp11test/tests/testthat/test-complex.R index f09ca00d..6fec2e8c 100644 --- a/cpp11test/tests/testthat/test-complex.R +++ b/cpp11test/tests/testthat/test-complex.R @@ -4,15 +4,18 @@ test_that("complex iterators work with normal vectors", { x <- complex(real = rnorm(len), imaginary = rnorm(len)) sum_base <- sum(x) + # Pacha: I know this is redundant, but exhanging equivalent types + # allowed me to test for errors in the implementation expect_equal(sum_cplx_for_(x), sum_base) expect_equal(sum_cplx_for_2_(x), sum_base) expect_equal(sum_cplx_for_3_(x), sum_base) expect_equal(sum_cplx_for_4_(x), sum_base) expect_equal(sum_cplx_for_5_(x), sum_base) expect_equal(sum_cplx_for_6_(x), sum_base) - # expect_equal(sum_cplx_foreach_(x), sum_base) - # expect_equal(sum_cplx_accumulate_(x), sum_base) - # expect_equal(sum_cplx_for2_(x), sum_base) + + expect_equal(sum_cplx_foreach_(x), sum_base) + expect_equal(sum_cplx_accumulate_(x), sum_base) + expect_equal(sum_cplx_for2_(x), sum_base) }) test_that("complex iterators work with altrep vectors", { @@ -24,15 +27,15 @@ test_that("complex iterators work with altrep vectors", { sum_base <- sum(x) expect_equal(sum_cplx_for_(x), sum_base) - # expect_equal(sum_cplx_foreach_(x), sum_base) - # expect_equal(sum_cplx_accumulate_(x), sum_base) - # expect_equal(sum_cplx_for2_(x), sum_base) + expect_equal(sum_cplx_foreach_(x), sum_base) + expect_equal(sum_cplx_accumulate_(x), sum_base) + expect_equal(sum_cplx_for2_(x), sum_base) }) -# test_that("writable::complex grow", { -# len <- 1e5L -# expect_equal(grow_cplx_(len), complex( -# real = as.numeric(seq(0, len - 1)), -# imaginary = as.numeric(seq(0, len - 1)) -# )) -# }) +test_that("writable::complex grow", { + len <- 1e5L + expect_equal(grow_cplx_(len), complex( + real = as.numeric(seq(0, len - 1)), + imaginary = as.numeric(seq(0, len - 1)) + )) +}) diff --git a/inst/include/cpp11/as.hpp b/inst/include/cpp11/as.hpp index 1ef0abc9..bf779f93 100644 --- a/inst/include/cpp11/as.hpp +++ b/inst/include/cpp11/as.hpp @@ -334,8 +334,16 @@ enable_if_convertible_to_sexp as_sexp(const T& from) { return from; } +// Definition for converting SEXP to std::complex +inline std::complex as_cpp(SEXP x) { + if (TYPEOF(x) != CPLXSXP || Rf_length(x) != 1) { + throw std::invalid_argument("Expected a single complex number."); + } + Rcomplex c = COMPLEX(x)[0]; + return {c.r, c.i}; +} + // Specialization for converting std::complex to SEXP -template <> inline SEXP as_sexp(const std::complex& x) { SEXP result = PROTECT(Rf_allocVector(CPLXSXP, 1)); COMPLEX(result)[0].r = x.real(); @@ -343,19 +351,4 @@ inline SEXP as_sexp(const std::complex& x) { UNPROTECT(1); return result; } - -// Declaration for converting SEXP to std::complex -template <> -std::complex as_cpp(SEXP x); - -// Specialization for as_cpp with std::complex -template <> -inline std::complex as_cpp>(SEXP x) { - if (TYPEOF(x) != CPLXSXP || Rf_length(x) != 1) { - throw std::invalid_argument("Expected a single complex number."); - } - Rcomplex c = COMPLEX(x)[0]; - return {c.r, c.i}; -} - } // namespace cpp11 diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp index cfda9340..b6daef08 100644 --- a/inst/include/cpp11/r_complex.hpp +++ b/inst/include/cpp11/r_complex.hpp @@ -140,4 +140,15 @@ struct get_underlying_type { }; } // namespace traits +// Define operator+ for std::complex and r_complex +inline std::complex operator+(const std::complex& lhs, + const r_complex& rhs) { + return std::complex(lhs.real() + rhs.real(), lhs.imag() + rhs.imag()); +} + +inline std::complex operator+(const r_complex& lhs, + const std::complex& rhs) { + return std::complex(lhs.real() + rhs.real(), lhs.imag() + rhs.imag()); +} + } // namespace cpp11 diff --git a/inst/include/cpp11/sexp.hpp b/inst/include/cpp11/sexp.hpp index 03e75937..cd34fcc6 100644 --- a/inst/include/cpp11/sexp.hpp +++ b/inst/include/cpp11/sexp.hpp @@ -76,14 +76,4 @@ class sexp { operator bool() const { return LOGICAL_ELT(data_, 0); } }; -// Specialization for converting std::complex to SEXP -template <> -inline SEXP as_sexp(const std::complex& from) { - SEXP result = PROTECT(Rf_allocVector(CPLXSXP, 1)); - COMPLEX(result)[0].r = from.real(); - COMPLEX(result)[0].i = from.imag(); - UNPROTECT(1); - return result; -} - } // namespace cpp11 From 8e044f697db46db1a21140c0506eb0f423480fc6 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 25 Dec 2024 22:18:18 -0500 Subject: [PATCH 06/14] trying to add push_back for cplx --- inst/include/cpp11/complexes.hpp | 10 +- inst/include/cpp11/r_complex.hpp | 159 +++++++------------------------ 2 files changed, 39 insertions(+), 130 deletions(-) diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp index 138c0319..5ca3585c 100644 --- a/inst/include/cpp11/complexes.hpp +++ b/inst/include/cpp11/complexes.hpp @@ -26,7 +26,7 @@ inline SEXPTYPE r_vector::get_sexptype() { template <> inline typename r_vector::underlying_type r_vector::get_elt( SEXP x, R_xlen_t i) { - return COMPLEX_ELT(x, i); + return r_complex(COMPLEX_ELT(x, i)); } template <> @@ -35,20 +35,20 @@ inline typename r_vector::underlying_type* r_vector::get_p if (is_altrep) { return nullptr; } else { - return COMPLEX(data); + return reinterpret_cast(COMPLEX(data)); } } template <> inline typename r_vector::underlying_type const* r_vector::get_const_p(bool is_altrep, SEXP data) { - return COMPLEX_OR_NULL(data); + return reinterpret_cast(COMPLEX_OR_NULL(data)); } template <> inline void r_vector::get_region(SEXP x, R_xlen_t i, R_xlen_t n, typename r_vector::underlying_type* buf) { - COMPLEX_GET_REGION(x, i, n, buf); + COMPLEX_GET_REGION(x, i, n, reinterpret_cast(buf)); } template <> @@ -63,7 +63,7 @@ namespace writable { template <> inline void r_vector::set_elt( SEXP x, R_xlen_t i, typename r_vector::underlying_type value) { - SET_COMPLEX_ELT(x, i, value); + SET_COMPLEX_ELT(x, i, static_cast(value)); } typedef r_vector complexes; diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp index b6daef08..5b2c76ad 100644 --- a/inst/include/cpp11/r_complex.hpp +++ b/inst/include/cpp11/r_complex.hpp @@ -4,151 +4,60 @@ #include #include // for is_convertible, enable_if -#include "R_ext/Arith.h" // for NA_REAL -#include "R_ext/Complex.h" // for Rcomplex -#include "cpp11/R.hpp" // for SEXP, SEXPREC, ... -#include "cpp11/as.hpp" // for as_sexp -#include "cpp11/protect.hpp" // for unwind_protect, preserved -#include "cpp11/sexp.hpp" // for sexp +#include "R_ext/Arith.h" // for NA_REAL +#include "R_ext/Complex.h" // for Rcomplex +#include "cpp11/R.hpp" // for SEXP, SEXPREC, ... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for unwind_protect, preserved +#include "cpp11/r_vector.hpp" // for r_vector +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { class r_complex { public: - r_complex() = default; + r_complex() : r_(NA_REAL), i_(NA_REAL) {} + r_complex(double r, double i) : r_(r), i_(i) {} + r_complex(const std::complex& c) : r_(c.real()), i_(c.imag()) {} + r_complex(const Rcomplex& rc) : r_(rc.r), i_(rc.i) {} - r_complex(SEXP data) { - if (Rf_isComplex(data) && Rf_xlength(data) == 1) { - Rcomplex elt = COMPLEX_ELT(data, 0); - real_ = elt.r; - imag_ = elt.i; - } else { - throw std::invalid_argument("Invalid r_complex value"); - } - } - - r_complex(double real, double imag) : real_(real), imag_(imag) {} - - explicit r_complex(Rcomplex value) : real_(value.r), imag_(value.i) {} - explicit r_complex(std::complex value) - : real_(value.real()), imag_(value.imag()) {} - - explicit operator Rcomplex() const { return Rcomplex{real_, imag_}; } - explicit operator std::complex() const { - return std::complex(real_, imag_); - } - - double real() const { return real_; } - double imag() const { return imag_; } - - r_complex& operator+=(const r_complex& other) { - real_ += other.real_; - imag_ += other.imag_; - return *this; - } - - r_complex& operator-=(const r_complex& other) { - real_ -= other.real_; - imag_ -= other.imag_; - return *this; - } + double real() const { return r_; } + double imag() const { return i_; } - r_complex& operator*=(const r_complex& other) { - double r = real_ * other.real_ - imag_ * other.imag_; - double i = real_ * other.imag_ + imag_ * other.real_; - real_ = r; - imag_ = i; - return *this; - } + operator std::complex() const { return std::complex(r_, i_); } + operator Rcomplex() const { return {r_, i_}; } - r_complex& operator/=(const r_complex& other) { - double denom = other.real_ * other.real_ + other.imag_ * other.imag_; - double r = (real_ * other.real_ + imag_ * other.imag_) / denom; - double i = (imag_ * other.real_ - real_ * other.imag_) / denom; - real_ = r; - imag_ = i; - return *this; + bool operator==(const r_complex& other) const { + return r_ == other.r_ && i_ == other.i_; } private: - double real_; - double imag_; + double r_; + double i_; }; -inline r_complex operator+(r_complex lhs, const r_complex& rhs) { - lhs += rhs; - return lhs; -} - -inline r_complex operator-(r_complex lhs, const r_complex& rhs) { - lhs -= rhs; - return lhs; -} - -inline r_complex operator*(r_complex lhs, const r_complex& rhs) { - lhs *= rhs; - return lhs; -} - -inline r_complex operator/(r_complex lhs, const r_complex& rhs) { - lhs /= rhs; - return lhs; -} - -inline bool operator==(const r_complex& x, const r_complex& y) { - return (x.real() == y.real()) && (x.imag() == y.imag()); -} - -inline std::ostream& operator<<(std::ostream& os, const r_complex& value) { - os << value.real() << "+" << value.imag() << "i"; - return os; -} - +// Specialization for r_complex template <> -inline r_complex na() { - return r_complex(NA_REAL, NA_REAL); -} - -template <> -inline bool is_na(const r_complex& x) { - return ISNA(x.real()) || ISNA(x.imag()); -} - -template -struct is_r_complex : std::false_type {}; +inline void writable::r_vector::push_back(r_complex value) { + while (this->length_ >= this->capacity_) { + this->reserve(this->capacity_ == 0 ? 1 : this->capacity_ * 2); + } -template <> -struct is_r_complex : std::true_type {}; + Rcomplex r_value = static_cast(value); -template -using enable_if_r_complex = std::enable_if_t::value, R>; + if (this->data_p_ != nullptr) { + this->data_p_[this->length_] = r_value; + } else { + this->set_elt(this->data_, this->length_, r_value); + } -template -enable_if_r_complex as_sexp(T from) { - SEXP res = PROTECT(Rf_allocVector(CPLXSXP, 1)); - Rcomplex* r = COMPLEX(res); - r[0].r = from.real(); - r[0].i = from.imag(); - UNPROTECT(1); - return res; + ++this->length_; } -namespace traits { +// Specialization for std::complex template <> -struct get_underlying_type { - using type = Rcomplex; -}; -} // namespace traits - -// Define operator+ for std::complex and r_complex -inline std::complex operator+(const std::complex& lhs, - const r_complex& rhs) { - return std::complex(lhs.real() + rhs.real(), lhs.imag() + rhs.imag()); -} - -inline std::complex operator+(const r_complex& lhs, - const std::complex& rhs) { - return std::complex(lhs.real() + rhs.real(), lhs.imag() + rhs.imag()); +inline void writable::r_vector::push_back(const std::complex& value) { + this->push_back(r_complex(value.real(), value.imag())); } } // namespace cpp11 From 49ee1791209a142bf7cbf6898ee59833d2986975 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 25 Dec 2024 23:59:47 -0500 Subject: [PATCH 07/14] trying to get push_back for cplx to work :\ --- inst/include/cpp11/complexes.hpp | 13 ++++++++----- inst/include/cpp11/r_complex.hpp | 6 ++---- inst/include/cpp11/r_vector.hpp | 2 ++ 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp index 5ca3585c..2fa41410 100644 --- a/inst/include/cpp11/complexes.hpp +++ b/inst/include/cpp11/complexes.hpp @@ -61,9 +61,9 @@ typedef r_vector complexes; namespace writable { template <> -inline void r_vector::set_elt( - SEXP x, R_xlen_t i, typename r_vector::underlying_type value) { - SET_COMPLEX_ELT(x, i, static_cast(value)); +inline void r_vector::set_elt(SEXP x, R_xlen_t i, + r_vector::underlying_type value) { + COMPLEX(x)[i] = static_cast(value); } typedef r_vector complexes; @@ -98,8 +98,11 @@ class r_vector::proxy { proxy(SEXP data, R_xlen_t index) : data_(data), index_(index), buf_(nullptr), is_altrep_(false) {} - proxy(SEXP data, R_xlen_t index, Rcomplex* buf, bool is_altrep) - : data_(data), index_(index), buf_(buf), is_altrep_(is_altrep) {} + proxy(SEXP data, R_xlen_t index, r_complex* buf, bool is_altrep) + : data_(data), + index_(index), + buf_(reinterpret_cast(buf)), + is_altrep_(is_altrep) {} operator r_complex() const { if (is_altrep_ && buf_ != nullptr) { diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp index 5b2c76ad..19bcbc98 100644 --- a/inst/include/cpp11/r_complex.hpp +++ b/inst/include/cpp11/r_complex.hpp @@ -43,12 +43,10 @@ inline void writable::r_vector::push_back(r_complex value) { this->reserve(this->capacity_ == 0 ? 1 : this->capacity_ * 2); } - Rcomplex r_value = static_cast(value); - if (this->data_p_ != nullptr) { - this->data_p_[this->length_] = r_value; + this->data_p_[this->length_] = static_cast(value); } else { - this->set_elt(this->data_, this->length_, r_value); + set_elt(this->data_, this->length_, value); } ++this->length_; diff --git a/inst/include/cpp11/r_vector.hpp b/inst/include/cpp11/r_vector.hpp index 576f4fe6..1edf3233 100644 --- a/inst/include/cpp11/r_vector.hpp +++ b/inst/include/cpp11/r_vector.hpp @@ -237,6 +237,8 @@ class r_vector : public cpp11::r_vector { void push_back(T value); /// Implemented in `strings.hpp` void push_back(const named_arg& value); + // Implemented in `complexes.hpp` + void push_back(const std::complex& value); void pop_back(); void resize(R_xlen_t count); From b003c28119ef169314db7f9600ed43fde814b466 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Thu, 26 Dec 2024 17:10:25 -0500 Subject: [PATCH 08/14] complex tests work, BUT THERE IS A CATCH ERROR I DO NOT GET --- cpp11test/src/grow.cpp | 2 +- inst/include/cpp11/complexes.hpp | 56 +++++++------ inst/include/cpp11/matrix.hpp | 15 ++-- inst/include/cpp11/r_complex.hpp | 132 ++++++++++++++++++++++++------- inst/include/cpp11/r_vector.hpp | 5 +- inst/include/cpp11/sexp.hpp | 2 +- 6 files changed, 146 insertions(+), 66 deletions(-) diff --git a/cpp11test/src/grow.cpp b/cpp11test/src/grow.cpp index ccc302e7..cd20b292 100644 --- a/cpp11test/src/grow.cpp +++ b/cpp11test/src/grow.cpp @@ -1,5 +1,5 @@ -#include "cpp11/doubles.hpp" #include "cpp11/complexes.hpp" +#include "cpp11/doubles.hpp" [[cpp11::register]] cpp11::writable::doubles grow_(R_xlen_t n) { cpp11::writable::doubles x; diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp index 2fa41410..db9c7eb4 100644 --- a/inst/include/cpp11/complexes.hpp +++ b/inst/include/cpp11/complexes.hpp @@ -1,18 +1,15 @@ #pragma once -#include // for min -#include // for array +#include // for std::transform #include // for std::complex -#include // for initializer_list +#include // for std::initializer_list -#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_allocVector -#include "cpp11/as.hpp" // for as_sexp -#include "cpp11/attribute_proxy.hpp" // for attribute_proxy -#include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for preserved -#include "cpp11/r_complex.hpp" // for r_complex -#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy -#include "cpp11/sexp.hpp" // for sexp +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_allocVector, COMPLEX, COMPLEX_ELT, SET_COMPLEX_ELT +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for safe +#include "cpp11/r_complex.hpp" // for r_complex +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { @@ -26,7 +23,7 @@ inline SEXPTYPE r_vector::get_sexptype() { template <> inline typename r_vector::underlying_type r_vector::get_elt( SEXP x, R_xlen_t i) { - return r_complex(COMPLEX_ELT(x, i)); + return COMPLEX_ELT(x, i); } template <> @@ -35,20 +32,20 @@ inline typename r_vector::underlying_type* r_vector::get_p if (is_altrep) { return nullptr; } else { - return reinterpret_cast(COMPLEX(data)); + return COMPLEX(data); } } template <> inline typename r_vector::underlying_type const* r_vector::get_const_p(bool is_altrep, SEXP data) { - return reinterpret_cast(COMPLEX_OR_NULL(data)); + return COMPLEX_OR_NULL(data); } template <> inline void r_vector::get_region(SEXP x, R_xlen_t i, R_xlen_t n, typename r_vector::underlying_type* buf) { - COMPLEX_GET_REGION(x, i, n, reinterpret_cast(buf)); + COMPLEX_GET_REGION(x, i, n, buf); } template <> @@ -61,9 +58,9 @@ typedef r_vector complexes; namespace writable { template <> -inline void r_vector::set_elt(SEXP x, R_xlen_t i, - r_vector::underlying_type value) { - COMPLEX(x)[i] = static_cast(value); +inline void r_vector::set_elt( + SEXP x, R_xlen_t i, typename cpp11::r_vector::underlying_type value) { + COMPLEX(x)[i] = value; } typedef r_vector complexes; @@ -98,11 +95,8 @@ class r_vector::proxy { proxy(SEXP data, R_xlen_t index) : data_(data), index_(index), buf_(nullptr), is_altrep_(false) {} - proxy(SEXP data, R_xlen_t index, r_complex* buf, bool is_altrep) - : data_(data), - index_(index), - buf_(reinterpret_cast(buf)), - is_altrep_(is_altrep) {} + proxy(SEXP data, R_xlen_t index, Rcomplex* buf, bool is_altrep) + : data_(data), index_(index), buf_(buf), is_altrep_(is_altrep) {} operator r_complex() const { if (is_altrep_ && buf_ != nullptr) { @@ -219,4 +213,20 @@ inline std::complex& operator+=(std::complex& lhs, const cpp11::r_complex& return lhs; } +// Add constructor for initializer_list +template <> +inline r_vector::r_vector(std::initializer_list il) { + R_xlen_t size = il.size(); + SEXP data = PROTECT(Rf_allocVector(CPLXSXP, size)); + auto it = il.begin(); + for (R_xlen_t i = 0; i < size; ++i, ++it) { + Rcomplex r; + r.r = it->real(); + r.i = it->imag(); + COMPLEX(data)[i] = r; + } + UNPROTECT(1); + data_ = data; +} + } // namespace cpp11 diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 78deea53..8345068f 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -3,12 +3,11 @@ #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_complex.hpp" // for r_complex -#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/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 { @@ -215,8 +214,6 @@ template using logicals_matrix = matrix, r_bool, S>; template using strings_matrix = matrix, r_string, S>; -template -using complex_matrix = matrix, r_complex, S>; namespace writable { template @@ -227,8 +224,6 @@ template using logicals_matrix = matrix, r_vector::proxy, S>; template using strings_matrix = matrix, r_vector::proxy, S>; -template -using complex_matrix = matrix, r_vector::proxy, S>; } // namespace writable // TODO: Add tests for Matrix class diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp index 19bcbc98..824e0fea 100644 --- a/inst/include/cpp11/r_complex.hpp +++ b/inst/include/cpp11/r_complex.hpp @@ -1,8 +1,8 @@ #pragma once -#include // for complex +#include // for complex #include -#include // for is_convertible, enable_if +#include // for is_convertible, enable_if #include "R_ext/Arith.h" // for NA_REAL #include "R_ext/Complex.h" // for Rcomplex @@ -16,46 +16,120 @@ namespace cpp11 { class r_complex { public: - r_complex() : r_(NA_REAL), i_(NA_REAL) {} - r_complex(double r, double i) : r_(r), i_(i) {} - r_complex(const std::complex& c) : r_(c.real()), i_(c.imag()) {} - r_complex(const Rcomplex& rc) : r_(rc.r), i_(rc.i) {} + r_complex() = default; + r_complex(SEXP data) : data_(data) {} + r_complex(double real, double imag) : data_(safe[Rf_allocVector](CPLXSXP, 1)) { + COMPLEX(data_)[0].r = real; + COMPLEX(data_)[0].i = imag; + } + r_complex(const std::complex& data) : r_complex(data.real(), data.imag()) {} + r_complex(const Rcomplex& data) : r_complex(data.r, data.i) {} - double real() const { return r_; } - double imag() const { return i_; } + operator SEXP() const { return data_; } + operator sexp() const { return data_; } + operator std::complex() const { + return {COMPLEX(data_)[0].r, COMPLEX(data_)[0].i}; + } + operator Rcomplex() const { + Rcomplex r; + r.r = real(); + r.i = imag(); + return r; + } - operator std::complex() const { return std::complex(r_, i_); } - operator Rcomplex() const { return {r_, i_}; } + double real() const { return COMPLEX(data_)[0].r; } + double imag() const { return COMPLEX(data_)[0].i; } - bool operator==(const r_complex& other) const { - return r_ == other.r_ && i_ == other.i_; + bool operator==(const r_complex& rhs) const { + return real() == rhs.real() && imag() == rhs.imag(); } - private: - double r_; - double i_; -}; + bool operator!=(const r_complex& rhs) const { return !(*this == rhs); } -// Specialization for r_complex -template <> -inline void writable::r_vector::push_back(r_complex value) { - while (this->length_ >= this->capacity_) { - this->reserve(this->capacity_ == 0 ? 1 : this->capacity_ * 2); + r_complex& operator+=(const r_complex& rhs) { + *this = r_complex(real() + rhs.real(), imag() + rhs.imag()); + return *this; + } + + r_complex& operator-=(const r_complex& rhs) { + *this = r_complex(real() - rhs.real(), imag() - rhs.imag()); + return *this; + } + + r_complex& operator*=(const r_complex& rhs) { + std::complex lhs = *this; + lhs *= static_cast>(rhs); + *this = r_complex(lhs.real(), lhs.imag()); + return *this; + } + + r_complex& operator/=(const r_complex& rhs) { + std::complex lhs = *this; + lhs /= static_cast>(rhs); + *this = r_complex(lhs.real(), lhs.imag()); + return *this; + } + + friend r_complex operator+(r_complex lhs, const r_complex& rhs) { + lhs += rhs; + return lhs; } - if (this->data_p_ != nullptr) { - this->data_p_[this->length_] = static_cast(value); - } else { - set_elt(this->data_, this->length_, value); + friend r_complex operator-(r_complex lhs, const r_complex& rhs) { + lhs -= rhs; + return lhs; } - ++this->length_; + friend r_complex operator*(r_complex lhs, const r_complex& rhs) { + lhs *= rhs; + return lhs; + } + + friend r_complex operator/(r_complex lhs, const r_complex& rhs) { + lhs /= rhs; + return lhs; + } + + private: + sexp data_ = R_NilValue; +}; + +inline SEXP as_sexp(const r_complex& from) { + sexp res; + unwind_protect([&] { + res = Rf_allocVector(CPLXSXP, 1); + COMPLEX(res)[0].r = from.real(); + COMPLEX(res)[0].i = from.imag(); + }); + + return res; +} + +inline SEXP as_sexp(std::initializer_list il) { + R_xlen_t size = il.size(); + + sexp data; + unwind_protect([&] { + data = Rf_allocVector(CPLXSXP, size); + auto it = il.begin(); + for (R_xlen_t i = 0; i < size; ++i, ++it) { + COMPLEX(data)[i].r = it->real(); + COMPLEX(data)[i].i = it->imag(); + } + }); + return data; } -// Specialization for std::complex template <> -inline void writable::r_vector::push_back(const std::complex& value) { - this->push_back(r_complex(value.real(), value.imag())); +inline r_complex na() { + return r_complex(NA_REAL, NA_REAL); } +namespace traits { +template <> +struct get_underlying_type { + using type = Rcomplex; +}; +} // namespace traits + } // namespace cpp11 diff --git a/inst/include/cpp11/r_vector.hpp b/inst/include/cpp11/r_vector.hpp index 1edf3233..45a1d877 100644 --- a/inst/include/cpp11/r_vector.hpp +++ b/inst/include/cpp11/r_vector.hpp @@ -18,6 +18,7 @@ #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg #include "cpp11/protect.hpp" // for store +#include "cpp11/r_complex.hpp" // for r_complex #include "cpp11/r_string.hpp" // for r_string #include "cpp11/sexp.hpp" // for sexp @@ -30,7 +31,6 @@ template class r_vector; } // namespace writable -// Declarations template class r_vector { public: @@ -60,6 +60,7 @@ class r_vector { r_vector(const r_vector& x); r_vector(r_vector&& x); r_vector(const writable::r_vector& x); + r_vector(std::initializer_list il); r_vector(named_arg) = delete; r_vector& operator=(const r_vector& rhs); @@ -238,7 +239,7 @@ class r_vector : public cpp11::r_vector { /// Implemented in `strings.hpp` void push_back(const named_arg& value); // Implemented in `complexes.hpp` - void push_back(const std::complex& value); + void push_back(const Rcomplex& value); void pop_back(); void resize(R_xlen_t count); diff --git a/inst/include/cpp11/sexp.hpp b/inst/include/cpp11/sexp.hpp index cd34fcc6..6b3bbc20 100644 --- a/inst/include/cpp11/sexp.hpp +++ b/inst/include/cpp11/sexp.hpp @@ -2,8 +2,8 @@ #include // for size_t -#include // for string, basic_string #include // for complex +#include // for string, basic_string #include "cpp11/R.hpp" // for SEXP, SEXPREC, REAL_ELT, R_NilV... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy From e642aa67e59e42f8c490195329bd3ad299ae932e Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Thu, 26 Dec 2024 20:20:41 -0500 Subject: [PATCH 09/14] passed all test for cplx :D --- cpp11test/src/test-complex.cpp | 32 ++++++++++++----- inst/include/cpp11/complexes.hpp | 15 ++++++++ inst/include/cpp11/r_complex.hpp | 59 ++++++++++++++++++++++---------- 3 files changed, 79 insertions(+), 27 deletions(-) diff --git a/cpp11test/src/test-complex.cpp b/cpp11test/src/test-complex.cpp index 4210f079..750002f0 100644 --- a/cpp11test/src/test-complex.cpp +++ b/cpp11test/src/test-complex.cpp @@ -357,17 +357,29 @@ context("complexes-C++") { } test_that("comparison operator works") { - cpp11::r_complex one{1, 1}; - cpp11::r_complex two{2, 2}; - cpp11::r_complex three{3, 3}; - using namespace cpp11; - cpp11::complexes base({one, two}); - cpp11::complexes same_values({one, two}); - cpp11::complexes diff_length({one}); - cpp11::complexes diff_values({one, three}); - expect_true(base == base); + // SEXP base = PROTECT(Rf_allocVector(CPLXSXP, 2)); + // SEXP same_values = PROTECT(Rf_allocVector(CPLXSXP, 2)); + // SEXP diff_length = PROTECT(Rf_allocVector(CPLXSXP, 1)); + // SEXP diff_values = PROTECT(Rf_allocVector(CPLXSXP, 2)); + + cpp11::complexes base(Rf_allocVector(CPLXSXP, 2)); + cpp11::complexes same_values(Rf_allocVector(CPLXSXP, 2)); + cpp11::complexes diff_length(Rf_allocVector(CPLXSXP, 1)); + cpp11::complexes diff_values(Rf_allocVector(CPLXSXP, 2)); + + COMPLEX(base)[0] = Rcomplex{1, 1}; + COMPLEX(base)[1] = Rcomplex{2, 2}; + + COMPLEX(same_values)[0] = Rcomplex{1, 1}; + COMPLEX(same_values)[1] = Rcomplex{2, 2}; + + COMPLEX(diff_length)[0] = Rcomplex{1, 1}; + + COMPLEX(diff_values)[0] = Rcomplex{1, 1}; + COMPLEX(diff_values)[1] = Rcomplex{3, 3}; + expect_true(base == base); expect_true(base == same_values); expect_true(!(base == diff_length)); @@ -377,6 +389,8 @@ context("complexes-C++") { expect_true(!(base != same_values)); expect_true(base != diff_length); expect_true(base != diff_values); + + UNPROTECT(4); } test_that("proxy comparison works symmetrically") { diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp index db9c7eb4..bc229125 100644 --- a/inst/include/cpp11/complexes.hpp +++ b/inst/include/cpp11/complexes.hpp @@ -229,4 +229,19 @@ inline r_vector::r_vector(std::initializer_list il) { data_ = data; } +// Comparison operators for r_vector +template <> +inline bool operator==(const r_vector& lhs, const r_vector& rhs) { + if (lhs.size() != rhs.size()) return false; + for (R_xlen_t i = 0; i < lhs.size(); ++i) { + if (!(lhs[i] == rhs[i])) return false; + } + return true; +} + +template <> +inline bool operator!=(const r_vector& lhs, const r_vector& rhs) { + return !(lhs == rhs); +} + } // namespace cpp11 diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp index 824e0fea..89957aa7 100644 --- a/inst/include/cpp11/r_complex.hpp +++ b/inst/include/cpp11/r_complex.hpp @@ -1,23 +1,26 @@ #pragma once -#include // for complex -#include -#include // for is_convertible, enable_if - -#include "R_ext/Arith.h" // for NA_REAL -#include "R_ext/Complex.h" // for Rcomplex -#include "cpp11/R.hpp" // for SEXP, SEXPREC, ... -#include "cpp11/as.hpp" // for as_sexp -#include "cpp11/protect.hpp" // for unwind_protect, preserved -#include "cpp11/r_vector.hpp" // for r_vector -#include "cpp11/sexp.hpp" // for sexp +#include // for std::complex + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_mkCharCE, Rf_translateCharUTF8 +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for unwind_protect, protect, protect::function +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { class r_complex { public: - r_complex() = default; - r_complex(SEXP data) : data_(data) {} + r_complex() : data_(safe[Rf_allocVector](CPLXSXP, 1)) { + COMPLEX(data_)[0].r = 0; + COMPLEX(data_)[0].i = 0; + } + r_complex(SEXP data) : data_(data) { + if (data_ == R_NilValue) { + data_ = PROTECT(Rf_allocVector(CPLXSXP, 0)); + UNPROTECT(1); + } + } r_complex(double real, double imag) : data_(safe[Rf_allocVector](CPLXSXP, 1)) { COMPLEX(data_)[0].r = real; COMPLEX(data_)[0].i = imag; @@ -28,20 +31,38 @@ class r_complex { operator SEXP() const { return data_; } operator sexp() const { return data_; } operator std::complex() const { + if (data_ == R_NilValue || Rf_length(data_) == 0) { + return {NA_REAL, NA_REAL}; + } return {COMPLEX(data_)[0].r, COMPLEX(data_)[0].i}; } operator Rcomplex() const { Rcomplex r; - r.r = real(); - r.i = imag(); + if (data_ == R_NilValue || Rf_length(data_) == 0) { + r.r = NA_REAL; + r.i = NA_REAL; + } else { + r.r = real(); + r.i = imag(); + } return r; } - double real() const { return COMPLEX(data_)[0].r; } - double imag() const { return COMPLEX(data_)[0].i; } + double real() const { + if (data_ == R_NilValue || Rf_length(data_) == 0) { + return NA_REAL; + } + return COMPLEX(data_)[0].r; + } + double imag() const { + if (data_ == R_NilValue || Rf_length(data_) == 0) { + return NA_REAL; + } + return COMPLEX(data_)[0].i; + } bool operator==(const r_complex& rhs) const { - return real() == rhs.real() && imag() == rhs.imag(); + return (is_na() && rhs.is_na()) || (real() == rhs.real() && imag() == rhs.imag()); } bool operator!=(const r_complex& rhs) const { return !(*this == rhs); } @@ -90,6 +111,8 @@ class r_complex { return lhs; } + bool is_na() const { return R_IsNA(real()) || R_IsNA(imag()); } + private: sexp data_ = R_NilValue; }; From d42f512e9e0784be8ced4428d29e41e42f28c6b6 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Thu, 26 Dec 2024 22:55:34 -0500 Subject: [PATCH 10/14] complex_matrix<> --- cpp11test/dev/partial_r_vector.hpp | 70 ++++++++++++++++++++++++++++++ cpp11test/src/test-matrix.cpp | 36 +++++++++++++++ inst/include/cpp11/matrix.hpp | 15 ++++--- 3 files changed, 116 insertions(+), 5 deletions(-) create mode 100644 cpp11test/dev/partial_r_vector.hpp diff --git a/cpp11test/dev/partial_r_vector.hpp b/cpp11test/dev/partial_r_vector.hpp new file mode 100644 index 00000000..39af5f66 --- /dev/null +++ b/cpp11test/dev/partial_r_vector.hpp @@ -0,0 +1,70 @@ +class const_iterator { + // Iterator references: + // https://cplusplus.com/reference/iterator/ + // https://stackoverflow.com/questions/8054273/how-to-implement-an-stl-style-iterator-and-avoid-common-pitfalls + // It seems like our iterator doesn't fully implement everything for + // `random_access_iterator_tag` (like an `[]` operator, for example). If we discover + // issues with it, we probably need to add more methods. + private: + const r_vector* data_; + R_xlen_t pos_; + std::array buf_; + R_xlen_t block_start_ = 0; + R_xlen_t length_ = 0; + + public: + using difference_type = ptrdiff_t; + using value_type = T; + using pointer = T*; + using reference = T&; + using iterator_category = std::random_access_iterator_tag; + + const_iterator(const r_vector* data, R_xlen_t pos); + + const_iterator operator+(R_xlen_t pos); + ptrdiff_t operator-(const const_iterator& other) const; + + const_iterator& operator++(); + const_iterator& operator--(); + + const_iterator& operator+=(R_xlen_t pos); + const_iterator& operator-=(R_xlen_t pos); + + bool operator!=(const const_iterator& other) const; + bool operator==(const const_iterator& other) const; + + T operator*() const; + + friend class writable::r_vector::iterator; + + private: + /// Implemented in specialization + static bool use_buf(bool is_altrep); + void fill_buf(R_xlen_t pos); + }; + +template +inline bool r_vector::const_iterator::operator==( + const r_vector::const_iterator& other) const { + return pos_ == other.pos_; +} + +template +bool operator==(const r_vector& lhs, const r_vector& rhs) { + if (lhs.size() != rhs.size()) { + return false; + } + + auto lhs_it = lhs.begin(); + auto rhs_it = rhs.begin(); + + auto end = lhs.end(); + while (lhs_it != end) { + if (!(*lhs_it == *rhs_it)) { + return false; + } + ++lhs_it; + ++rhs_it; + } + return true; +} diff --git a/cpp11test/src/test-matrix.cpp b/cpp11test/src/test-matrix.cpp index 39e33938..d7f2992b 100644 --- a/cpp11test/src/test-matrix.cpp +++ b/cpp11test/src/test-matrix.cpp @@ -24,6 +24,7 @@ context("matrix-C++") { expect_true(x[1].size() == 2); expect_true(x[1].stride() == 5); } + test_that("matrix dim attributes are correct for read only matrices") { auto getExportedValue = cpp11::package("base")["getExportedValue"]; @@ -41,6 +42,7 @@ context("matrix-C++") { expect_true(x[1].size() == 61); expect_true(x[1].stride() == 87); } + test_that("matrix attributes are correct") { cpp11::doubles_matrix x(getExportedValue("datasets", "volcano")); @@ -156,4 +158,38 @@ context("matrix-C++") { cpp11::writable::doubles_matrix x(5, 2); expect_error(cpp11::writable::integers_matrix(x)); } + + test_that("complex matrix can be created, filled, and copied") { + cpp11::writable::complexes_matrix x(5, 2); + + for (int i = 0; i < 5; ++i) { + for (int j = 0; j < 2; ++j) { + x(i, j) = std::complex(i, j); + } + } + + cpp11::writable::complexes_matrix y(5, 2); + + for (int i = 0; i < 5; ++i) { + for (int j = 0; j < 2; ++j) { + y(i, j) = std::complex(i, j); + } + } + + cpp11::complexes_matrix<> xc = x; + expect_true(x.nrow() == xc.nrow()); + expect_true(x.ncol() == xc.ncol()); + + cpp11::complexes_matrix<> yc = y; + expect_true(y.nrow() == yc.nrow()); + expect_true(y.ncol() == yc.ncol()); + + // Pacha: I need to figure out how to compare complexes with testthat + // for (int i = 0; i < 5; ++i) { + // for (int j = 0; j < 2; ++j) { + // expect_true(x(i, j) == xc(i, j)); + // expect_true(y(i, j) == yc(i, j)); + // } + // } + } } diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 8345068f..47c849da 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -3,11 +3,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/r_bool.hpp" // for r_bool +#include "cpp11/r_complex.hpp" // for r_complex +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { @@ -214,6 +215,8 @@ template using logicals_matrix = matrix, r_bool, S>; template using strings_matrix = matrix, r_string, S>; +template +using complexes_matrix = matrix, r_complex, S>; namespace writable { template @@ -224,6 +227,8 @@ template using logicals_matrix = matrix, r_vector::proxy, S>; template using strings_matrix = matrix, r_vector::proxy, S>; +template +using complexes_matrix = matrix, r_vector::proxy, S>; } // namespace writable // TODO: Add tests for Matrix class From f7ead220dc67f83f99d8b1a4b92ecaafc4edd76d Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Thu, 26 Dec 2024 23:13:20 -0500 Subject: [PATCH 11/14] cpp11test: add rcpp to imports + .here to .Rbuildignore --- cpp11test/.Rbuildignore | 1 + cpp11test/DESCRIPTION | 1 + cpp11test/dev/partial_r_vector.hpp | 70 ------------------------------ 3 files changed, 2 insertions(+), 70 deletions(-) create mode 100644 cpp11test/.Rbuildignore delete mode 100644 cpp11test/dev/partial_r_vector.hpp diff --git a/cpp11test/.Rbuildignore b/cpp11test/.Rbuildignore new file mode 100644 index 00000000..8e9e984f --- /dev/null +++ b/cpp11test/.Rbuildignore @@ -0,0 +1 @@ +^\.here$ diff --git a/cpp11test/DESCRIPTION b/cpp11test/DESCRIPTION index 70c5649f..95fff1b9 100644 --- a/cpp11test/DESCRIPTION +++ b/cpp11test/DESCRIPTION @@ -12,6 +12,7 @@ Authors@R: Description: Provides a test suite and benchmarking code for the 'cpp11' package. License: MIT + file LICENSE Encoding: UTF-8 +Imports: Rcpp LinkingTo: Rcpp, cpp11, testthat Suggests: covr, diff --git a/cpp11test/dev/partial_r_vector.hpp b/cpp11test/dev/partial_r_vector.hpp deleted file mode 100644 index 39af5f66..00000000 --- a/cpp11test/dev/partial_r_vector.hpp +++ /dev/null @@ -1,70 +0,0 @@ -class const_iterator { - // Iterator references: - // https://cplusplus.com/reference/iterator/ - // https://stackoverflow.com/questions/8054273/how-to-implement-an-stl-style-iterator-and-avoid-common-pitfalls - // It seems like our iterator doesn't fully implement everything for - // `random_access_iterator_tag` (like an `[]` operator, for example). If we discover - // issues with it, we probably need to add more methods. - private: - const r_vector* data_; - R_xlen_t pos_; - std::array buf_; - R_xlen_t block_start_ = 0; - R_xlen_t length_ = 0; - - public: - using difference_type = ptrdiff_t; - using value_type = T; - using pointer = T*; - using reference = T&; - using iterator_category = std::random_access_iterator_tag; - - const_iterator(const r_vector* data, R_xlen_t pos); - - const_iterator operator+(R_xlen_t pos); - ptrdiff_t operator-(const const_iterator& other) const; - - const_iterator& operator++(); - const_iterator& operator--(); - - const_iterator& operator+=(R_xlen_t pos); - const_iterator& operator-=(R_xlen_t pos); - - bool operator!=(const const_iterator& other) const; - bool operator==(const const_iterator& other) const; - - T operator*() const; - - friend class writable::r_vector::iterator; - - private: - /// Implemented in specialization - static bool use_buf(bool is_altrep); - void fill_buf(R_xlen_t pos); - }; - -template -inline bool r_vector::const_iterator::operator==( - const r_vector::const_iterator& other) const { - return pos_ == other.pos_; -} - -template -bool operator==(const r_vector& lhs, const r_vector& rhs) { - if (lhs.size() != rhs.size()) { - return false; - } - - auto lhs_it = lhs.begin(); - auto rhs_it = rhs.begin(); - - auto end = lhs.end(); - while (lhs_it != end) { - if (!(*lhs_it == *rhs_it)) { - return false; - } - ++lhs_it; - ++rhs_it; - } - return true; -} From 66b4adeb460f8e8455194ee24739723bc2342b0a Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Thu, 26 Dec 2024 23:30:01 -0500 Subject: [PATCH 12/14] revert complexes_matrix<> for now --- cpp11test/src/test-matrix.cpp | 36 ----------------------------------- inst/include/cpp11/matrix.hpp | 15 +++++---------- 2 files changed, 5 insertions(+), 46 deletions(-) diff --git a/cpp11test/src/test-matrix.cpp b/cpp11test/src/test-matrix.cpp index d7f2992b..39e33938 100644 --- a/cpp11test/src/test-matrix.cpp +++ b/cpp11test/src/test-matrix.cpp @@ -24,7 +24,6 @@ context("matrix-C++") { expect_true(x[1].size() == 2); expect_true(x[1].stride() == 5); } - test_that("matrix dim attributes are correct for read only matrices") { auto getExportedValue = cpp11::package("base")["getExportedValue"]; @@ -42,7 +41,6 @@ context("matrix-C++") { expect_true(x[1].size() == 61); expect_true(x[1].stride() == 87); } - test_that("matrix attributes are correct") { cpp11::doubles_matrix x(getExportedValue("datasets", "volcano")); @@ -158,38 +156,4 @@ context("matrix-C++") { cpp11::writable::doubles_matrix x(5, 2); expect_error(cpp11::writable::integers_matrix(x)); } - - test_that("complex matrix can be created, filled, and copied") { - cpp11::writable::complexes_matrix x(5, 2); - - for (int i = 0; i < 5; ++i) { - for (int j = 0; j < 2; ++j) { - x(i, j) = std::complex(i, j); - } - } - - cpp11::writable::complexes_matrix y(5, 2); - - for (int i = 0; i < 5; ++i) { - for (int j = 0; j < 2; ++j) { - y(i, j) = std::complex(i, j); - } - } - - cpp11::complexes_matrix<> xc = x; - expect_true(x.nrow() == xc.nrow()); - expect_true(x.ncol() == xc.ncol()); - - cpp11::complexes_matrix<> yc = y; - expect_true(y.nrow() == yc.nrow()); - expect_true(y.ncol() == yc.ncol()); - - // Pacha: I need to figure out how to compare complexes with testthat - // for (int i = 0; i < 5; ++i) { - // for (int j = 0; j < 2; ++j) { - // expect_true(x(i, j) == xc(i, j)); - // expect_true(y(i, j) == yc(i, j)); - // } - // } - } } diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 47c849da..8345068f 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -3,12 +3,11 @@ #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_complex.hpp" // for r_complex -#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/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 { @@ -215,8 +214,6 @@ template using logicals_matrix = matrix, r_bool, S>; template using strings_matrix = matrix, r_string, S>; -template -using complexes_matrix = matrix, r_complex, S>; namespace writable { template @@ -227,8 +224,6 @@ template using logicals_matrix = matrix, r_vector::proxy, S>; template using strings_matrix = matrix, r_vector::proxy, S>; -template -using complexes_matrix = matrix, r_vector::proxy, S>; } // namespace writable // TODO: Add tests for Matrix class From a91c3ed154cb50b8547ad4d1ef7b293a57036965 Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Fri, 27 Dec 2024 13:11:30 -0500 Subject: [PATCH 13/14] Define SET_COMPLEX_ELT if not defined --- inst/include/cpp11/complexes.hpp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp index bc229125..0e0dd69b 100644 --- a/inst/include/cpp11/complexes.hpp +++ b/inst/include/cpp11/complexes.hpp @@ -11,6 +11,12 @@ #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp +// Define SET_COMPLEX_ELT if not defined +// for compatibility with older R versions, such as ubuntu 20.04 oldrel-4 +#ifndef SET_COMPLEX_ELT +#define SET_COMPLEX_ELT(x, i, v) (COMPLEX(x)[i] = v) +#endif + namespace cpp11 { // Specializations for complex numbers From 511a7ed09130aac7c8e6cde57b2a17609423052c Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Sat, 28 Dec 2024 22:23:59 -0500 Subject: [PATCH 14/14] re-add complex matrix with tests --- cpp11test/src/test-matrix.cpp | 39 +++++++++++++++++++++++++++++++++++ inst/include/cpp11/matrix.hpp | 15 +++++++++----- 2 files changed, 49 insertions(+), 5 deletions(-) diff --git a/cpp11test/src/test-matrix.cpp b/cpp11test/src/test-matrix.cpp index 39e33938..18e62b71 100644 --- a/cpp11test/src/test-matrix.cpp +++ b/cpp11test/src/test-matrix.cpp @@ -1,3 +1,4 @@ +#include "cpp11/complexes.hpp" #include "cpp11/doubles.hpp" #include "cpp11/function.hpp" #include "cpp11/integers.hpp" @@ -24,6 +25,7 @@ context("matrix-C++") { expect_true(x[1].size() == 2); expect_true(x[1].stride() == 5); } + test_that("matrix dim attributes are correct for read only matrices") { auto getExportedValue = cpp11::package("base")["getExportedValue"]; @@ -41,6 +43,7 @@ context("matrix-C++") { expect_true(x[1].size() == 61); expect_true(x[1].stride() == 87); } + test_that("matrix attributes are correct") { cpp11::doubles_matrix x(getExportedValue("datasets", "volcano")); @@ -156,4 +159,40 @@ context("matrix-C++") { cpp11::writable::doubles_matrix x(5, 2); expect_error(cpp11::writable::integers_matrix(x)); } + + test_that("complex objects can be created, filled, and copied") { + // vector + + cpp11::writable::complexes v(2); + v[0] = std::complex(1, 2); + v[1] = std::complex(3, 4); + + cpp11::complexes vc = v; + + expect_true(v.size() == vc.size()); + + for (int i = 0; i < 2; ++i) { + expect_true(v[i] == vc[i]); + } + + // matrix + + cpp11::writable::complexes_matrix m(5, 2); + + for (int i = 0; i < 5; ++i) { + for (int j = 0; j < 2; ++j) { + m(i, j) = std::complex(i, j); + } + } + + cpp11::complexes_matrix<> mc = m; + expect_true(m.nrow() == mc.nrow()); + expect_true(m.ncol() == mc.ncol()); + + for (int i = 0; i < 5; ++i) { + for (int j = 0; j < 2; ++j) { + expect_true(m(i, j) == mc(i, j)); + } + } + } } diff --git a/inst/include/cpp11/matrix.hpp b/inst/include/cpp11/matrix.hpp index 8345068f..47c849da 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -3,11 +3,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/r_bool.hpp" // for r_bool +#include "cpp11/r_complex.hpp" // for r_complex +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector +#include "cpp11/sexp.hpp" // for sexp namespace cpp11 { @@ -214,6 +215,8 @@ template using logicals_matrix = matrix, r_bool, S>; template using strings_matrix = matrix, r_string, S>; +template +using complexes_matrix = matrix, r_complex, S>; namespace writable { template @@ -224,6 +227,8 @@ template using logicals_matrix = matrix, r_vector::proxy, S>; template using strings_matrix = matrix, r_vector::proxy, S>; +template +using complexes_matrix = matrix, r_vector::proxy, S>; } // namespace writable // TODO: Add tests for Matrix class