mirror of
https://git.gfz-potsdam.de/naaice/poet.git
synced 2025-12-16 12:54:50 +01:00
Refactor Field.cpp to use Rcpp DataFrame for conversion to SEXP
This commit is contained in:
parent
5182b6aa20
commit
830e139122
@ -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
|
||||||
|
|||||||
@ -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});
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
10
src/poet.cpp
10
src/poet.cpp
@ -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 ¶ms,
|
|||||||
// 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));
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user