R baseline

README.md

@@ -120,6 +120,23 @@ Beside the usual application usage, please note, that it's very beneficial to us
 ## Modifying the transformation script
 The TS transformation script's path can be obtained via `./tsqsim --help`, as well as it's currently available transformations. The script can modify the chain of transformations used by the executable, without the need for its recompilation.
 
+## Running R scripts
+The tool delivers binding to the R's C interface, currently via `PredictorRBaseline` and `PredictorRCustom`. Their corresponding R scripts can be found in the directory `static/scripts`
+Before running the wrapped R scripts, two variables need to be exported from the shell, that is supposed to run the predictors. Under Linux:
+```
+export R_HOME=/usr/lib/R
+export LD_LIBRARY_PATH=$R_HOME/lib
+./tsqsim
+```
+
+and under OSX:
+
+```
+export R_HOME=/Library/Frameworks/R.framework/Resources
+export LD_LIBRARY_PATH=$R_HOME/lib
+./tsqsim
+```
+
 # Development
 For the development use case, it's recommended to turn on certain optimizations, that reduce the recompilation and linking time while changing the source code often. The optimizations are: dynamic linking (*shared*), precompiled headers (*pch*) and (optionally) a networked parallel compiler's wrapper, [icecc](https://github.com/icecc/icecream).
 

src/lib-base/src/ConfigDirs.cpp

@@ -17,6 +17,7 @@ ConfigDirs::ConfigDirs()
     , DIR_OUT_LABELS(DIR_DATA + "/labels")
     , DIR_LABELS_RANGE("static/labels-range/")
     , DIR_LABELS_SIGNAL("static/labels-strat/")
+    , DIR_SCRIPTS2("static/scripts/")
     , DIR_CRYPTO("static/crypto/")
     , FILE_LABELS("/labels-strat.txt")
     , FILE_CORREL_LIST(DIR_DATA + "/list_correl.txt")

src/lib-base/src/ConfigDirs.h

@@ -16,6 +16,7 @@ class ConfigDirs
         const EnjoLib::Str DIR_CACHE;
         const EnjoLib::Str DIR_CFG;
         const EnjoLib::Str DIR_SCRIPTS;
+        const EnjoLib::Str DIR_SCRIPTS2;
         const EnjoLib::Str DIR_OUT;
         const EnjoLib::Str DIR_OUT_LABELS;
         const EnjoLib::Str DIR_LABELS_RANGE;

src/lib-base/src/PredictorRBaseline.cpp

@@ -1,24 +1,26 @@
 #include "PredictorRBaseline.h"
 
-#ifdef USE_R
-#include <Rinternals.h>
-#include <Rembedded.h>
-#endif //USE_R
+#include "ConfigDirs.h"
+#include "RWrapper.h"
+
+const char * PredictorRBaseline::SCRIPT_NAME = "r-baseline.R";
 
 PredictorRBaseline::PredictorRBaseline(const IDataProvider & dat)
 : PredictorBase(dat, "RBaseline")
 {
-    //ctor
 }
 
 PredictorRBaseline::~PredictorRBaseline()
 {
-    //dtor
 }
 
 EnjoLib::VecD PredictorRBaseline::Predict(const EnjoLib::VecD & data) const
 {
-    return data;
+    // Invoke a function in R
+    RWrapper::source(ConfigDirs().DIR_SCRIPTS2 + SCRIPT_NAME);
+    const EnjoLib::VecD & ret = RWrapper::R_predictVec(data);
+
+    return ret;
 }
 
 unsigned PredictorRBaseline::GetLags() const

src/lib-base/src/PredictorRBaseline.h

@@ -12,6 +12,9 @@ class PredictorRBaseline : public PredictorBase
 
         EnjoLib::VecD Predict(const EnjoLib::VecD & data) const override;
         unsigned GetLags() const override;
+
+        static const char * SCRIPT_NAME;
+        //static const char * FUNCTION_NAME;
 
     protected:
 

src/lib-base/src/PredictorRCustom.cpp

@@ -1,9 +1,9 @@
 #include "PredictorRCustom.h"
 
-#ifdef USE_R
-#include <Rinternals.h>
-#include <Rembedded.h>
-#endif //USE_R
+#include "ConfigDirs.h"
+#include "RWrapper.h"
+
+const char * PredictorRCustom::SCRIPT_NAME = "r-custom.R";
 
 PredictorRCustom::PredictorRCustom(const IDataProvider & dat)
 : PredictorBase(dat, "RCustom")
@@ -18,7 +18,11 @@ PredictorRCustom::~PredictorRCustom()
 
 EnjoLib::VecD PredictorRCustom::Predict(const EnjoLib::VecD & data) const
 {
-    return data;
+    // Invoke a function in R
+    RWrapper::source(ConfigDirs().DIR_SCRIPTS2 + SCRIPT_NAME);
+    const EnjoLib::VecD & ret = RWrapper::R_predictVec(data);
+
+    return ret;
 }
 
 unsigned PredictorRCustom::GetLags() const

src/lib-base/src/PredictorRCustom.h

@@ -12,6 +12,8 @@ class PredictorRCustom : public PredictorBase
 
         EnjoLib::VecD Predict(const EnjoLib::VecD & data) const override;
         unsigned GetLags() const override;
+
+        static const char * SCRIPT_NAME;
 
     protected:
 

src/lib-base/src/RInitDeinit.cpp

@@ -0,0 +1,22 @@
+#include "RInitDeinit.h"
+
+#ifdef USE_R
+#include <Rinternals.h>
+#include <Rembedded.h>
+#endif //USE_R
+
+RInitDeinit::RInitDeinit()
+{
+#ifdef USE_R
+    const int r_argc = 3;
+    char *r_argv[] = { "R", "--silent", "--vanilla" };
+    Rf_initEmbeddedR(r_argc, r_argv);
+#endif //USE_R
+}
+
+RInitDeinit::~RInitDeinit()
+{
+#ifdef USE_R
+    Rf_endEmbeddedR(0);
+#endif //USE_R
+}

src/lib-base/src/RInitDeinit.h

@@ -0,0 +1,16 @@
+#ifndef RINITDEINIT_HPP
+#define RINITDEINIT_HPP
+
+
+class RInitDeinit
+{
+    public:
+        RInitDeinit();
+        virtual ~RInitDeinit();
+
+    protected:
+
+    private:
+};
+
+#endif // RINITDEINIT_HPP

src/lib-base/src/RWrapper.cpp

@@ -0,0 +1,83 @@
+#include "RWrapper.h"
+
+#include <Util/Except.hpp>
+#include <Util/FileUtils.hpp>
+
+#ifdef USE_R
+#include <Rinternals.h>
+#include <Rembedded.h>
+#endif //USE_R
+
+#include <cstring>
+
+RWrapper::RWrapper()
+{
+}
+
+RWrapper::~RWrapper()
+{
+}
+
+/**
+ * Wrapper for R function predict, defined in func.R.
+ */
+EnjoLib::VecD RWrapper::R_predictVec(const EnjoLib::VecD & vec)
+{
+    EnjoLib::VecD retVec;   
+#ifdef USE_R
+    const double * a = vec.data();
+    const int alen = vec.size();
+    const char * functionName = "predict";
+
+    // Allocate an R vector and copy the C array into it.
+    SEXP arg;
+    PROTECT(arg = allocVector(REALSXP, alen));
+    std::memcpy(REAL(arg), a, alen * sizeof(double));
+
+    // Setup a call to the R function
+    SEXP add1_call;
+    PROTECT(add1_call = lang2(install(functionName), arg));
+
+    // Execute the function
+    int errorOccurred;
+    SEXP ret = R_tryEval(add1_call, R_GlobalEnv, &errorOccurred);
+
+    if (!errorOccurred)
+    {
+        printf("R returned: ");
+        double *val = REAL(ret);
+        for (int i = 0; i < LENGTH(ret); i++)
+        {
+            printf("%0.1f, ", val[i]);
+            retVec.Add(val[i]);
+        }
+
+        printf("\n");
+    }
+    else
+    {
+        printf("Error occurred calling R\n");
+    }
+
+    UNPROTECT(2);
+#endif //USE_R
+    return retVec;
+}
+
+/**
+ * Invokes the command source(scriptPath).
+ */
+void RWrapper::source(const EnjoLib::Str & scriptPath)
+{
+    if (not EnjoLib::FileUtils().FileExists(scriptPath))
+    {
+        throw EnjoLib::ExceptInvalidArg("RWrapper::source(): File doesn't exist: " + scriptPath);
+    }
+#ifdef USE_R
+    SEXP e;
+
+    PROTECT(e = lang2(install("source"), mkString(scriptPath.c_str())));
+    R_tryEval(e, R_GlobalEnv, NULL);
+    UNPROTECT(1);
+#endif //USE_R
+}

src/lib-base/src/RWrapper.h

@@ -0,0 +1,21 @@
+#ifndef RWRAPPER_H
+#define RWRAPPER_H
+
+#include <Util/VecD.hpp>
+#include <Util/Str.hpp>
+
+class RWrapper
+{
+    public:
+        RWrapper();
+        virtual ~RWrapper();
+
+        static EnjoLib::VecD R_predictVec(const EnjoLib::VecD & vec);
+        static void source(const EnjoLib::Str & scriptPath);
+
+    protected:
+
+    private:
+};
+
+#endif // RWRAPPER_H

src/tsqsim-lib/static/scripts/r-baseline.R

@@ -0,0 +1,8 @@
+# This function is invoked by the PredictorRBaseline class
+
+predict <- function(a) {
+  cat("R received: ", a, "\n");
+  b <- c(0, a) # Add 0 at front
+  return(head(b, -1)) # Remove last element
+  #return(a + 1)
+}

src/tsqsim-lib/static/scripts/r-custom.R

@@ -0,0 +1,8 @@
+# This function is invoked by the PredictorRBaseline class
+
+predict <- function(a) {
+  cat("R received: ", a, "\n");
+  b <- c(0, a) # Add 0 at front
+  return(head(b, -1)) # Remove last element
+  #return(a + 1)
+}

src/tsqsim-lib/static/scripts/r-path.R

@@ -0,0 +1 @@
+Sys.getenv("R_HOME")

src/tsqsim-qt/src/main.cpp

@@ -35,6 +35,7 @@
 #include <ConfigSym.h>
 #include "StrategyType.h"
 #include "StrategyTypeEnum.h"
+#include "RInitDeinit.h"
 
 //#include <Util/Trim.hpp>
 #include <Util/CharManipulations.hpp>
@@ -49,6 +50,7 @@ using namespace EnjoLib;
 
 int main(int argc, char *argv[])
 {
+    RInitDeinit rinit;
     int mode = 0;
     if (argc > 1)
     {

src/tsqsim/src/main.cpp

@@ -2,6 +2,7 @@
 
 #include "CLITsq.h"
 #include "CLIResult.h"
+#include "RInitDeinit.h"
 
 #include <Util/CoutBuf.hpp>
 #include <Util/StrColour.hpp>
@@ -15,6 +16,7 @@ int main(int argc, char ** argv)
 {
     try
     {
+        RInitDeinit rinit;
         const CLITsq cli;
         const EnjoLib::Result<CLIResult> & result = cli.GetConfigs(argc, argv);
 

util/build.py

@@ -130,8 +130,19 @@ def build(args):
     #print(cmd)
 def run_demo(args):
     os.chdir(DIR_BIN)
+    exports_r = ""
+    if platform.system() == 'Linux':
+        exports_r = "&& export R_HOME=/usr/lib/R && export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$R_HOME/lib"
+    elif platform.system() == 'Darwin':
+        dir_framework = '/Library/Frameworks/R.framework/Resources'
+        dir_osx11 = '/usr/local/Cellar/r/4.1.2/lib/R'
+        if os.path.isdir(dir_osx11):
+            dir_framework = dir_osx11
+        exports_r = "&& export R_HOME={} && export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$R_HOME/lib".format(dir_framework)
+
     cmd = ""
     cmd += ' export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:lib' # TODO: Solve in CMake?
+    cmd += exports_r
     cmd += '&& ./tsqsim --help'
     cmd += '&& ./tsqsim'
 

util/deps-pull.sh

@@ -10,6 +10,8 @@ if [ "$(uname)" == "Darwin" ]; then
 	#brew link -v qt5 --force
 	HOMEBREW_NO_AUTO_UPDATE=1 brew install boost ccache gnuplot eigen gsl unittest-cpp wxwidgets r # openssl zmq
 	# TODO: install qt instead of qt5, after moving to latest QCustomPlot. Then the "--prefix" and "link" aren't needed.
+	# Expose R_HOME path:
+	Rscript src/tsqsim-lib/static/scripts/r-path.R
 elif [ "$(uname)" == "Linux" ]; then
 	sudo apt update; sudo apt -y install build-essential cmake ccache gnuplot libeigen3-dev libunittest++-dev libgsl-dev libboost-system-dev libboost-filesystem-dev libboost-iostreams-dev libboost-serialization-dev libboost-program-options-dev libboost-date-time-dev libboost-atomic-dev libwxgtk3.0-gtk3-dev qtbase5-dev qtchooser qt5-qmake qtbase5-dev-tools r-base-dev #  libssl-dev
 else