RはCのライブラリとして動作させることができ、容易にRによる統計解析をアプリケーションに組み込むことができます。埋め込みRです。
使い道がなさそうな気もしますが、システム開発を考えると有用です。例えばメッセージキューのライブラリはC/C++やJavaで提供されている一方で、Rの公式サポートは無かったりしますが、これでRからも問題なく利用することができます。
1 ソースコード
本家で埋め込みRはR拡張の亜種として扱われていますが、Rの起動と終了の部分を除けば、CでR拡張を書くのと同様にRの機能を呼び出せます。
Rの起動はRf_initEmbeddedRで、Rの終了はRf_endEmbeddedRで行えます。R拡張の場合と同様に、抽象構文木を作成するか、Rのコードを解釈して実行するか出来ます。
実際に書いてみましょう。
#include<stdio.h>
#include<stdlib.h>
#include<R.h>
#include<Rinternals.h>
#include<R_ext/Parse.h>
#include<Rembedded.h>
double call_R_sum(int, double *);
double eval_R_src(unsigned char *);
int main(int argc, char *argv[])
{
char *R_HOME;
char *R_argv[] = {"embedding_R", "--silent"}; /* The first argument is not used, and subsequent arguments become R startup options. */
double data[] = {1.1, 2.3, 3.1};
char *text = "1 + 2*3 - 4";
int i, len;
Rf_initEmbeddedR(sizeof(R_argv)/sizeof(R_argv[0]), R_argv);
/* consitutute an abstract syntax tree and eval it. */
len = sizeof(data)/sizeof(double);
printf("sum(");
for(i=0;i<len;i++){
if(0<i) putchar(',');
printf("%.1f", data[i]);
}
printf(") = %.1f\n", call_R_sum(len, data));
/* parse and eval a source text-string. */
printf("%s = %.1f\n", text, eval_R_src(text));
Rf_endEmbeddedR(0);
return 0;
}
double eval_R_src(unsigned char *cmd)
{
/* copied from the Writing R Extensions 5.12 Parsing R code from C */
SEXP cmdSexp, cmdexpr, ans = R_NilValue;
ParseStatus status;
int i;
cmdSexp = PROTECT(allocVector(STRSXP, 1));
SET_STRING_ELT(cmdSexp, 0, mkChar(cmd));
cmdexpr = PROTECT(R_ParseVector(cmdSexp, -1, &status, R_NilValue));
if (status != PARSE_OK) {
UNPROTECT(2);
error("invalid call %s", cmd);
}
/* Loop is needed here as EXPSEXP will be of length > 1 */
for(i = 0; i < length(cmdexpr); i++)
ans = eval(VECTOR_ELT(cmdexpr, i), R_GlobalEnv);
UNPROTECT(2);
return REAL(ans)[0];
}
double call_R_sum(int n, double *v)
{
SEXP ans, s, t, r;
unsigned i;
double rv;
t = s = PROTECT(allocList(2));
SET_TYPEOF(t, LANGSXP);
SETCAR(t, install("sum"));
t = CDR(t);
PROTECT(r = allocVector(REALSXP, n));
for(i = 0; i<n; i++)
REAL(r)[i] = v[i];
SETCAR(t, r);
PROTECT(ans = eval(s, R_GlobalEnv));
if(!isReal(ans)){
UNPROTECT(3);
fprintf(stderr, "The length of return of 'objf' must be of numeric.");
exit(-2);
}
if(0==length(ans)){
UNPROTECT(3);
fprintf(stderr, "The length of return of 'objf' should be one.");
exit(-3);
}
rv = REAL(ans)[0];
UNPROTECT(3);
return rv;
}