r_bridge 0.5.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +7 -0
- data/.gitignore +22 -0
- data/.travis.yml +6 -0
- data/Gemfile +7 -0
- data/LICENSE.txt +674 -0
- data/README.md +365 -0
- data/Rakefile +10 -0
- data/bin/console +14 -0
- data/bin/setup +8 -0
- data/ext/r_bridge/extconf.rb +78 -0
- data/ext/r_bridge/r_bridge.c +5 -0
- data/ext/r_bridge/r_embed.c +26 -0
- data/ext/r_bridge/r_eval.c +29 -0
- data/ext/r_bridge/r_lang.c +62 -0
- data/ext/r_bridge/r_list.c +34 -0
- data/ext/r_bridge/r_mysum.c +89 -0
- data/ext/r_bridge/r_ptr.c +18 -0
- data/ext/r_bridge/r_vec.c +76 -0
- data/ext/r_bridge/win_compat.h +10 -0
- data/lib/r_bridge.rb +10 -0
- data/lib/r_bridge/r_bridge_ffi.rb +480 -0
- data/lib/r_bridge/r_bridge_lazyfunc_ext.rb +202 -0
- data/lib/r_bridge/version.rb +3 -0
- data/r_bridge.gemspec +32 -0
- metadata +91 -0
@@ -0,0 +1,26 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
|
5
|
+
#include "win_compat.h"
|
6
|
+
|
7
|
+
EXPORT void
|
8
|
+
r_embedded_init()
|
9
|
+
{
|
10
|
+
size_t localArgc = 2;
|
11
|
+
char localArgs[][50] = {"R", "--silent"};
|
12
|
+
|
13
|
+
char *args[ localArgc ];
|
14
|
+
for (size_t i = 0; i < localArgc; ++i){
|
15
|
+
args[i] = localArgs[i];
|
16
|
+
}
|
17
|
+
|
18
|
+
Rf_initEmbeddedR( localArgc , args );
|
19
|
+
}
|
20
|
+
|
21
|
+
EXPORT void
|
22
|
+
r_embedded_end()
|
23
|
+
{
|
24
|
+
Rf_endEmbeddedR(0);
|
25
|
+
}
|
26
|
+
|
@@ -0,0 +1,29 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
|
5
|
+
#include "win_compat.h"
|
6
|
+
|
7
|
+
EXPORT SEXP
|
8
|
+
r_eval( SEXP sexp )
|
9
|
+
{
|
10
|
+
SEXP ptrRetVal;
|
11
|
+
int nErr = 0;
|
12
|
+
PROTECT(ptrRetVal = R_tryEval( sexp, R_GlobalEnv, &nErr));
|
13
|
+
if( nErr ){
|
14
|
+
Rprintf("R's eval error deteccted: %d\n", nErr);
|
15
|
+
Rf_unprotect_ptr(ptrRetVal);
|
16
|
+
return R_NilValue;
|
17
|
+
}
|
18
|
+
return ptrRetVal;
|
19
|
+
}
|
20
|
+
|
21
|
+
EXPORT void
|
22
|
+
r_eval_no_return( SEXP sexp )
|
23
|
+
{
|
24
|
+
SEXP ptrRetVal;
|
25
|
+
int nErr = 0;
|
26
|
+
Rf_protect(ptrRetVal = R_tryEval( sexp, R_GlobalEnv, &nErr));
|
27
|
+
Rf_unprotect_ptr(ptrRetVal);
|
28
|
+
}
|
29
|
+
|
@@ -0,0 +1,62 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
|
5
|
+
#include "win_compat.h"
|
6
|
+
|
7
|
+
EXPORT SEXP
|
8
|
+
r_lang_create_fcall( const char* fname, SEXP args)
|
9
|
+
{
|
10
|
+
SEXP func;
|
11
|
+
PROTECT( func = LCONS( Rf_install(fname), args ));
|
12
|
+
return func;
|
13
|
+
}
|
14
|
+
|
15
|
+
|
16
|
+
EXPORT SEXP
|
17
|
+
r_lang_cons( SEXP car, SEXP cdr)
|
18
|
+
{
|
19
|
+
SEXP cons_cell;
|
20
|
+
PROTECT( cons_cell = LCONS( car, cdr ));
|
21
|
+
return cons_cell;
|
22
|
+
}
|
23
|
+
|
24
|
+
EXPORT SEXP
|
25
|
+
r_lang_cons_gen( SEXP car )
|
26
|
+
{
|
27
|
+
SEXP cons_cell;
|
28
|
+
PROTECT( cons_cell = LCONS( car, R_NilValue ));
|
29
|
+
return cons_cell;
|
30
|
+
}
|
31
|
+
|
32
|
+
EXPORT void
|
33
|
+
r_lang_set_tag( SEXP sexp, const char* tag_name )
|
34
|
+
{
|
35
|
+
SET_TAG( sexp, Rf_install(tag_name));
|
36
|
+
}
|
37
|
+
|
38
|
+
EXPORT SEXP
|
39
|
+
r_lang_symbol( const char* symbol_name)
|
40
|
+
{
|
41
|
+
SEXP r_symbol ;
|
42
|
+
r_symbol = Rf_install(symbol_name);
|
43
|
+
return r_symbol;
|
44
|
+
}
|
45
|
+
|
46
|
+
EXPORT SEXP
|
47
|
+
r_lang_nil()
|
48
|
+
{
|
49
|
+
return R_NilValue;
|
50
|
+
}
|
51
|
+
|
52
|
+
EXPORT int
|
53
|
+
r_is_nil( SEXP obj)
|
54
|
+
{
|
55
|
+
if( obj == R_NilValue ){
|
56
|
+
return 1;
|
57
|
+
}else{
|
58
|
+
return 0;
|
59
|
+
}
|
60
|
+
}
|
61
|
+
|
62
|
+
|
@@ -0,0 +1,34 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
|
5
|
+
#include "win_compat.h"
|
6
|
+
|
7
|
+
EXPORT SEXP
|
8
|
+
r_list_create( SEXP name_vec, int size )
|
9
|
+
{
|
10
|
+
SEXP lst;
|
11
|
+
PROTECT( lst = allocVector(VECSXP, size));
|
12
|
+
setAttrib( lst, R_NamesSymbol, name_vec);
|
13
|
+
return lst;
|
14
|
+
}
|
15
|
+
|
16
|
+
EXPORT void
|
17
|
+
r_list_set_elem( SEXP lst, int idx, SEXP elem_vec )
|
18
|
+
{
|
19
|
+
SET_VECTOR_ELT( lst, idx, elem_vec );
|
20
|
+
}
|
21
|
+
|
22
|
+
EXPORT SEXP
|
23
|
+
r_list_to_dataframe( SEXP lst )
|
24
|
+
{
|
25
|
+
setAttrib( lst , R_ClassSymbol, ScalarString(mkChar("data.frame")));
|
26
|
+
return lst;
|
27
|
+
}
|
28
|
+
|
29
|
+
EXPORT void
|
30
|
+
r_dataframe_set_rownames( SEXP lst, SEXP rownames )
|
31
|
+
{
|
32
|
+
setAttrib(lst, R_RowNamesSymbol, rownames);
|
33
|
+
}
|
34
|
+
|
@@ -0,0 +1,89 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
#include <R_ext/Parse.h>
|
5
|
+
|
6
|
+
|
7
|
+
SEXP
|
8
|
+
mysum (SEXP vec)
|
9
|
+
{
|
10
|
+
int int_sum = 0;
|
11
|
+
double dbl_sum = 0.0;
|
12
|
+
R_xlen_t size = xlength(vec);
|
13
|
+
unsigned int idx ;
|
14
|
+
SEXP result;
|
15
|
+
|
16
|
+
switch(TYPEOF(vec)){
|
17
|
+
case INTSXP:
|
18
|
+
for( idx = 0; idx < size; ++idx ){
|
19
|
+
int_sum = int_sum + INTEGER(vec)[idx] ;
|
20
|
+
}
|
21
|
+
Rf_protect(result = Rf_ScalarInteger( int_sum ) );
|
22
|
+
break;
|
23
|
+
case REALSXP:
|
24
|
+
for( idx = 0; idx < size; ++idx ){
|
25
|
+
dbl_sum = dbl_sum + REAL(vec)[idx] ;
|
26
|
+
}
|
27
|
+
Rf_protect(result = Rf_ScalarReal( dbl_sum ) );
|
28
|
+
break;
|
29
|
+
default:
|
30
|
+
Rf_protect(result = Rf_ScalarLogical(NA_LOGICAL) );
|
31
|
+
}
|
32
|
+
|
33
|
+
Rf_unprotect_ptr(result);
|
34
|
+
return result;
|
35
|
+
}
|
36
|
+
|
37
|
+
void
|
38
|
+
r_mysum(SEXP input)
|
39
|
+
{
|
40
|
+
SEXP result;
|
41
|
+
Rf_protect( result = mysum( input ));
|
42
|
+
SEXP ptrRetVal;
|
43
|
+
int nErr;
|
44
|
+
Rf_protect(ptrRetVal = R_tryEval( LCONS( Rf_install( "print" ), LCONS( result , R_NilValue )) , R_GlobalEnv, &nErr));
|
45
|
+
|
46
|
+
Rf_unprotect_ptr(ptrRetVal);
|
47
|
+
Rf_unprotect_ptr(result);
|
48
|
+
}
|
49
|
+
|
50
|
+
/*
|
51
|
+
To write the above code in Ruby, the following methods are required
|
52
|
+
|
53
|
+
|
54
|
+
|
55
|
+
1. RBridge::init()
|
56
|
+
2. RBridge::new_integer_vec()
|
57
|
+
RBridge::new_real_vec()
|
58
|
+
RBridge::new_logical_vec()
|
59
|
+
RBridge::new_string_vec()
|
60
|
+
|
61
|
+
RBrideg::new_list()
|
62
|
+
|
63
|
+
3. RBridge::new_function()
|
64
|
+
RBridge::new_symbol()
|
65
|
+
RBridge::new_arguments()
|
66
|
+
|
67
|
+
RBridge::lcons()
|
68
|
+
|
69
|
+
3. RBridge::convert_to_r_objects()
|
70
|
+
4. RBridge::eval()
|
71
|
+
5. RBridge::close()
|
72
|
+
RBridge::
|
73
|
+
|
74
|
+
As structure
|
75
|
+
|
76
|
+
class RBridge::Sexp
|
77
|
+
def initalize( type , name , tag , r_sexp)
|
78
|
+
|
79
|
+
end
|
80
|
+
|
81
|
+
end
|
82
|
+
|
83
|
+
class RBridge::LangCons
|
84
|
+
def initialize( car, cdr )
|
85
|
+
end
|
86
|
+
|
87
|
+
end
|
88
|
+
|
89
|
+
*/
|
@@ -0,0 +1,18 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
|
5
|
+
#include "win_compat.h"
|
6
|
+
|
7
|
+
EXPORT void
|
8
|
+
r_ptr_unprotect( SEXP ptr )
|
9
|
+
{
|
10
|
+
Rf_unprotect_ptr(ptr);
|
11
|
+
}
|
12
|
+
|
13
|
+
EXPORT void
|
14
|
+
r_ptr_gc( int num )
|
15
|
+
{
|
16
|
+
UNPROTECT( num );
|
17
|
+
}
|
18
|
+
|
@@ -0,0 +1,76 @@
|
|
1
|
+
#include <Rinternals.h>
|
2
|
+
#include <Rembedded.h>
|
3
|
+
#include <Rdefines.h>
|
4
|
+
|
5
|
+
#include "win_compat.h"
|
6
|
+
|
7
|
+
EXPORT SEXP
|
8
|
+
r_vec_create_str( int size )
|
9
|
+
{
|
10
|
+
SEXP vec;
|
11
|
+
PROTECT( vec = allocVector(STRSXP, size));
|
12
|
+
return vec;
|
13
|
+
}
|
14
|
+
|
15
|
+
EXPORT SEXP
|
16
|
+
r_vec_create_int( int size )
|
17
|
+
{
|
18
|
+
SEXP vec;
|
19
|
+
PROTECT(vec = Rf_allocVector(INTSXP, size));
|
20
|
+
return vec;
|
21
|
+
}
|
22
|
+
|
23
|
+
EXPORT SEXP
|
24
|
+
r_vec_create_real( int size )
|
25
|
+
{
|
26
|
+
SEXP vec;
|
27
|
+
PROTECT(vec = Rf_allocVector(REALSXP, size));
|
28
|
+
return vec;
|
29
|
+
}
|
30
|
+
|
31
|
+
|
32
|
+
EXPORT SEXP
|
33
|
+
r_vec_create_lgl( int size )
|
34
|
+
{
|
35
|
+
SEXP vec;
|
36
|
+
PROTECT(vec = Rf_allocVector(LGLSXP, size));
|
37
|
+
return vec;
|
38
|
+
}
|
39
|
+
|
40
|
+
EXPORT void
|
41
|
+
r_vec_set_str( SEXP vec, char** ary , int size)
|
42
|
+
{
|
43
|
+
int idx;
|
44
|
+
for(idx=0; idx<size; ++idx){
|
45
|
+
SET_STRING_ELT(vec, idx, mkChar( ary[idx] ));
|
46
|
+
}
|
47
|
+
}
|
48
|
+
|
49
|
+
EXPORT void
|
50
|
+
r_vec_set_int( SEXP vec, int* ary , int size)
|
51
|
+
{
|
52
|
+
int idx;
|
53
|
+
for(idx=0; idx<size; ++idx){
|
54
|
+
INTEGER(vec)[idx] = ary[idx];
|
55
|
+
}
|
56
|
+
}
|
57
|
+
|
58
|
+
EXPORT void
|
59
|
+
r_vec_set_real( SEXP vec, double* ary , int size)
|
60
|
+
{
|
61
|
+
int idx;
|
62
|
+
for(idx=0; idx<size; ++idx){
|
63
|
+
REAL(vec)[idx] = ary[idx];
|
64
|
+
}
|
65
|
+
}
|
66
|
+
|
67
|
+
EXPORT void
|
68
|
+
r_vec_set_lgl( SEXP vec, int* ary , int size)
|
69
|
+
{
|
70
|
+
int idx;
|
71
|
+
for(idx=0; idx<size; ++idx){
|
72
|
+
LOGICAL(vec)[idx] = ary[idx];
|
73
|
+
}
|
74
|
+
}
|
75
|
+
|
76
|
+
|
data/lib/r_bridge.rb
ADDED
@@ -0,0 +1,480 @@
|
|
1
|
+
require 'ffi'
|
2
|
+
|
3
|
+
module RBridge
|
4
|
+
extend FFI::Library
|
5
|
+
ffi_lib_flags :now, :global
|
6
|
+
|
7
|
+
lib_name = "librbridge" + "." + RbConfig::CONFIG['DLEXT']
|
8
|
+
ffi_lib File.expand_path( lib_name, __dir__ )
|
9
|
+
|
10
|
+
attach_function :r_embedded_init, [], :void
|
11
|
+
attach_function :r_embedded_end, [], :void
|
12
|
+
|
13
|
+
attach_function :r_vec_create_str, [:int], :pointer
|
14
|
+
attach_function :r_vec_create_int, [:int], :pointer
|
15
|
+
attach_function :r_vec_create_real, [:int], :pointer
|
16
|
+
attach_function :r_vec_create_lgl, [:int], :pointer
|
17
|
+
attach_function :r_vec_set_str, [:pointer, :pointer, :int], :void
|
18
|
+
attach_function :r_vec_set_int, [:pointer, :pointer, :int], :void
|
19
|
+
attach_function :r_vec_set_real, [:pointer, :pointer, :int], :void
|
20
|
+
attach_function :r_vec_set_lgl, [:pointer, :pointer, :int], :void
|
21
|
+
|
22
|
+
attach_function :r_list_create, [:pointer, :int], :pointer
|
23
|
+
attach_function :r_list_set_elem, [:pointer, :int, :pointer ], :void
|
24
|
+
attach_function :r_list_to_dataframe, [:pointer ], :pointer
|
25
|
+
attach_function :r_dataframe_set_rownames, [:pointer, :pointer], :void
|
26
|
+
|
27
|
+
attach_function :r_lang_create_fcall, [:string, :pointer], :pointer
|
28
|
+
attach_function :r_lang_cons, [:pointer, :pointer], :pointer
|
29
|
+
attach_function :r_lang_cons_gen, [:pointer], :pointer
|
30
|
+
attach_function :r_lang_set_tag, [:pointer, :string], :void
|
31
|
+
attach_function :r_lang_symbol, [:string], :pointer
|
32
|
+
|
33
|
+
attach_function :r_eval, [:pointer], :pointer
|
34
|
+
attach_function :r_eval_no_return, [:pointer], :pointer
|
35
|
+
|
36
|
+
attach_function :r_ptr_unprotect, [:pointer], :void
|
37
|
+
attach_function :r_ptr_gc, [:int], :void
|
38
|
+
|
39
|
+
attach_function :r_lang_nil , [] , :pointer
|
40
|
+
attach_function :r_is_nil, [:pointer], :int # Use wrapper function is_r_nil? for safety
|
41
|
+
|
42
|
+
def self.is_pointer?(val)
|
43
|
+
return val.is_a? FFI::Pointer
|
44
|
+
end
|
45
|
+
|
46
|
+
# From here, Ruby interface
|
47
|
+
|
48
|
+
def self.init_embedded_r()
|
49
|
+
r_embedded_init()
|
50
|
+
end
|
51
|
+
|
52
|
+
def self.end_embedded_r()
|
53
|
+
r_embedded_end()
|
54
|
+
end
|
55
|
+
|
56
|
+
def self.create_list( hash )
|
57
|
+
size = hash.size
|
58
|
+
r_name_vec = create_strvec(hash.keys)
|
59
|
+
|
60
|
+
r_list = r_list_create(r_name_vec, size)
|
61
|
+
ptr_manager_add_ptr_to_current( r_list )
|
62
|
+
|
63
|
+
hash.values.each_with_index(){|v, idx|
|
64
|
+
r_vec = create_vec( v )
|
65
|
+
r_list_set_elem( r_list, idx, r_vec )
|
66
|
+
}
|
67
|
+
return r_list
|
68
|
+
end
|
69
|
+
|
70
|
+
def self.create_dataframe( hash )
|
71
|
+
vec_size_array = hash.map(){|key, val|
|
72
|
+
val.size
|
73
|
+
}
|
74
|
+
if vec_size_array.uniq.size != 1
|
75
|
+
raise "For data.frame, all the element vectors should have the same length."
|
76
|
+
end
|
77
|
+
|
78
|
+
r_list = create_list(hash)
|
79
|
+
r_df = r_list_to_dataframe(r_list)
|
80
|
+
return r_df
|
81
|
+
end
|
82
|
+
|
83
|
+
def self.create_formula_from_syms( ary )
|
84
|
+
raise "create_formula_from_syms should take an Array argument" if(ary.class != Array)
|
85
|
+
raise "Array has an(some) elemnt(s) that are not SymbolR" if(! ary.all? {|i| i.is_a?(SymbolR) || i.is_a?(SignR) })
|
86
|
+
|
87
|
+
str = ary.map(){|sym| sym.val}.join(" ")
|
88
|
+
r_strvec = create_strvec([str])
|
89
|
+
|
90
|
+
r_create_formula = create_function_call( "as.formula" , {"object" => r_strvec})
|
91
|
+
|
92
|
+
r_formula_ptr = exec_function( r_create_formula ) # No need to add_ptr b/c exec_function adds this pointer to ptr_manager.
|
93
|
+
|
94
|
+
return r_formula_ptr
|
95
|
+
end
|
96
|
+
|
97
|
+
def self.create_assign_function( var_name, r_obj )
|
98
|
+
raise "create_assign_function should take an String argument for variable name" if(var_name.class != String)
|
99
|
+
r_var_name = create_strvec ([var_name])
|
100
|
+
r_create_formula = create_function_call( "assign" , {"x" => r_var_name , "value" => r_obj })
|
101
|
+
return r_create_formula
|
102
|
+
end
|
103
|
+
|
104
|
+
def self.create_library_function( lib_name )
|
105
|
+
raise "create_library_function should take an String argument for variable name" if(lib_name.class != String)
|
106
|
+
r_lib_name = create_strvec([lib_name])
|
107
|
+
func = create_function_call( "library", {"package" => r_lib_name})
|
108
|
+
return func
|
109
|
+
end
|
110
|
+
|
111
|
+
def self.create_strvec( ary )
|
112
|
+
raise "create_strvec should take an Array argument" if(ary.class != Array)
|
113
|
+
raise "Array has an(some) elemnt(s) that are not String" if(! ary.all? {|i| i.is_a?(String) })
|
114
|
+
|
115
|
+
r_strvec_ptr = r_vec_create_str(ary.size )
|
116
|
+
|
117
|
+
str_values = FFI::MemoryPointer.new(:pointer, ary.size ) # This is garbage collected by FFI
|
118
|
+
|
119
|
+
strptrs = []
|
120
|
+
ary.each(){|str_elem|
|
121
|
+
strptrs << FFI::MemoryPointer.from_string(str_elem) # Make cstring pointer managed via FFI::MemoryPointer
|
122
|
+
}
|
123
|
+
strptrs.each_with_index do |p, i|
|
124
|
+
str_values[i].put_pointer(0, p)
|
125
|
+
end
|
126
|
+
|
127
|
+
r_vec_set_str( r_strvec_ptr, str_values , ary.size )
|
128
|
+
|
129
|
+
ptr_manager_add_ptr_to_current( r_strvec_ptr )
|
130
|
+
return r_strvec_ptr
|
131
|
+
end
|
132
|
+
|
133
|
+
def self.create_intvec( ary )
|
134
|
+
raise "create_intvec should take an Array argument" if(ary.class != Array)
|
135
|
+
raise "Array has an(some) elemnt(s) that are not Integer" if(! ary.all? {|i| i.is_a?(Integer) })
|
136
|
+
r_intvec_ptr = r_vec_create_int(ary.size)
|
137
|
+
int_values = FFI::MemoryPointer.new(:int, ary.size) # This is garbage collected by FFI
|
138
|
+
int_values.put_array_of_int(0, ary)
|
139
|
+
r_vec_set_int( r_intvec_ptr, int_values , ary.size)
|
140
|
+
|
141
|
+
ptr_manager_add_ptr_to_current( r_intvec_ptr )
|
142
|
+
return r_intvec_ptr
|
143
|
+
end
|
144
|
+
|
145
|
+
def self.create_realvec( ary )
|
146
|
+
raise "create_realvec should take an Array argument" if(ary.class != Array)
|
147
|
+
raise "Array has an(some) elemnt(s) that are not Float" if(! ary.all? {|i| i.is_a?(Float) })
|
148
|
+
r_realvec_ptr = r_vec_create_real(ary.size)
|
149
|
+
dbl_values = FFI::MemoryPointer.new(:double, ary.size) # This is garbage collected by FFI
|
150
|
+
dbl_values.put_array_of_double(0, ary)
|
151
|
+
r_vec_set_real( r_realvec_ptr, dbl_values , ary.size)
|
152
|
+
|
153
|
+
ptr_manager_add_ptr_to_current( r_realvec_ptr )
|
154
|
+
return r_realvec_ptr
|
155
|
+
end
|
156
|
+
|
157
|
+
def self.create_lglvec( ary )
|
158
|
+
raise "create_lglvec should take an Array argument" if(ary.class != Array)
|
159
|
+
raise "Array has an(some) elemnt(s) that are not true or false" if(! ary.all? {|i| [true, false].include?(i) })
|
160
|
+
ary = ary.map{|elem| elem ? 1 : 0 }
|
161
|
+
|
162
|
+
r_lglvec_ptr = r_vec_create_lgl(ary.size)
|
163
|
+
lgl_values = FFI::MemoryPointer.new(:int, ary.size) # This is garbage collected by FFI
|
164
|
+
lgl_values.put_array_of_int(0, ary)
|
165
|
+
r_vec_set_lgl( r_lglvec_ptr, lgl_values , ary.size)
|
166
|
+
|
167
|
+
ptr_manager_add_ptr_to_current( r_lglvec_ptr )
|
168
|
+
return r_lglvec_ptr
|
169
|
+
end
|
170
|
+
|
171
|
+
def self.create_vec( ary )
|
172
|
+
raise "create_vec should take an Array argument" if(ary.class != Array)
|
173
|
+
# (SymbolR >) String > Real > Int > Logical
|
174
|
+
|
175
|
+
type_ary = ary.map(){|elem|
|
176
|
+
case elem
|
177
|
+
when String
|
178
|
+
4
|
179
|
+
when Float
|
180
|
+
3
|
181
|
+
when Integer
|
182
|
+
2
|
183
|
+
when TrueClass
|
184
|
+
1
|
185
|
+
when FalseClass
|
186
|
+
1
|
187
|
+
else
|
188
|
+
nil
|
189
|
+
raise " The current elemnt is not supported to convert to R vector : " + elem
|
190
|
+
end
|
191
|
+
}
|
192
|
+
|
193
|
+
max_type = type_ary.max()
|
194
|
+
|
195
|
+
converted_ary = ary.each_with_index.map(){|elem, idx|
|
196
|
+
if type_ary[idx] != max_type
|
197
|
+
case max_type
|
198
|
+
when 4
|
199
|
+
converted = ary[idx].to_s
|
200
|
+
when 3
|
201
|
+
if(type_ary[idx] == 2)
|
202
|
+
converted = ary[idx].to_f
|
203
|
+
else # 1 : boolean
|
204
|
+
converted = ary[idx] ? 1 : 0
|
205
|
+
end
|
206
|
+
when 2
|
207
|
+
converted = ary[idx].to_i
|
208
|
+
when 1
|
209
|
+
raise "All the elements shold be true/false. Current value: " + ary[idx]
|
210
|
+
end
|
211
|
+
else
|
212
|
+
ary[idx]
|
213
|
+
end
|
214
|
+
}
|
215
|
+
|
216
|
+
case max_type
|
217
|
+
when 4
|
218
|
+
new_r_vec = create_strvec( converted_ary )
|
219
|
+
when 3
|
220
|
+
new_r_vec = create_realvec( converted_ary )
|
221
|
+
when 2
|
222
|
+
new_r_vec = create_intvec( converted_ary )
|
223
|
+
when 1
|
224
|
+
new_r_vec = create_lglvec( converted_ary )
|
225
|
+
end
|
226
|
+
|
227
|
+
return new_r_vec
|
228
|
+
end
|
229
|
+
|
230
|
+
def self.convert_to_r_object(value)
|
231
|
+
case
|
232
|
+
when [String, Integer, Float , TrueClass, FalseClass].include?( value.class )
|
233
|
+
r_obj = RBridge.create_vec( [ value ] )
|
234
|
+
when value.class == Array
|
235
|
+
if value[0].class == RBridge::SymbolR
|
236
|
+
ary = value.map(){|elem|
|
237
|
+
if(value.val == "TRUE" || value.val == "T")
|
238
|
+
true
|
239
|
+
elsif(value.val == "FALSE" || value.val == "F")
|
240
|
+
false
|
241
|
+
else
|
242
|
+
raise "Array of symbols is not accepted except TRUE(T) or FALSE(F) array"
|
243
|
+
end
|
244
|
+
}
|
245
|
+
r_obj = RBridge.create_vec( ary )
|
246
|
+
else
|
247
|
+
r_obj = RBridge.create_vec( value )
|
248
|
+
end
|
249
|
+
when value.class == RBridge::SymbolR # SymbolR with name of T, F, TRUE and FALSE
|
250
|
+
if value.val == "TRUE" || value.val == "T"
|
251
|
+
r_obj = RBridge.create_vec( [true] )
|
252
|
+
elsif value.val == "FALSE" || value.val == "F"
|
253
|
+
r_obj = RBridge.create_vec( [false] )
|
254
|
+
else
|
255
|
+
r_obj = value.to_r_symbol
|
256
|
+
end
|
257
|
+
end
|
258
|
+
return r_obj
|
259
|
+
end
|
260
|
+
|
261
|
+
def self.lcons( car, cdr )
|
262
|
+
new_lcons = r_lang_cons(car, cdr)
|
263
|
+
ptr_manager_add_ptr_to_current( new_lcons )
|
264
|
+
return new_lcons
|
265
|
+
end
|
266
|
+
|
267
|
+
def self.lcons_gen( car )
|
268
|
+
new_lcons = r_lang_cons_gen(car )
|
269
|
+
ptr_manager_add_ptr_to_current( new_lcons )
|
270
|
+
return new_lcons
|
271
|
+
end
|
272
|
+
|
273
|
+
def self.is_r_nil?( obj )
|
274
|
+
result = r_is_nil( obj )
|
275
|
+
if(result == 1)
|
276
|
+
return true
|
277
|
+
else
|
278
|
+
return false
|
279
|
+
end
|
280
|
+
end
|
281
|
+
|
282
|
+
def self.set_tag_to_lcons( lcons, tag_name )
|
283
|
+
r_lang_set_tag( lcons, tag_name )
|
284
|
+
end
|
285
|
+
|
286
|
+
def self.create_function_call( fname, hash )
|
287
|
+
raise "create_function_call should take String for function name" if(fname.class != String)
|
288
|
+
raise "create_function_call should take Hash for function arguments" if(hash.class != Hash)
|
289
|
+
if(hash.size == 0)
|
290
|
+
lcons_args = r_lang_nil()
|
291
|
+
elsif(hash.size == 1)
|
292
|
+
tag = hash.first[0]
|
293
|
+
val = hash.first[1]
|
294
|
+
lcons_args = lcons_gen( val )
|
295
|
+
if( tag != "" )
|
296
|
+
set_tag_to_lcons( lcons_args, tag )
|
297
|
+
end
|
298
|
+
else
|
299
|
+
idx = 0
|
300
|
+
hash.reverse_each(){|arg|
|
301
|
+
tag = arg[0]
|
302
|
+
val = arg[1]
|
303
|
+
if(idx == 0 )
|
304
|
+
lcons_args = lcons_gen( val )
|
305
|
+
else
|
306
|
+
lcons_args = lcons( val, lcons_args )
|
307
|
+
end
|
308
|
+
if( tag != "" )
|
309
|
+
set_tag_to_lcons( lcons_args, tag )
|
310
|
+
end
|
311
|
+
idx = idx + 1
|
312
|
+
}
|
313
|
+
end
|
314
|
+
new_function_call = r_lang_create_fcall(fname, lcons_args)
|
315
|
+
ptr_manager_add_ptr_to_current( new_function_call )
|
316
|
+
return new_function_call
|
317
|
+
end
|
318
|
+
|
319
|
+
def self.exec_function( func , allow_nil_result: false )
|
320
|
+
result = r_eval( func )
|
321
|
+
if ( ! allow_nil_result ) && ( is_r_nil?( result ))
|
322
|
+
raise "Return value of R's function is unintentioanlly nil"
|
323
|
+
end
|
324
|
+
|
325
|
+
if ( ! is_r_nil?( result ) )
|
326
|
+
# if the result is nil, this pointer needs no tracking (for GC)
|
327
|
+
ptr_manager_add_ptr_to_current( result )
|
328
|
+
end
|
329
|
+
return result
|
330
|
+
end
|
331
|
+
|
332
|
+
def self.exec_function_no_return( func )
|
333
|
+
r_eval_no_return( func )
|
334
|
+
return nil
|
335
|
+
end
|
336
|
+
|
337
|
+
|
338
|
+
class SymbolR
|
339
|
+
attr :val
|
340
|
+
|
341
|
+
def initialize( str )
|
342
|
+
@val = str
|
343
|
+
end
|
344
|
+
|
345
|
+
def to_s
|
346
|
+
return @val
|
347
|
+
end
|
348
|
+
|
349
|
+
def to_r_symbol
|
350
|
+
return ::RBridge.r_lang_symbol(@val)
|
351
|
+
end
|
352
|
+
end
|
353
|
+
|
354
|
+
class SignR
|
355
|
+
attr :val
|
356
|
+
|
357
|
+
def initialize( str )
|
358
|
+
@val = str
|
359
|
+
end
|
360
|
+
|
361
|
+
def to_s
|
362
|
+
return @val
|
363
|
+
end
|
364
|
+
end
|
365
|
+
|
366
|
+
|
367
|
+
###########################
|
368
|
+
# Code to manage pointers #
|
369
|
+
###########################
|
370
|
+
|
371
|
+
class RPointerManager
|
372
|
+
def initialize()
|
373
|
+
@ptrs = []
|
374
|
+
end
|
375
|
+
|
376
|
+
def ptr_add(ptr)
|
377
|
+
@ptrs << ptr
|
378
|
+
end
|
379
|
+
|
380
|
+
def ptr_num()
|
381
|
+
@ptrs.size()
|
382
|
+
end
|
383
|
+
|
384
|
+
def close()
|
385
|
+
unprotect_all()
|
386
|
+
@ptrs = []
|
387
|
+
end
|
388
|
+
|
389
|
+
private
|
390
|
+
|
391
|
+
def unprotect(ptr)
|
392
|
+
::RBridge.r_ptr_unprotect(ptr)
|
393
|
+
end
|
394
|
+
|
395
|
+
def unprotect_all
|
396
|
+
@ptrs.each_with_index(){|ptr, idx|
|
397
|
+
unprotect(ptr)
|
398
|
+
}
|
399
|
+
end
|
400
|
+
end
|
401
|
+
|
402
|
+
@gc_counter = 0
|
403
|
+
@ptr_managers = { "" => RPointerManager.new() }
|
404
|
+
@ptr_manager_stack = [""]
|
405
|
+
|
406
|
+
private_class_method def self.current_ptr_manger_name
|
407
|
+
@ptr_manager_stack.last()
|
408
|
+
end
|
409
|
+
|
410
|
+
def self.ptr_manager_open( ptr_manager_name )
|
411
|
+
if block_given?
|
412
|
+
ptr_manager_create_or_switch( ptr_manager_name )
|
413
|
+
begin
|
414
|
+
yield
|
415
|
+
rescue => e
|
416
|
+
raise e
|
417
|
+
ensure
|
418
|
+
ptr_manager_close( ptr_manager_name ) # This part is always conducted at the end of block or when error raised within block
|
419
|
+
end
|
420
|
+
else
|
421
|
+
ptr_manager_create_or_switch( ptr_manager_name )
|
422
|
+
end
|
423
|
+
end
|
424
|
+
|
425
|
+
def self.ptr_manager_close( ptr_manager_name )
|
426
|
+
raise "RPointerManager(" + ptr_manager_name + ") does not exist" if ! @ptr_managers.keys.include?( ptr_manager_name )
|
427
|
+
raise "RPointerManager with empty string name should never be closed." if ptr_manager_name == ""
|
428
|
+
|
429
|
+
@gc_counter = @gc_counter - (@ptr_managers[ptr_manager_name]).ptr_num()
|
430
|
+
@ptr_managers[ptr_manager_name].close()
|
431
|
+
|
432
|
+
@ptr_managers.delete(ptr_manager_name)
|
433
|
+
@ptr_manager_stack.delete(ptr_manager_name)
|
434
|
+
end
|
435
|
+
|
436
|
+
def self.ptr_manager_switch( ptr_manager_name )
|
437
|
+
raise "ptr_manager_name does not exit yet: #{ptr_manager_name}" if ! @ptr_managers.keys.include?( ptr_manager_name )
|
438
|
+
raise "ptr_manager_name does not exit yet: #{ptr_manager_name}" if ! @ptr_manager_stack.include?( ptr_manager_name )
|
439
|
+
|
440
|
+
# put the specified name on top(last) of stack
|
441
|
+
@ptr_manager_stack.delete( ptr_manager_name ) && ( @ptr_manager_stack << ptr_manager_name )
|
442
|
+
end
|
443
|
+
|
444
|
+
private_class_method def self.ptr_manager_add_ptr_to( ptr_manager_name, ptr )
|
445
|
+
ptr_manager = @ptr_managers[ptr_manager_name]
|
446
|
+
|
447
|
+
ptr_manager.ptr_add( ptr )
|
448
|
+
@gc_counter = @gc_counter + 1
|
449
|
+
end
|
450
|
+
|
451
|
+
private_class_method def self.ptr_manager_add_ptr_to_current(ptr)
|
452
|
+
ptr_manager_add_ptr_to( current_ptr_manger_name() , ptr )
|
453
|
+
end
|
454
|
+
|
455
|
+
private_class_method def self.ptr_manager_create_or_switch( ptr_manager_name )
|
456
|
+
if ! @ptr_managers.keys.include?( ptr_manager_name )
|
457
|
+
@ptr_managers[ ptr_manager_name ] = RPointerManager.new()
|
458
|
+
@ptr_manager_stack << ptr_manager_name
|
459
|
+
else
|
460
|
+
ptr_manager_switch(ptr_manager_name)
|
461
|
+
end
|
462
|
+
end
|
463
|
+
|
464
|
+
|
465
|
+
# public
|
466
|
+
def self.gc_all()
|
467
|
+
num_of_objs_by_ptr_managers = @ptr_managers.map(){|key,r_obj| r_obj}.reduce(0){| result, elem | result + elem.ptr_num() }
|
468
|
+
if(@gc_counter != num_of_objs_by_ptr_managers)
|
469
|
+
puts "RBridge internal error: R object counting and tracking mismatch"
|
470
|
+
puts "GC counter: #{@gc_counter} Num of objects under ptr managers: #{num_of_objs_by_ptr_managers}"
|
471
|
+
end
|
472
|
+
|
473
|
+
r_ptr_gc( @gc_counter )
|
474
|
+
@gc_counter = 0
|
475
|
+
end
|
476
|
+
|
477
|
+
end
|
478
|
+
|
479
|
+
|
480
|
+
|