00001
00002
00003
00004
00005
00006
00007
00008 #include "RInside.h"
00009 #include <sys/time.h>
00010
00011 bool verbose = false;
00012 const char *programName = "RInside";
00013
00014 #ifdef WIN32
00015
00016 #include "setenv.c"
00017 extern int optind;
00018 #endif
00019
00020 RInside::~RInside() {
00021 logTxt("RInside::dtor BEGIN", verbose);
00022 R_dot_Last();
00023 R_RunExitFinalizers();
00024 R_CleanTempDir();
00025 Rf_KillAllDevices();
00026
00027
00028
00029 Rf_endEmbeddedR(0);
00030 logTxt("RInside::dtor END", verbose);
00031 }
00032
00033 RInside::RInside(const int argc, const char* const argv[]) {
00034 logTxt("RInside::ctor BEGIN", verbose);
00035
00036 verbose_m = false;
00037
00038
00039 #include "RInsideEnvVars.h"
00040
00041 for (int i = 0; R_VARS[i] != NULL; i+= 2) {
00042 if (getenv(R_VARS[i]) == NULL) {
00043 if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){
00044 perror("ERROR: couldn't set/replace an R environment variable");
00045 exit(1);
00046 }
00047 }
00048 }
00049
00050 #ifndef WIN32
00051 R_SignalHandlers = 0;
00052 #endif
00053
00054 #ifdef CSTACK_DEFNS
00055 R_CStackLimit = (uintptr_t)-1;
00056 #endif
00057
00058 init_tempdir();
00059
00060 const char *R_argv[] = {(char*)programName, "--gui=none", "--no-save", "--no-readline", "--silent", "", ""};
00061 const char *R_argv_opt[] = {"--vanilla", "--slave"};
00062 int R_argc = (sizeof(R_argv) - sizeof(R_argv_opt) ) / sizeof(R_argv[0]);
00063 Rf_initEmbeddedR(R_argc, (char**)R_argv);
00064
00065 R_ReplDLLinit();
00066
00067
00068
00069 autoloads();
00070
00071 SEXP s_argv = R_NilValue;
00072 if ((argc - optind) > 1){
00073 int nargv = argc - optind - 1;
00074 PROTECT(s_argv = allocVector(STRSXP,nargv));
00075 for (int i = 0; i <nargv; i++){
00076 STRING_PTR(s_argv)[i] = mkChar(argv[i+1+optind]);
00077 }
00078 UNPROTECT(1);
00079
00080 setVar(install("argv"),s_argv,R_GlobalEnv);
00081 } else {
00082 setVar(install("argv"),R_NilValue,R_GlobalEnv);
00083 }
00084
00085 init_rand();
00086 logTxt("RInside::ctor END", verbose);
00087 }
00088
00089 void RInside::init_tempdir(void) {
00090 const char *tmp;
00091
00092 tmp = getenv("TMPDIR");
00093 if (tmp == NULL) {
00094 tmp = getenv("TMP");
00095 if (tmp == NULL) {
00096 tmp = getenv("TEMP");
00097 if (tmp == NULL)
00098 tmp = "/tmp";
00099 }
00100 }
00101 R_TempDir = (char*) tmp;
00102 if (setenv("R_SESSION_TMPDIR",tmp,1) != 0){
00103 perror("Fatal Error: couldn't set/replace R_SESSION_TMPDIR!");
00104 exit(1);
00105 }
00106 }
00107
00108 void RInside::init_rand(void) {
00109 unsigned int seed;
00110 struct timeval tv;
00111 gettimeofday (&tv, NULL);
00112
00113 seed = ((unsigned int) tv.tv_usec << 16) ^ tv.tv_sec;
00114 srand(seed);
00115 }
00116
00117 void RInside::autoloads() {
00118
00119 #include "RInsideAutoloads.h"
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148 SEXP da, dacall, al, alcall, AutoloadEnv, name, package;
00149 int i,j, idx=0, errorOccurred, ptct;
00150
00151
00152 PROTECT(da = Rf_findFun(Rf_install("delayedAssign"), R_GlobalEnv));
00153 PROTECT(AutoloadEnv = Rf_findVar(Rf_install(".AutoloadEnv"), R_GlobalEnv));
00154 if (AutoloadEnv == R_NilValue){
00155 fprintf(stderr,"%s: Cannot find .AutoloadEnv!\n", programName);
00156 exit(1);
00157 }
00158 PROTECT(dacall = allocVector(LANGSXP,5));
00159 SETCAR(dacall,da);
00160
00161
00162 SETCAR(CDR(CDR(CDR(dacall))),R_GlobalEnv);
00163 SETCAR(CDR(CDR(CDR(CDR(dacall)))),AutoloadEnv);
00164
00165
00166 PROTECT(al = Rf_findFun(Rf_install("autoloader"), R_GlobalEnv));
00167 PROTECT(alcall = allocVector(LANGSXP,3));
00168 SET_TAG(alcall, R_NilValue);
00169 SETCAR(alcall,al);
00170
00171
00172
00173 ptct = 5;
00174 for(i = 0; i < packc; i++){
00175 idx += (i != 0)? packobjc[i-1] : 0;
00176 for (j = 0; j < packobjc[i]; j++){
00177
00178
00179 PROTECT(name = NEW_CHARACTER(1));
00180 PROTECT(package = NEW_CHARACTER(1));
00181 SET_STRING_ELT(name, 0, COPY_TO_USER_STRING(packobj[idx+j]));
00182 SET_STRING_ELT(package, 0, COPY_TO_USER_STRING(pack[i]));
00183
00184
00185 PROTECT(alcall = allocVector(LANGSXP,3));
00186 SET_TAG(alcall, R_NilValue);
00187 SETCAR(alcall,al);
00188 SETCAR(CDR(alcall),name);
00189 SETCAR(CDR(CDR(alcall)),package);
00190
00191
00192 SETCAR(CDR(dacall),name);
00193 SETCAR(CDR(CDR(dacall)),alcall);
00194
00195 R_tryEval(dacall,R_GlobalEnv,&errorOccurred);
00196 if (errorOccurred){
00197 fprintf(stderr,"%s: Error calling delayedAssign!\n",
00198 programName);
00199 exit(1);
00200 }
00201
00202 ptct += 3;
00203 }
00204 }
00205 UNPROTECT(ptct);
00206 }
00207
00208 int RInside::parseEval(const std::string & line, SEXP & ans) {
00209 ParseStatus status;
00210 SEXP cmdSexp, cmdexpr = R_NilValue;
00211 int i, errorOccurred;
00212
00213 mb_m.add((char*)line.c_str());
00214
00215 PROTECT(cmdSexp = allocVector(STRSXP, 1));
00216 SET_STRING_ELT(cmdSexp, 0, mkChar((char*)mb_m.getBufPtr()));
00217
00218 cmdexpr = PROTECT(R_ParseVector(cmdSexp, -1, &status, R_NilValue));
00219
00220 switch (status){
00221 case PARSE_OK:
00222
00223 for(i = 0; i < length(cmdexpr); i++){
00224 ans = R_tryEval(VECTOR_ELT(cmdexpr, i),NULL,&errorOccurred);
00225 if (errorOccurred) {
00226 fprintf(stderr, "%s: Error in evaluating R code (%d)\n", programName, status);
00227 UNPROTECT(2);
00228 return 1;
00229 }
00230 if (verbose_m) {
00231 PrintValue(ans);
00232 }
00233 }
00234 mb_m.rewind();
00235 break;
00236 case PARSE_INCOMPLETE:
00237
00238 break;
00239 case PARSE_NULL:
00240 fprintf(stderr, "%s: ParseStatus is null (%d)\n", programName, status);
00241 UNPROTECT(2);
00242 return 1;
00243 break;
00244 case PARSE_ERROR:
00245 fprintf(stderr,"Parse Error: \"%s\"\n", line.c_str());
00246 UNPROTECT(2);
00247 return 1;
00248 break;
00249 case PARSE_EOF:
00250 fprintf(stderr, "%s: ParseStatus is eof (%d)\n", programName, status);
00251 break;
00252 default:
00253 fprintf(stderr, "%s: ParseStatus is not documented %d\n", programName, status);
00254 UNPROTECT(2);
00255 return 1;
00256 break;
00257 }
00258 UNPROTECT(2);
00259 return 0;
00260 }
00261
00262 int RInside::parseEvalQ(const std::string & line) {
00263 SEXP ans;
00264 int rc = parseEval(line, ans);
00265 return rc;
00266 }
00267
00268
00269 void RInside::assign(const std::vector< std::vector< double > > & mat, const std::string & nam) {
00270 int nx = mat.size();
00271 int ny = mat[0].size();
00272 SEXP sexpmat = PROTECT(allocMatrix(REALSXP, nx, ny));
00273 for(int i = 0; i < nx; i++) {
00274 for(int j = 0; j < ny; j++) {
00275 REAL(sexpmat)[i + nx*j] = mat[i][j];
00276 }
00277 }
00278 setVar(install((char*) nam.c_str()), sexpmat, R_GlobalEnv);
00279 UNPROTECT(1);
00280 }
00281
00282
00283 void RInside::assign(const std::vector< std::vector< int > > & mat, const std::string & nam) {
00284 int nx = mat.size();
00285 int ny = mat[0].size();
00286 SEXP sexpmat = PROTECT(allocMatrix(INTSXP, nx, ny));
00287 for(int i = 0; i < nx; i++) {
00288 for(int j = 0; j < ny; j++) {
00289 INTEGER(sexpmat)[i + nx*j] = mat[i][j];
00290 }
00291 }
00292 setVar(install((char*) nam.c_str()), sexpmat, R_GlobalEnv);
00293 UNPROTECT(1);
00294 }
00295
00296
00297 void RInside::assign(const std::vector< double > & vec, const std::string & nam) {
00298 int nx = vec.size();
00299 SEXP sexpvec = PROTECT(allocVector(REALSXP, nx));
00300 for(int i = 0; i < nx; i++) {
00301 REAL(sexpvec)[i] = vec[i];
00302 }
00303 setVar(install((char*) nam.c_str()), sexpvec, R_GlobalEnv);
00304 UNPROTECT(1);
00305 }
00306
00307
00308 void RInside::assign(const std::vector< std::string > & vec, const std::string & nam) {
00309 int len = (int)vec.size();
00310 SEXP sexpvec = PROTECT(allocVector(STRSXP, len));
00311 for (int i = 0; i < len; i++) {
00312 SET_STRING_ELT(sexpvec, i, mkChar(vec[i].c_str()));
00313 }
00314 setVar(install((char*) nam.c_str()), sexpvec, R_GlobalEnv);
00315 UNPROTECT(1);
00316 }
00317
00318
00319
00320 void RInside::assign(const std::vector< int > & vec, const std::string & nam) {
00321 int nx = vec.size();
00322 SEXP sexpvec = PROTECT(allocVector(INTSXP, nx));
00323 for(int i = 0; i < nx; i++) {
00324 INTEGER(sexpvec)[i] = vec[i];
00325 }
00326 setVar(install((char*) nam.c_str()), sexpvec, R_GlobalEnv);
00327 UNPROTECT(1);
00328 }
00329
00330 void RInside::assign(const std::string & txt, const std::string & nam) {
00331 SEXP value = PROTECT(allocVector(STRSXP, 1));
00332 SET_STRING_ELT(value, 0, mkChar(txt.c_str()));
00333 setVar(install((char*) nam.c_str()), value, R_GlobalEnv);
00334 UNPROTECT(1);
00335 }