Refactor Field.cpp to use Rcpp DataFrame for conversion to SEXP

This commit is contained in:
Max Luebke 2024-04-08 15:56:06 +00:00
parent c42b335aae
commit 8856825c23
3 changed files with 42 additions and 64 deletions

View File

@ -68,16 +68,22 @@ master_iteration_end <- function(setup, state_T, state_C) {
## comprised in setup$out_save ## comprised in setup$out_save
if (setup$store_result) { if (setup$store_result) {
if (iter %in% setup$out_save) { 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") 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( saveRDS(list(
T = state_T, C = state_C, T = state_T, C = state_C
simtime = as.integer(setup$simulation_time)
), file = nameout) ), file = nameout)
msgm("results stored in <", nameout, ">") msgm("results stored in <", nameout, ">")
} }
} }
## Add last time step to simulation time ## 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)) msgm("done iteration", iter, "/", length(setup$timesteps))
setup$iter <- setup$iter + 1 setup$iter <- setup$iter + 1

View File

@ -1,6 +1,9 @@
#include "Field.hpp" #include "Field.hpp"
#include <Rcpp.h> #include <Rcpp.h>
#include <Rcpp/DataFrame.h>
#include <Rcpp/exceptions.h>
#include <Rcpp/vector/instantiation.h>
#include <Rinternals.h> #include <Rinternals.h>
#include <cstddef> #include <cstddef>
#include <cstdint> #include <cstdint>
@ -117,40 +120,14 @@ poet::FieldColumn &poet::Field::operator[](const std::string &key) {
} }
SEXP poet::Field::asSEXP() const { SEXP poet::Field::asSEXP() const {
const std::size_t cols = this->props.size(); Rcpp::List output;
SEXP s_names = PROTECT(Rf_allocVector(STRSXP, cols)); for (const auto &elem : this->props) {
SEXP s_output = PROTECT(Rf_allocVector(VECSXP, cols)); const auto map_it = this->find(elem);
output[elem] = Rcpp::wrap(map_it->second);
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);
} }
SEXP s_rownames = PROTECT(Rf_allocVector(INTSXP, this->req_vec_size)); return Rcpp::DataFrame(output);
for (std::size_t i = 0; i < this->req_vec_size; i++) {
INTEGER(s_rownames)[i] = static_cast<int>(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;
} }
poet::Field &poet::Field::operator=(const FieldColumn &cont_field) { poet::Field &poet::Field::operator=(const FieldColumn &cont_field) {
@ -199,34 +176,25 @@ poet::Field::operator=(const std::vector<FieldColumn> &cont_field) {
void poet::Field::fromSEXP(const SEXP &s_rhs) { void poet::Field::fromSEXP(const SEXP &s_rhs) {
this->clear(); this->clear();
SEXP s_vec = PROTECT(Rf_coerceVector(s_rhs, VECSXP)); Rcpp::List in_list;
SEXP s_names = PROTECT(Rf_getAttrib(s_vec, R_NamesSymbol));
std::size_t cols = static_cast<std::size_t>(Rf_length(s_vec)); try {
in_list = Rcpp::List(s_rhs);
this->props.clear(); } catch (const Rcpp::exception &e) {
this->props.reserve(cols); throw std::runtime_error("Input cannot be casted as list.");
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<std::uint32_t>(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<double>(REAL(s_values)[j]);
}
UNPROTECT(1);
this->insert({prop_name, input});
} }
UNPROTECT(2); if (in_list.size() == 0) {
return;
}
this->props = Rcpp::as<std::vector<std::string>>(in_list.names());
this->req_vec_size =
static_cast<std::uint32_t>(Rcpp::DataFrame(in_list).nrow());
for (const auto &elem : this->props) {
const auto values = Rcpp::as<std::vector<double>>(in_list[elem]);
this->insert({elem, values});
}
} }

View File

@ -29,6 +29,7 @@
#include <RInside.h> #include <RInside.h>
#include <Rcpp.h> #include <Rcpp.h>
#include <Rcpp/DataFrame.h>
#include <Rcpp/Function.h> #include <Rcpp/Function.h>
#include <Rcpp/vector/instantiation.h> #include <Rcpp/vector/instantiation.h>
#include <cstdlib> #include <cstdlib>
@ -264,9 +265,12 @@ static Rcpp::List RunMasterLoop(const RuntimeParameters &params,
// state_C after every iteration if the cmdline option // state_C after every iteration if the cmdline option
// --ignore-results is not given (and thus the R variable // --ignore-results is not given (and thus the R variable
// store_result is TRUE) // store_result is TRUE)
*global_rt_setup = master_iteration_end_R.value()( {
*global_rt_setup, diffusion.getField().asSEXP(), Rcpp::DataFrame t_field = diffusion.getField().asSEXP();
chem.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) + "/" + MSG("End of *coupling* iteration " + std::to_string(iter) + "/" +
std::to_string(maxiter)); std::to_string(maxiter));