r_bridge 0.5.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,5 @@
1
+ void
2
+ Init_librbridge()
3
+ {
4
+ // nop
5
+ }
@@ -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
+
@@ -0,0 +1,10 @@
1
+ #ifndef WIN_COMPAT_H
2
+ #define WIN_COMPAT_H
3
+
4
+ #ifdef _WIN
5
+ #define EXPORT __declspec(dllexport)
6
+ #else
7
+ #define EXPORT // For other OS
8
+ #endif
9
+
10
+ #endif // WIN_COMPAT_H
@@ -0,0 +1,10 @@
1
+ require "r_bridge/version"
2
+
3
+ require 'r_bridge/r_bridge_ffi'
4
+ require 'r_bridge/r_bridge_lazyfunc_ext'
5
+
6
+ module RBridge
7
+ class Error < StandardError; end
8
+ # Your code goes here...
9
+ end
10
+
@@ -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
+