diff --git a/src/Base/RInsidePOET.hpp b/src/Base/RInsidePOET.hpp index 2897fc5a8..466c49375 100644 --- a/src/Base/RInsidePOET.hpp +++ b/src/Base/RInsidePOET.hpp @@ -1,17 +1,13 @@ -#ifndef RPOET_H_ -#define RPOET_H_ +#pragma once #include #include #include -#include #include -#include -#include +#include #include -#include -#include +namespace poet { class RInsidePOET : public RInside { public: static RInsidePOET &getInstance() { @@ -33,44 +29,64 @@ private: RInsidePOET() : RInside(){}; }; -template class RHookFunction { +/** + * @brief Deferred evaluation function + * + * The class is intended to call R functions within an existing RInside + * instance. The problem with "original" Rcpp::Function is that they require: + * 1. RInside instance already present, restricting the declaration of + * Rcpp::Functions in global scope + * 2. Require the function to be present. Otherwise, they will throw an + * exception. + * This class solves both problems by deferring the evaluation of the function + * until the constructor is called and evaluating whether the function is + * present or not, wihout throwing an exception. + * + * @tparam T Return type of the function + */ +class DEFunc { public: - RHookFunction() {} - RHookFunction(RInside &R, const std::string &f_name) { + DEFunc() {} + DEFunc(const std::string &f_name) { try { - this->func = Rcpp::Function(Rcpp::as(R.parseEval(f_name.c_str()))); + this->func = std::make_shared(f_name); } catch (const std::exception &e) { } } - RHookFunction(SEXP f) { + DEFunc(SEXP f) { try { - this->func = Rcpp::Function(f); + this->func = std::make_shared(f); } catch (const std::exception &e) { } } - template T operator()(Args... args) const { - if (func.has_value()) { - return (Rcpp::as(this->func.value()(args...))); + template SEXP operator()(Args... args) const { + if (func) { + return (*this->func)(args...); } else { throw std::exception(); } } - RHookFunction &operator=(const RHookFunction &rhs) { + DEFunc &operator=(const DEFunc &rhs) { this->func = rhs.func; return *this; } - RHookFunction(const RHookFunction &rhs) { this->func = rhs.func; } + DEFunc(const DEFunc &rhs) { this->func = rhs.func; } - bool isValid() const { return this->func.has_value(); } + bool isValid() const { return static_cast(func); } - SEXP asSEXP() const { return Rcpp::as(this->func.value()); } + SEXP asSEXP() const { + if (!func) { + return R_NilValue; + } + return Rcpp::as(*this->func.get()); + } private: - std::optional func; + std::shared_ptr func; }; -#endif // RPOET_H_ +} // namespace poet \ No newline at end of file diff --git a/src/Chemistry/SurrogateModels/DHT_Wrapper.cpp b/src/Chemistry/SurrogateModels/DHT_Wrapper.cpp index eac73b14a..a7c1827a6 100644 --- a/src/Chemistry/SurrogateModels/DHT_Wrapper.cpp +++ b/src/Chemistry/SurrogateModels/DHT_Wrapper.cpp @@ -25,6 +25,7 @@ #include "Init/InitialList.hpp" #include "Rounding.hpp" +#include #include #include #include @@ -267,7 +268,8 @@ LookupKey DHT_Wrapper::fuzzForDHT_R(const std::vector &cell, NamedVector input_nv(this->output_names, cell); - const std::vector eval_vec = hooks.dht_fuzz(input_nv); + const std::vector eval_vec = + Rcpp::as>(hooks.dht_fuzz(input_nv)); assert(eval_vec.size() == this->key_count); LookupKey vecFuzz(this->key_count + 1, {.0}); diff --git a/src/Chemistry/SurrogateModels/InterpolationModule.cpp b/src/Chemistry/SurrogateModels/InterpolationModule.cpp index 455c96729..e6015b14b 100644 --- a/src/Chemistry/SurrogateModels/InterpolationModule.cpp +++ b/src/Chemistry/SurrogateModels/InterpolationModule.cpp @@ -9,6 +9,7 @@ #include "Rounding.hpp" #include +#include #include #include @@ -94,7 +95,8 @@ void InterpolationModule::tryInterpolation(WorkPackage &work_package) { if (hooks.interp_pre.isValid()) { NamedVector nv_in(this->out_names, work_package.input[wp_i]); - auto rm_indices = hooks.interp_pre(nv_in, pht_result.in_values); + std::vector rm_indices = Rcpp::as>( + hooks.interp_pre(nv_in, pht_result.in_values)); pht_result.size -= rm_indices.size(); diff --git a/src/Init/InitialList.hpp b/src/Init/InitialList.hpp index 3e6ae7654..3a3c5ea23 100644 --- a/src/Init/InitialList.hpp +++ b/src/Init/InitialList.hpp @@ -215,10 +215,10 @@ private: public: struct ChemistryHookFunctions { - RHookFunction dht_fill; - RHookFunction> dht_fuzz; - RHookFunction> interp_pre; - RHookFunction interp_post; + poet::DEFunc dht_fill; + poet::DEFunc dht_fuzz; + poet::DEFunc interp_pre; + poet::DEFunc interp_post; }; struct ChemistryInit { diff --git a/src/poet.cpp b/src/poet.cpp index 229c48255..9151016a5 100644 --- a/src/poet.cpp +++ b/src/poet.cpp @@ -4,7 +4,8 @@ ** ** Copyright (C) 2018-2022 Marco De Lucia, Max Luebke (GFZ Potsdam) ** -** Copyright (C) 2023-2024 Max Luebke (University of Potsdam) +** Copyright (C) 2023-2024 Marco De Lucia (GFZ Potsdam), Max Luebke (University +** of Potsdam) ** ** POET is free software; you can redistribute it and/or modify it under the ** terms of the GNU General Public License as published by the Free Software @@ -36,7 +37,6 @@ #include #include #include -#include #include #include "Base/argh.hpp" @@ -54,21 +54,21 @@ static std::unique_ptr global_rt_setup; // we need some lazy evaluation, as we can't define the functions // before the R runtime is initialized -static std::optional master_init_R; -static std::optional master_iteration_end_R; -static std::optional store_setup_R; -static std::optional ReadRObj_R; -static std::optional SaveRObj_R; -static std::optional source_R; +static poet::DEFunc master_init_R; +static poet::DEFunc master_iteration_end_R; +static poet::DEFunc store_setup_R; +static poet::DEFunc ReadRObj_R; +static poet::DEFunc SaveRObj_R; +static poet::DEFunc source_R; static void init_global_functions(RInside &R) { R.parseEval(kin_r_library); - master_init_R = Rcpp::Function("master_init"); - master_iteration_end_R = Rcpp::Function("master_iteration_end"); - store_setup_R = Rcpp::Function("StoreSetup"); - source_R = Rcpp::Function("source"); - ReadRObj_R = Rcpp::Function("ReadRObj"); - SaveRObj_R = Rcpp::Function("SaveRObj"); + master_init_R = DEFunc("master_init"); + master_iteration_end_R = DEFunc("master_iteration_end"); + store_setup_R = DEFunc("StoreSetup"); + source_R = DEFunc("source"); + ReadRObj_R = DEFunc("ReadRObj"); + SaveRObj_R = DEFunc("SaveRObj"); } // HACK: this is a step back as the order and also the count of fields is @@ -224,12 +224,12 @@ ParseRet parseInitValues(char **argv, RuntimeParameters ¶ms) { // Rcpp::Function ReadRObj("ReadRObj"); // Rcpp::Function SaveRObj("SaveRObj"); - Rcpp::List init_params_ = ReadRObj_R.value()(init_file); + Rcpp::List init_params_(ReadRObj_R(init_file)); params.init_params = init_params_; - - global_rt_setup = std::make_unique(); - *global_rt_setup = source_R.value()(runtime_file, Rcpp::Named("local", true)); - *global_rt_setup = global_rt_setup->operator[]("value"); + + global_rt_setup = std::make_unique( + source_R(runtime_file, Rcpp::Named("local", true))); + *global_rt_setup = (*global_rt_setup)["value"]; // MDL add "out_ext" for output format to R setup (*global_rt_setup)["out_ext"] = params.out_ext; @@ -524,9 +524,8 @@ int main(int argc, char *argv[]) { // R.parseEvalQ("mysetup <- setup"); // // if (MY_RANK == 0) { // get timestep vector from // // grid_init function ... // - *global_rt_setup = - master_init_R.value()(*global_rt_setup, run_params.out_dir, - init_list.getInitialGrid().asSEXP()); + *global_rt_setup = master_init_R(*global_rt_setup, run_params.out_dir, + init_list.getInitialGrid().asSEXP()); // MDL: store all parameters // MSG("Calling R Function to store calling parameters"); // R.parseEvalQ("StoreSetup(setup=mysetup)"); diff --git a/test/testField.cpp b/test/testField.cpp index 0800b4dbd..51858ecc4 100644 --- a/test/testField.cpp +++ b/test/testField.cpp @@ -89,14 +89,14 @@ TEST_CASE("Field") { } SUBCASE("Apply R function (set Na to zero)") { - RHookFunction to_call(R, "simple_field"); + poet::DEFunc to_call("simple_field"); Field field_proc = to_call(dut.asSEXP()); CHECK_EQ(field_proc["Na"], FieldColumn(dut.GetRequestedVecSize(), 0)); } SUBCASE("Apply R function (add two fields)") { - RHookFunction to_call(R, "extended_field"); + poet::DEFunc to_call("extended_field"); Field field_proc = to_call(dut.asSEXP(), dut.asSEXP()); CHECK_EQ(field_proc["Na"], diff --git a/test/testNamedVector.cpp b/test/testNamedVector.cpp index 7b86c7496..71d575ba0 100644 --- a/test/testNamedVector.cpp +++ b/test/testNamedVector.cpp @@ -9,7 +9,7 @@ #include "testDataStructures.hpp" TEST_CASE("NamedVector") { - RInsidePOET &R = RInsidePOET::getInstance(); + poet::RInsidePOET &R = poet::RInsidePOET::getInstance(); R["sourcefile"] = RInside_source_file; R.parseEval("source(sourcefile)"); @@ -36,14 +36,14 @@ TEST_CASE("NamedVector") { } SUBCASE("Apply R function (set to zero)") { - RHookFunction> to_call(R, "simple_named_vec"); + poet::DEFunc to_call("simple_named_vec"); nv = to_call(nv); CHECK_EQ(nv[2], 0); } SUBCASE("Apply R function (second NamedVector)") { - RHookFunction> to_call(R, "extended_named_vec"); + poet::DEFunc to_call("extended_named_vec"); const std::vector names{{"C", "H", "Mg"}}; const std::vector values{{0, 1, 2}}; @@ -56,8 +56,8 @@ TEST_CASE("NamedVector") { } SUBCASE("Apply R function (check if zero)") { - RHookFunction to_call(R, "bool_named_vec"); + poet::DEFunc to_call("bool_named_vec"); - CHECK_FALSE(to_call(nv)); + CHECK_FALSE(Rcpp::as(to_call(nv))); } }