From 8856825c2397b5293a5b5984755ad0182c399942 Mon Sep 17 00:00:00 2001 From: Max Luebke Date: Mon, 8 Apr 2024 15:56:06 +0000 Subject: [PATCH] Refactor Field.cpp to use Rcpp DataFrame for conversion to SEXP --- R_lib/kin_r_library.R | 12 ++++-- src/DataStructures/Field.cpp | 84 +++++++++++------------------------- src/poet.cpp | 10 +++-- 3 files changed, 42 insertions(+), 64 deletions(-) diff --git a/R_lib/kin_r_library.R b/R_lib/kin_r_library.R index b0e34ca61..4ecffdff7 100644 --- a/R_lib/kin_r_library.R +++ b/R_lib/kin_r_library.R @@ -68,16 +68,22 @@ master_iteration_end <- function(setup, state_T, state_C) { ## comprised in setup$out_save if (setup$store_result) { if (iter %in% setup$out_save) { + print(head(state_T)) + print(head(state_C)) nameout <- paste0(setup$out_dir, "/iter_", sprintf(fmt = fmt, iter), ".rds") + print(nameout) + # saveRDS(list( + # T = state_T, C = state_C, + # simtime = as.integer(setup$simulation_time) + # ), file = nameout) saveRDS(list( - T = state_T, C = state_C, - simtime = as.integer(setup$simulation_time) + T = state_T, C = state_C ), file = nameout) msgm("results stored in <", nameout, ">") } } ## Add last time step to simulation time - setup$simulation_time <- setup$simulation_time + setup$dt_differ + setup$simulation_time <- setup$simulation_time + setup$timesteps[iter] msgm("done iteration", iter, "/", length(setup$timesteps)) setup$iter <- setup$iter + 1 diff --git a/src/DataStructures/Field.cpp b/src/DataStructures/Field.cpp index 69ab648de..5f942640d 100644 --- a/src/DataStructures/Field.cpp +++ b/src/DataStructures/Field.cpp @@ -1,6 +1,9 @@ #include "Field.hpp" #include +#include +#include +#include #include #include #include @@ -117,40 +120,14 @@ poet::FieldColumn &poet::Field::operator[](const std::string &key) { } SEXP poet::Field::asSEXP() const { - const std::size_t cols = this->props.size(); + Rcpp::List output; - SEXP s_names = PROTECT(Rf_allocVector(STRSXP, cols)); - SEXP s_output = PROTECT(Rf_allocVector(VECSXP, cols)); - - for (std::size_t prop_i = 0; prop_i < this->props.size(); prop_i++) { - const auto &name = this->props[prop_i]; - SEXP s_values = PROTECT(Rf_allocVector(REALSXP, this->req_vec_size)); - const auto values = this->find(name)->second; - - SET_STRING_ELT(s_names, prop_i, Rf_mkChar(name.c_str())); - - for (std::size_t i = 0; i < this->req_vec_size; i++) { - REAL(s_values)[i] = values[i]; - } - - SET_VECTOR_ELT(s_output, prop_i, s_values); - - UNPROTECT(1); + for (const auto &elem : this->props) { + const auto map_it = this->find(elem); + output[elem] = Rcpp::wrap(map_it->second); } - SEXP s_rownames = PROTECT(Rf_allocVector(INTSXP, this->req_vec_size)); - for (std::size_t i = 0; i < this->req_vec_size; i++) { - INTEGER(s_rownames)[i] = static_cast(i + 1); - } - - Rf_setAttrib(s_output, R_ClassSymbol, - Rf_ScalarString(Rf_mkChar("data.frame"))); - Rf_setAttrib(s_output, R_NamesSymbol, s_names); - Rf_setAttrib(s_output, R_RowNamesSymbol, s_rownames); - - UNPROTECT(3); - - return s_output; + return Rcpp::DataFrame(output); } poet::Field &poet::Field::operator=(const FieldColumn &cont_field) { @@ -199,34 +176,25 @@ poet::Field::operator=(const std::vector &cont_field) { void poet::Field::fromSEXP(const SEXP &s_rhs) { this->clear(); - SEXP s_vec = PROTECT(Rf_coerceVector(s_rhs, VECSXP)); - SEXP s_names = PROTECT(Rf_getAttrib(s_vec, R_NamesSymbol)); + Rcpp::List in_list; - std::size_t cols = static_cast(Rf_length(s_vec)); - - this->props.clear(); - this->props.reserve(cols); - - for (std::size_t i = 0; i < cols; i++) { - const std::string prop_name(CHAR(STRING_ELT(s_names, i))); - this->props.push_back(prop_name); - - SEXP s_values = PROTECT(VECTOR_ELT(s_vec, i)); - - if (i == 0) { - this->req_vec_size = static_cast(Rf_length(s_values)); - } - - FieldColumn input(this->req_vec_size); - - for (std::size_t j = 0; j < this->req_vec_size; j++) { - input[j] = static_cast(REAL(s_values)[j]); - } - - UNPROTECT(1); - - this->insert({prop_name, input}); + try { + in_list = Rcpp::List(s_rhs); + } catch (const Rcpp::exception &e) { + throw std::runtime_error("Input cannot be casted as list."); } - UNPROTECT(2); + if (in_list.size() == 0) { + return; + } + + this->props = Rcpp::as>(in_list.names()); + + this->req_vec_size = + static_cast(Rcpp::DataFrame(in_list).nrow()); + + for (const auto &elem : this->props) { + const auto values = Rcpp::as>(in_list[elem]); + this->insert({elem, values}); + } } diff --git a/src/poet.cpp b/src/poet.cpp index 38ce1f974..5c749aa7e 100644 --- a/src/poet.cpp +++ b/src/poet.cpp @@ -29,6 +29,7 @@ #include #include +#include #include #include #include @@ -264,9 +265,12 @@ static Rcpp::List RunMasterLoop(const RuntimeParameters ¶ms, // state_C after every iteration if the cmdline option // --ignore-results is not given (and thus the R variable // store_result is TRUE) - *global_rt_setup = master_iteration_end_R.value()( - *global_rt_setup, diffusion.getField().asSEXP(), - chem.getField().asSEXP()); + { + Rcpp::DataFrame t_field = diffusion.getField().asSEXP(); + Rcpp::DataFrame c_field = chem.getField().asSEXP(); + *global_rt_setup = + master_iteration_end_R.value()(*global_rt_setup, t_field, c_field); + } MSG("End of *coupling* iteration " + std::to_string(iter) + "/" + std::to_string(maxiter));