diff --git a/Makefile b/Makefile index 4b85c9f1..2a3dd692 100644 --- a/Makefile +++ b/Makefile @@ -3,8 +3,13 @@ all: @Rscript -e 'devtools::load_all("cpp11test")' @echo "make: Leaving directory 'cpp11test/src'" +install: + @Rscript -e 'devtools::document()' + @Rscript -e 'devtools::install()' + test: all - @echo "make: Entering directory 'cpp11test/tests/testthat'" + @echo "make: Entering directory 'cpp11test'" + @Rscript -e 'devtools::document("cpp11test")' @Rscript -e 'devtools::test("cpp11test")' @echo "make: Leaving directory 'cpp11test/tests/testthat'" 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..72c0e794 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) } @@ -156,6 +160,34 @@ rcpp_release_ <- function(n) { invisible(.Call(`_cpp11test_rcpp_release_`, n)) } +notroxcpp1_ <- function(x) { + .Call(`_cpp11test_notroxcpp1_`, x) +} + +roxcpp2_ <- function(x) { + .Call(`_cpp11test_roxcpp2_`, x) +} + +roxcpp3_ <- function(x) { + .Call(`_cpp11test_roxcpp3_`, x) +} + +roxcpp4_ <- function(x) { + .Call(`_cpp11test_roxcpp4_`, x) +} + +roxcpp5_ <- function(x) { + .Call(`_cpp11test_roxcpp5_`, x) +} + +notroxcpp6_ <- function(x) { + .Call(`_cpp11test_notroxcpp6_`, x) +} + +roxcpp7_ <- function(x) { + .Call(`_cpp11test_roxcpp7_`, x) +} + cpp11_safe_ <- function(x_sxp) { .Call(`_cpp11test_cpp11_safe_`, x_sxp) } @@ -196,6 +228,42 @@ 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_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 421de637..bac3a051 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) { @@ -303,6 +310,55 @@ extern "C" SEXP _cpp11test_rcpp_release_(SEXP n) { return R_NilValue; END_CPP11 } +// roxygen1.cpp +double notroxcpp1_(double x); +extern "C" SEXP _cpp11test_notroxcpp1_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(notroxcpp1_(cpp11::as_cpp>(x))); + END_CPP11 +} +// roxygen1.cpp +double roxcpp2_(double x); +extern "C" SEXP _cpp11test_roxcpp2_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(roxcpp2_(cpp11::as_cpp>(x))); + END_CPP11 +} +// roxygen2.cpp +double roxcpp3_(double x); +extern "C" SEXP _cpp11test_roxcpp3_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(roxcpp3_(cpp11::as_cpp>(x))); + END_CPP11 +} +// roxygen2.cpp +double roxcpp4_(double x); +extern "C" SEXP _cpp11test_roxcpp4_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(roxcpp4_(cpp11::as_cpp>(x))); + END_CPP11 +} +// roxygen3.cpp +double roxcpp5_(double x); +extern "C" SEXP _cpp11test_roxcpp5_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(roxcpp5_(cpp11::as_cpp>(x))); + END_CPP11 +} +// roxygen3.cpp +double notroxcpp6_(double x); +extern "C" SEXP _cpp11test_notroxcpp6_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(notroxcpp6_(cpp11::as_cpp>(x))); + END_CPP11 +} +// roxygen3.cpp +double roxcpp7_(double x); +extern "C" SEXP _cpp11test_roxcpp7_(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(roxcpp7_(cpp11::as_cpp>(x))); + END_CPP11 +} // safe.cpp SEXP cpp11_safe_(SEXP x_sxp); extern "C" SEXP _cpp11test_cpp11_safe_(SEXP x_sxp) { @@ -373,6 +429,69 @@ 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.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) { @@ -488,6 +607,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}, @@ -500,6 +620,8 @@ static const R_CallMethodDef CallEntries[] = { {"_cpp11test_my_warning_n1", (DL_FUNC) &_cpp11test_my_warning_n1, 1}, {"_cpp11test_my_warning_n1fmt", (DL_FUNC) &_cpp11test_my_warning_n1fmt, 1}, {"_cpp11test_my_warning_n2fmt", (DL_FUNC) &_cpp11test_my_warning_n2fmt, 2}, + {"_cpp11test_notroxcpp1_", (DL_FUNC) &_cpp11test_notroxcpp1_, 1}, + {"_cpp11test_notroxcpp6_", (DL_FUNC) &_cpp11test_notroxcpp6_, 1}, {"_cpp11test_protect_many_", (DL_FUNC) &_cpp11test_protect_many_, 1}, {"_cpp11test_protect_many_cpp11_", (DL_FUNC) &_cpp11test_protect_many_cpp11_, 1}, {"_cpp11test_protect_many_preserve_", (DL_FUNC) &_cpp11test_protect_many_preserve_, 1}, @@ -518,8 +640,22 @@ static const R_CallMethodDef CallEntries[] = { {"_cpp11test_rcpp_sum_int_for_", (DL_FUNC) &_cpp11test_rcpp_sum_int_for_, 1}, {"_cpp11test_remove_altrep", (DL_FUNC) &_cpp11test_remove_altrep, 1}, {"_cpp11test_row_sums", (DL_FUNC) &_cpp11test_row_sums, 1}, + {"_cpp11test_roxcpp2_", (DL_FUNC) &_cpp11test_roxcpp2_, 1}, + {"_cpp11test_roxcpp3_", (DL_FUNC) &_cpp11test_roxcpp3_, 1}, + {"_cpp11test_roxcpp4_", (DL_FUNC) &_cpp11test_roxcpp4_, 1}, + {"_cpp11test_roxcpp5_", (DL_FUNC) &_cpp11test_roxcpp5_, 1}, + {"_cpp11test_roxcpp7_", (DL_FUNC) &_cpp11test_roxcpp7_, 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..cd20b292 100644 --- a/cpp11test/src/grow.cpp +++ b/cpp11test/src/grow.cpp @@ -1,3 +1,4 @@ +#include "cpp11/complexes.hpp" #include "cpp11/doubles.hpp" [[cpp11::register]] cpp11::writable::doubles grow_(R_xlen_t n) { @@ -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/roxygen1.cpp b/cpp11test/src/roxygen1.cpp new file mode 100644 index 00000000..6ce5dea8 --- /dev/null +++ b/cpp11test/src/roxygen1.cpp @@ -0,0 +1,22 @@ +#include "cpp11/doubles.hpp" +using namespace cpp11; + +// Test: not documented + documented + +// Not Roxygenised C++ function I +[[cpp11::register]] double notroxcpp1_(double x) { + double y = x + 1.0; + return y; +} + +/* roxygen start +@title Roxygenise C++ function II +@param x numeric value +@description Dummy function to test roxygen2. It adds 2.0 to a double. +@export +@examples roxcpp2_(1.0) +roxygen end */ +[[cpp11::register]] double roxcpp2_(double x) { + double y = x + 2.0; + return y; +} diff --git a/cpp11test/src/roxygen2.cpp b/cpp11test/src/roxygen2.cpp new file mode 100644 index 00000000..ecd50221 --- /dev/null +++ b/cpp11test/src/roxygen2.cpp @@ -0,0 +1,28 @@ +#include "cpp11/doubles.hpp" +using namespace cpp11; + +// Test: documented + documented + +/* roxygen start +@title Roxygenise C++ function III +@param x numeric value +@description Dummy function to test roxygen2. It adds 3.0 to a double. +@export +@examples roxcpp3_(1.0) +roxygen end */ +[[cpp11::register]] double roxcpp3_(double x) { + double y = x + 3.0; + return y; +} + +/* roxygen start +@title Roxygenise C++ function IV +@param x numeric value +@description Dummy function to test roxygen2. It adds 4.0 to a double. +@export +@examples roxcpp4_(1.0) +roxygen end */ +[[cpp11::register]] double roxcpp4_(double x) { + double y = x + 4.0; + return y; +} diff --git a/cpp11test/src/roxygen3.cpp b/cpp11test/src/roxygen3.cpp new file mode 100644 index 00000000..7ede7a08 --- /dev/null +++ b/cpp11test/src/roxygen3.cpp @@ -0,0 +1,38 @@ +#include "cpp11/doubles.hpp" +using namespace cpp11; + +// Test: documented + not documented + documented + +/* roxygen start +@title Roxygenise C++ function V +@param x numeric value +@description Dummy function to test roxygen2. It adds 5.0 to a double. +@export +@examples roxcpp5_(1.0) +roxygen end */ +[[cpp11::register]] double roxcpp5_(double x) { + double y = x + 5.0; + return y; +} + +// Not Roxygenised C++ function VI +[[cpp11::register]] double notroxcpp6_(double x) { + double y = x + 6.0; + return y; +} + +/* roxygen start +@title Roxygenise C++ function VII +@param x numeric value +@description Dummy function to test roxygen2. It adds 7.0 to a double. +@export +@examples +my_fun <- function(x) { + roxcpp7_(x) +} +@seealso \code{\link{roxcpp1_}} +roxygen end */ +[[cpp11::register]] double roxcpp7_(double x) { + double y = x + 7.0; + return y; +} diff --git a/cpp11test/src/sum.cpp b/cpp11test/src/sum.cpp index e685c7d1..cb8060b7 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,111 @@ const cpp11::doubles x(x_sxp, false); return std::accumulate(x.cbegin(), x.cend(), 0.); } + +// 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 += x[i]; + } + + 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()); + sum += x[i]; + } + + cpp11::writable::complexes result(1); + // result[0] = cpp11::r_complex(sum.real(), sum.imag()); + result[0] = sum; + + 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()); + sum += x[i]; + } + + 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()); + sum += x[i]; + } + + 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()); + sum += x[i]; + } + + 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()); + 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 new file mode 100644 index 00000000..750002f0 --- /dev/null +++ b/cpp11test/src/test-complex.cpp @@ -0,0 +1,514 @@ +#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") { + using namespace cpp11; + + // 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)); + expect_true(!(base == diff_values)); + + expect_true(!(base != base)); + expect_true(!(base != same_values)); + expect_true(base != diff_length); + expect_true(base != diff_values); + + UNPROTECT(4); + } + + 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") { + 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..6fec2e8c --- /dev/null +++ b/cpp11test/tests/testthat/test-complex.R @@ -0,0 +1,41 @@ +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) + + # 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) +}) + +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..c6b79be1 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" diff --git a/inst/include/cpp11/as.hpp b/inst/include/cpp11/as.hpp index 682f12b5..8941c03c 100644 --- a/inst/include/cpp11/as.hpp +++ b/inst/include/cpp11/as.hpp @@ -3,6 +3,7 @@ #include // for modf #include // for initializer_list #include // for std::shared_ptr, std::weak_ptr, std::unique_ptr +#include #include #include // for string, basic_string #include // for decay, enable_if, is_same, is_convertible @@ -71,6 +72,14 @@ using enable_if_std_string = enable_if_t::value, R> template using enable_if_c_string = enable_if_t::value, R>; +// Detect std::complex types to avoid treating them as containers in generic +// container overloads. +template +struct is_std_complex : std::false_type {}; + +template +struct is_std_complex> : std::true_type {}; + // https://stackoverflow.com/a/1521682/2055486 // inline bool is_convertible_without_loss_to_integer(double value) { @@ -169,6 +178,15 @@ enable_if_floating_point as_cpp(SEXP from) { throw std::length_error("Expected single double value"); } +// 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}; +} + template enable_if_char as_cpp(SEXP from) { if (Rf_isString(from)) { @@ -213,6 +231,15 @@ enable_if_floating_point as_sexp(T from) { return safe[Rf_ScalarReal](from); } +// Specialization for converting std::complex to SEXP +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; +} + template enable_if_bool as_sexp(T from) { return safe[Rf_ScalarLogical](from); @@ -229,7 +256,8 @@ enable_if_std_string as_sexp(const T& from) { } template > + typename = disable_if_convertible_to_sexp, + typename = enable_if_t::value>> enable_if_integral as_sexp(const Container& from) { R_xlen_t size = from.size(); SEXP data = safe[Rf_allocVector](INTSXP, size); @@ -247,7 +275,8 @@ inline SEXP as_sexp(std::initializer_list from) { } template > + typename = disable_if_convertible_to_sexp, + typename = enable_if_t::value>> enable_if_floating_point as_sexp(const Container& from) { R_xlen_t size = from.size(); SEXP data = safe[Rf_allocVector](REALSXP, size); @@ -265,7 +294,8 @@ inline SEXP as_sexp(std::initializer_list from) { } template > + typename = disable_if_convertible_to_sexp, + typename = enable_if_t::value>> enable_if_bool as_sexp(const Container& from) { R_xlen_t size = from.size(); SEXP data = safe[Rf_allocVector](LGLSXP, size); diff --git a/inst/include/cpp11/complexes.hpp b/inst/include/cpp11/complexes.hpp new file mode 100644 index 00000000..b478db56 --- /dev/null +++ b/inst/include/cpp11/complexes.hpp @@ -0,0 +1,259 @@ +#pragma once + +#include // for std::transform +#include // for std::complex +#include // for std::initializer_list + +#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 + +// 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 + +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 cpp11::r_vector::underlying_type value) { + COMPLEX(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 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; + } + + 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 + +// 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; +} + +// Add constructor for initializer_list for the writable r_vector specialization +namespace writable { + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](CPLXSXP, il.size())), + capacity_(il.size()) { + auto it = il.begin(); + + if (data_p_ != nullptr) { + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + data_p_[i] = static_cast(*it); + } + } else { + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + set_elt(data_, i, static_cast(*it)); + } + } +} + +} // namespace writable + +// 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/matrix.hpp b/inst/include/cpp11/matrix.hpp index 8345068f..32e789d0 100644 --- a/inst/include/cpp11/matrix.hpp +++ b/inst/include/cpp11/matrix.hpp @@ -5,6 +5,7 @@ #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 @@ -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 diff --git a/inst/include/cpp11/r_complex.hpp b/inst/include/cpp11/r_complex.hpp new file mode 100644 index 00000000..89957aa7 --- /dev/null +++ b/inst/include/cpp11/r_complex.hpp @@ -0,0 +1,158 @@ +#pragma once + +#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() : 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; + } + r_complex(const std::complex& data) : r_complex(data.real(), data.imag()) {} + r_complex(const Rcomplex& data) : r_complex(data.r, data.i) {} + + 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; + 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 { + 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 (is_na() && rhs.is_na()) || (real() == rhs.real() && imag() == rhs.imag()); + } + + bool operator!=(const r_complex& rhs) const { return !(*this == rhs); } + + 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; + } + + 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; + } + + friend r_complex operator/(r_complex lhs, const r_complex& rhs) { + lhs /= rhs; + return lhs; + } + + bool is_na() const { return R_IsNA(real()) || R_IsNA(imag()); } + + 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; +} + +template <> +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 576f4fe6..c40fcff3 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 @@ -1396,10 +1397,12 @@ inline SEXP r_vector::resize_names(SEXP x, R_xlen_t size) { // rather than three things false? template using is_container_but_not_sexp_or_string = typename std::enable_if< - !std::is_constructible::value && - !std::is_same::type, std::string>::value && - !std::is_same::type, std::string>::value, - typename std::decay::type>::type; + !std::is_constructible::value && + !std::is_same::type, std::string>::value && + !std::is_same::type, std::string>::value && + //! Exclude std::complex from being treated as a container + !std::is_same::type, std::complex::type>>::value, + typename std::decay::type>::type; template ::type::value_type> // typename T = typename C::value_type>