RSRuby 0.4.0

Sign up to get free protection for your applications and to get access to all the features.
data/README ADDED
@@ -0,0 +1,102 @@
1
+ == Introduction
2
+
3
+ RSRuby is a partial conversion of RPy (http://rpy.sourceforge.net/), the original RSRuby was based on RSPerl (http://www.omegahat.org/RSPerl/) (hence RSRuby), however almost all the code is now from RPy. RSRuby provides the ability to embed a full R interpreter inside a running Ruby script. R methods can then be called from the Ruby script and data passed between the R interpreter and the Ruby script.
4
+
5
+ == License
6
+
7
+ Copyright (C) 2006 Alex Gutteridge
8
+
9
+ The Original Code is the RPy python module.
10
+
11
+ The Initial Developer of the Original Code is Walter Moreira.
12
+ Portions created by the Initial Developer are Copyright (C) 2002
13
+ the Initial Developer. All Rights Reserved.
14
+
15
+ Contributor(s):
16
+ Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
17
+
18
+ This library is free software; you can redistribute it and/or
19
+ modify it under the terms of the GNU Lesser General Public
20
+ License as published by the Free Software Foundation; either
21
+ version 2.1 of the License, or (at your option) any later version.
22
+
23
+ This library is distributed in the hope that it will be useful,
24
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
25
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
26
+ Lesser General Public License for more details.
27
+
28
+ You should have received a copy of the GNU Lesser General Public
29
+ License along with this library; if not, write to the Free Software
30
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
31
+
32
+ == Installation
33
+
34
+ Obviously a working R installation is required. R must have been installed/built with the '--enable-R-shlib' option enabled to provide the R shared library. I have tested on R version 2.2.1, but earlier version might work.
35
+
36
+ Firstly, on OS X please set the compiler to gcc 3.3
37
+
38
+ sudo gcc_select 3.3
39
+
40
+ Then (on all systems) to install:
41
+
42
+ 1. Set the R_HOME environment variable appropriately:
43
+
44
+ R_HOME=/usr/lib/R (on my Ubuntu Linux box)
45
+ R_HOME=/Library/Frameworks/R.framework/Resources (on OS X)
46
+
47
+ 2. Compile/install the Ruby library using setup.rb. You need to supply the location of your R installation for the libR shared library. This may be the same as R_HOME, e.g. ('/usr/lib/R' on Ubuntu, '/Library/Frameworks/R.framework/Resources' on OS X):
48
+
49
+ cd rsruby
50
+ ruby setup.rb config -- --with-R-dir=/usr/lib/R
51
+ ruby setup.rb setup
52
+ sudo ruby setup.rb install
53
+
54
+ If RSRuby does not compile you may need to configure the path to the R library (this wasn't required on either of my machines, but your mileage may vary). From the RPy README, anyone of the following should be sufficient:
55
+
56
+ o make a link to RHOME/bin/libR.so in /usr/local/lib or /usr/lib, then
57
+ run 'ldconfig',
58
+
59
+ o or, put the following line in your .bashrc (or equivalent):
60
+
61
+ export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:RHOME/bin
62
+
63
+ o or, edit the file /etc/ld.so.conf and add the following line:
64
+
65
+ RHOME/bin
66
+
67
+ and then, run 'ldconfig'.
68
+
69
+ 3. Test it.
70
+
71
+ ruby setup.rb test
72
+
73
+ Should pass all tests.
74
+
75
+ == Installation Notes
76
+
77
+ If you're brave then you can combine the config, setup and install steps into 'sudo ruby setup.rb all -- --with-R-dir=/usr/lib/R'.
78
+
79
+ You can avoid needing root/sudo access in the install step by providing setup.rb with a suitable install directory (such as home). Please run 'ruby setup.rb --help' for more details.
80
+
81
+ A Ruby Gem version of RSRuby is also available.
82
+
83
+ == Usage
84
+
85
+ To use (read examples and tests for more hints - the RPy manual will also be helpful until I have written something similar myself!):
86
+
87
+ #Initialize R
88
+ require 'rsruby'
89
+
90
+ #RSRuby uses Singleton design pattern so call instance rather
91
+ #than new
92
+ r = RSRuby.instance
93
+ #Call R functions
94
+ data = r.rnorm(100)
95
+ r.plot(data)
96
+ sleep(2)
97
+ #Call with named args
98
+ r.plot({'x' => data,
99
+ 'y' => data,
100
+ 'xlab' => 'test',
101
+ 'ylab' => 'test'})
102
+ sleep(2)
@@ -0,0 +1,99 @@
1
+ require 'rsruby'
2
+
3
+ class ERObj
4
+
5
+ @@x = 1
6
+
7
+ def initialize(robj)
8
+ @robj = robj
9
+ @r = RSRuby.instance
10
+ end
11
+
12
+ def as_r
13
+ @robj.as_r
14
+ end
15
+
16
+ def lcall(args)
17
+ @robj.lcall(args)
18
+ end
19
+
20
+ def to_s
21
+
22
+ @@x += 1
23
+
24
+ mode = RSRuby.get_default_mode
25
+ RSRuby.set_default_mode(RSRuby::NO_CONVERSION)
26
+ a = @r.textConnection("tmpobj#{@@x}",'w')
27
+
28
+ RSRuby.set_default_mode(RSRuby::BASIC_CONVERSION)
29
+ @r.sink(:file => a, :type => 'output')
30
+ @r.print_(@robj)
31
+ @r.sink.call()
32
+ @r.close_connection(a)
33
+
34
+ str = @r["tmpobj#{@@x}"].join("\n")
35
+
36
+ RSRuby.set_default_mode(mode)
37
+
38
+ return str
39
+
40
+ end
41
+
42
+ def method_missing(attr)
43
+ mode = RSRuby.get_default_mode
44
+ RSRuby.set_default_mode(RSRuby::BASIC_CONVERSION)
45
+ e = @r['$'].call(@robj,attr.to_s)
46
+ RSRuby.set_default_mode(mode)
47
+ return e
48
+ end
49
+
50
+ end
51
+
52
+ class DataFrame < ERObj
53
+
54
+ def rows
55
+ return @r.attr(@robj, 'row.names')
56
+ end
57
+
58
+ def columns
59
+ cols = @r.colnames(@robj)
60
+ cols = [cols] unless cols.class == 'Array'
61
+ return cols
62
+ end
63
+
64
+ def method_missing(attr)
65
+ attr = attr.to_s
66
+ mode = RSRuby.get_default_mode
67
+ RSRuby.set_default_mode(RSRuby::BASIC_CONVERSION)
68
+ column_names = @r.colnames(@robj)
69
+ if attr == column_names or column_names.include?(attr)
70
+ RSRuby.set_default_mode(mode)
71
+ return @r['$'].call(@robj,attr.to_s)
72
+ end
73
+
74
+ #? Not sure what here...
75
+ RSRuby.set_default_mode(mode)
76
+ return super(attr)
77
+
78
+ end
79
+
80
+ end
81
+
82
+ r = RSRuby.instance
83
+
84
+ r.class_table['data.frame'] = lambda{|x| DataFrame.new(x)}
85
+
86
+ r.library('affy')
87
+
88
+ r.eval_R("mydata <- ReadAffy()")
89
+ r.eval_R("eset.rma <- rma(mydata)")
90
+ r.eval_R("eset.pma <- mas5calls(mydata)")
91
+
92
+ RSRuby.set_default_mode(RSRuby::CLASS_CONVERSION)
93
+ frame = r.eval_R("data.frame(exprs(eset.rma), exprs(eset.pma), se.exprs(eset.pma))")
94
+
95
+ puts frame.class
96
+ puts frame.rows.join(" ")
97
+ puts frame.columns.join(" ")
98
+
99
+ puts frame.send('COLD_12H_SHOOT_REP1.cel'.to_sym)
@@ -0,0 +1,15 @@
1
+ require 'rsruby'
2
+ require 'rsruby/dataframe'
3
+
4
+ r.class_table['data.frame'] = lambda{|x| DataFrame.new(x)}
5
+ RSRuby.set_default_mode(RSRuby::CLASS_CONVERSION)
6
+
7
+ #slight kludge here need to use this form because of the
8
+ #calling with keywords semantics are different to RPy
9
+ e = r.as_data_frame(:x => {'foo' => [4,5,6], 'bar' => ['X','Y','Z']})
10
+
11
+ puts e
12
+ puts e.foo.join(" ")
13
+ puts e.bar.join(" ")
14
+ puts e.rows.join(" ")
15
+ puts e.columns.join(" ")
@@ -0,0 +1,16 @@
1
+ require 'rsruby'
2
+ require 'rsruby/erobj'
3
+
4
+ r = RSRuby.instance
5
+ r.proc_table[lambda{|x| true}] = lambda{|x| ERObj.new(x)}
6
+ RSRuby.set_default_mode(RSRuby::PROC_CONVERSION)
7
+
8
+ e = r.t_test([1,2,3,4,5,6])
9
+
10
+ puts e
11
+ puts "t value: #{e.statistic['t']}"
12
+
13
+ f = r.t_test([1,2,3])
14
+
15
+ puts f
16
+ puts "t value: #{f.statistic['t']}"
@@ -0,0 +1,657 @@
1
+ /*
2
+ * == Author
3
+ * Alex Gutteridge
4
+ *
5
+ * == Copyright
6
+ *Copyright (C) 2006 Alex Gutteridge
7
+ *
8
+ * The Original Code is the RPy python module.
9
+ *
10
+ * The Initial Developer of the Original Code is Walter Moreira.
11
+ * Portions created by the Initial Developer are Copyright (C) 2002
12
+ * the Initial Developer. All Rights Reserved.
13
+ *
14
+ * Contributor(s):
15
+ * Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
16
+ *
17
+ *This library is free software; you can redistribute it and/or
18
+ *modify it under the terms of the GNU Lesser General Public
19
+ *License as published by the Free Software Foundation; either
20
+ *version 2.1 of the License, or (at your option) any later version.
21
+ *
22
+ *This library is distributed in the hope that it will be useful,
23
+ *but WITHOUT ANY WARRANTY; without even the implied warranty of
24
+ *MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25
+ *Lesser General Public License for more details.
26
+ *
27
+ *You should have received a copy of the GNU Lesser General Public
28
+ *License along with this library; if not, write to the Free Software
29
+ *Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30
+ */
31
+
32
+ #include <rsruby.h>
33
+ #include "Converters.h"
34
+
35
+ // ************** Converters from Ruby to R *********//
36
+
37
+
38
+ SEXP ruby_to_R(VALUE obj)
39
+ {
40
+ SEXP robj;
41
+
42
+ //Return nil if object is nil
43
+ if (obj == Qnil) {
44
+ return R_NilValue;
45
+ }
46
+
47
+ //If object has 'as_r' then call it and use
48
+ //returned value subsequently
49
+ if (rb_respond_to(obj, rb_intern("as_r"))){
50
+ obj = rb_funcall(obj,rb_intern("as_r"),0);
51
+ if (!obj)
52
+ return NULL;
53
+ }
54
+
55
+ if (Robj_Check(obj))
56
+ {
57
+ Data_Get_Struct(obj, struct SEXPREC, robj);
58
+ PROTECT(robj);
59
+ }
60
+ else if (obj == Qtrue || obj == Qfalse)
61
+ {
62
+ PROTECT(robj = NEW_LOGICAL(1));
63
+ if (obj == Qtrue){
64
+ LOGICAL_DATA(robj)[0] = TRUE;
65
+ } else {
66
+ LOGICAL_DATA(robj)[0] = FALSE;
67
+ }
68
+
69
+ }
70
+ else if (TYPE(obj) == T_FIXNUM ||
71
+ TYPE(obj) == T_BIGNUM)
72
+ {
73
+ PROTECT(robj = NEW_INTEGER(1));
74
+ INTEGER_DATA(robj)[0] = NUM2LONG(obj);
75
+ }
76
+ else if (TYPE(obj) == T_FLOAT)
77
+ {
78
+ PROTECT(robj = NEW_NUMERIC(1));
79
+ NUMERIC_DATA(robj)[0] = NUM2DBL(obj);
80
+ }
81
+ else if (RubyComplex_Check(obj))
82
+ {
83
+ PROTECT(robj = NEW_COMPLEX(1));
84
+ COMPLEX_DATA(robj)[0].r = NUM2DBL(rb_funcall(obj,rb_intern("real"),0));
85
+ COMPLEX_DATA(robj)[0].i = NUM2DBL(rb_funcall(obj,rb_intern("image"),0));
86
+ }
87
+ else if (!NIL_P(rb_check_string_type(obj)))
88
+ {
89
+ PROTECT(robj = NEW_STRING(1));
90
+ SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(RSTRING(obj)->ptr));
91
+ }
92
+ else if (!NIL_P(rb_check_array_type(obj)))
93
+ {
94
+ PROTECT(robj = array_to_R(obj));
95
+ }
96
+ else if (TYPE(obj) == T_HASH)
97
+ {
98
+ PROTECT(robj = hash_to_R(obj));
99
+ }
100
+ else
101
+ {
102
+ rb_raise(rb_eArgError,"Unsupported object passed to R.\n");
103
+ PROTECT(robj = NULL); /* Protected to avoid stack inbalance */
104
+ }
105
+
106
+ UNPROTECT(1);
107
+ return robj;
108
+ }
109
+
110
+ /* Make a R list or vector from a Ruby array */
111
+ static SEXP array_to_R(VALUE obj)
112
+ {
113
+ VALUE it;
114
+ SEXP robj, rit;
115
+ int i, len, state;
116
+
117
+ /* This matrix defines what mode a vector should take given what
118
+ it already contains and a new item
119
+
120
+ E.g. Row 0 indicates that if we've seen an any, the vector will
121
+ always remain an any. Row 3 indicates that if we've seen a
122
+ float, then seeing an boolean, integer, or float will preserve
123
+ the vector as a float vector, while seeing a string or an Robj will
124
+ convert it into an any vector.
125
+ */
126
+ int fsm[7][7] = {
127
+ {0, 0, 0, 0, 0, 0, 0}, // any
128
+ {0, 1, 2, 3, 4, 0, 0}, // bool
129
+ {0, 2, 2, 3, 4, 0, 0}, // int
130
+ {0, 3, 3, 3, 4, 0, 0}, // float
131
+ {0, 4, 4, 4, 4, 0, 0}, // complex
132
+ {0, 0, 0, 0, 0, 5, 0}, // string
133
+ {0, 0, 0, 0, 0, 0, 6} // RObj
134
+ };
135
+
136
+ //Probably unnessecary but just in case
137
+ obj = rb_check_array_type(obj);
138
+
139
+ if (RARRAY(obj)->len == 0)
140
+ return R_NilValue;
141
+
142
+ PROTECT(robj = NEW_LIST(RARRAY(obj)->len));
143
+
144
+ state = -1;
145
+ for (i=0; i<RARRAY(obj)->len; i++) {
146
+ if (!(it = rb_ary_entry(obj, i)))
147
+ goto exception;
148
+
149
+ if (state < 0)
150
+ state = type_to_int(it);
151
+ else
152
+ state = fsm[state][type_to_int(it)];
153
+
154
+ if (!(rit = ruby_to_R(it)))
155
+ goto exception;
156
+
157
+ SET_VECTOR_ELT(robj, i, rit);
158
+ }
159
+
160
+ switch(state)
161
+ {
162
+ case INT_T:
163
+ robj = AS_INTEGER(robj);
164
+ break;
165
+ case BOOL_T:
166
+ robj = AS_LOGICAL(robj);
167
+ break;
168
+ case FLOAT_T:
169
+ robj = AS_NUMERIC(robj);
170
+ break;
171
+ case COMPLEX_T:
172
+ robj = AS_COMPLEX(robj);
173
+ break;
174
+ case STRING_T:
175
+ robj = AS_CHARACTER(robj);
176
+ break;
177
+ default:;
178
+ /* Otherwise, it's either an ANY_T or ROBJ_T - we want ANY */
179
+ }
180
+
181
+ UNPROTECT(1);
182
+ return robj;
183
+
184
+ exception:
185
+ UNPROTECT(1);
186
+ return NULL;
187
+ }
188
+
189
+ /* Make a R named list or vector from a Ruby Hash */
190
+ static SEXP
191
+ hash_to_R(VALUE obj)
192
+ {
193
+ int len;
194
+ VALUE keys, values;
195
+ SEXP robj, names;
196
+
197
+ //TODO - Baffling. Not sure what's wrong with these functions?
198
+ //rb_hash_keys(proc_table);
199
+ //rb_hash_values(proc_table);
200
+ //rb_hash_size(proc_table);
201
+ //compiles, but complains they are undefined symbols when run...
202
+
203
+ if (FIX2INT(rb_funcall(obj,rb_intern("size"),0)) == 0)
204
+ return R_NilValue;
205
+
206
+ /* If 'keys' succeed and 'values' fails this leaks */
207
+ if (!(keys = rb_funcall(obj,rb_intern("keys"),0)))
208
+ return NULL;
209
+ if (!(values = rb_funcall(obj,rb_intern("values"),0)))
210
+ return NULL;
211
+
212
+ if (!(robj = array_to_R(values)))
213
+ goto fail;
214
+ if (!(names = array_to_R(keys)))
215
+ goto fail;
216
+
217
+ PROTECT(robj);
218
+ SET_NAMES(robj, names);
219
+ UNPROTECT(1);
220
+
221
+ return robj;
222
+
223
+ fail:
224
+ return NULL;
225
+ }
226
+
227
+ static int
228
+ type_to_int(VALUE obj)
229
+ {
230
+ if (obj == Qtrue || obj == Qfalse)
231
+ return BOOL_T;
232
+ else if (TYPE(obj) == T_FIXNUM ||
233
+ TYPE(obj) == T_BIGNUM)
234
+ return INT_T;
235
+ else if (TYPE(obj) == T_FLOAT)
236
+ return FLOAT_T;
237
+ else if (RubyComplex_Check(obj))
238
+ return COMPLEX_T;
239
+ //NB (TODO): This line means that objects are coerced into
240
+ //String form if possible rather than leaving them as RObj
241
+ else if (!NIL_P(rb_check_string_type(obj)))
242
+ return STRING_T;
243
+ else if (Robj_Check(obj))
244
+ return ROBJ_T;
245
+ else
246
+ return ANY_T;
247
+ }
248
+
249
+ // ************** Converters from R to Ruby *********//
250
+
251
+ VALUE to_ruby_with_mode(SEXP robj, int mode)
252
+ {
253
+ VALUE obj;
254
+ int i;
255
+
256
+ switch (mode)
257
+ {
258
+ case PROC_CONVERSION:
259
+ i = to_ruby_proc(robj, &obj);
260
+ if (i<0) return Qnil;
261
+ if (i==1) break;
262
+ case CLASS_CONVERSION:
263
+ i = to_ruby_class(robj, &obj);
264
+ if (i<0) return Qnil;
265
+ if (i==1) break;
266
+ case BASIC_CONVERSION:
267
+ i = to_ruby_basic(robj, &obj);
268
+ if (i<0) return Qnil;
269
+ if (i==1) break;
270
+ case VECTOR_CONVERSION:
271
+ i = to_ruby_vector(robj, &obj, mode=VECTOR_CONVERSION);
272
+ if (i<0) return Qnil;
273
+ if (i==1) break;
274
+ default:
275
+ obj = Data_Wrap_Struct(rb_const_get(rb_cObject,
276
+ rb_intern("RObj")), 0, 0, robj);
277
+ rb_iv_set(obj,"@conversion",INT2FIX(TOP_MODE));
278
+ }
279
+
280
+ return obj;
281
+ }
282
+
283
+ /* Convert an R object to a 'basic' Ruby object (mode 2) */
284
+ /* NOTE: R vectors of length 1 will yield a Ruby scalar */
285
+ int
286
+ to_ruby_basic(SEXP robj, VALUE *obj)
287
+ {
288
+ int status;
289
+ VALUE tmp;
290
+
291
+ status = to_ruby_vector(robj, &tmp, BASIC_CONVERSION);
292
+
293
+ if(status==1 && TYPE(tmp) == T_ARRAY && RARRAY(tmp)->len == 1)
294
+ {
295
+ *obj = rb_ary_entry(tmp, 0);
296
+ }
297
+ else
298
+ *obj = tmp;
299
+
300
+ return status;
301
+ }
302
+
303
+
304
+ /* Convert an R object to a 'vector' Ruby object (mode 1) */
305
+ /* NOTE: R vectors of length 1 will yield a Ruby array of length 1*/
306
+ int
307
+ to_ruby_vector(SEXP robj, VALUE *obj, int mode)
308
+ {
309
+ VALUE it, tmp;
310
+ VALUE params[2];
311
+ SEXP names, dim;
312
+ int len, *integers, i, type;
313
+ char *strings, *thislevel;
314
+ double *reals;
315
+ Rcomplex *complexes;
316
+
317
+ if (!robj)
318
+ return -1; /* error */
319
+
320
+ if (robj == R_NilValue) {
321
+ *obj = Qnil;
322
+ return 1; /* succeed */
323
+ }
324
+
325
+ len = GET_LENGTH(robj);
326
+ tmp = rb_ary_new2(len);
327
+ type = TYPEOF(robj);
328
+
329
+ for (i=0; i<len; i++) {
330
+ switch (type)
331
+ {
332
+ case LGLSXP:
333
+ integers = INTEGER(robj);
334
+ if(integers[i]==NA_INTEGER) /* watch out for NA's */
335
+ {
336
+ if (!(it = INT2NUM(integers[i])))
337
+ return -1;
338
+ }
339
+ //TODO - not sure of the conversion here.
340
+ else if (integers[i] != 0){
341
+ it = Qtrue;
342
+ } else if (integers[i] == 0){
343
+ it = Qfalse;
344
+ } else {
345
+ return -1;
346
+ }
347
+ break;
348
+ case INTSXP:
349
+ integers = INTEGER(robj);
350
+ if(isFactor(robj)) {
351
+ /* Watch for NA's! */
352
+ if(integers[i]==NA_INTEGER)
353
+ it = rb_str_new2(CHAR(NA_STRING));
354
+ else
355
+ {
356
+ thislevel = CHAR(STRING_ELT(GET_LEVELS(robj), integers[i]-1));
357
+ if (!(it = rb_str_new2(thislevel)))
358
+ return -1;
359
+ }
360
+ }
361
+ else {
362
+ if (!(it = LONG2NUM(integers[i])))
363
+ return -1;
364
+ }
365
+ break;
366
+ case REALSXP:
367
+ reals = REAL(robj);
368
+ if (!(it = rb_float_new(reals[i])))
369
+ return -1;
370
+ break;
371
+ case CPLXSXP:
372
+ complexes = COMPLEX(robj);
373
+
374
+ params[0] = rb_float_new(complexes[i].r);
375
+ params[1] = rb_float_new(complexes[i].i);
376
+
377
+ if (!(it = rb_class_new_instance(2, params, rb_const_get(rb_cObject, rb_intern("Complex")))))
378
+
379
+ return -1;
380
+ break;
381
+ case STRSXP:
382
+ if(STRING_ELT(robj, i)==R_NaString)
383
+ it = rb_str_new2(CHAR(NA_STRING));
384
+ else
385
+ {
386
+ strings = CHAR(STRING_ELT(robj, i));
387
+ if (!(it = rb_str_new2(strings)))
388
+ return -1;
389
+ }
390
+ break;
391
+ case LISTSXP:
392
+ if (!(it = to_ruby_with_mode(elt(robj, i), mode)))
393
+ return -1;
394
+ break;
395
+ case VECSXP:
396
+ if (!(it = to_ruby_with_mode(VECTOR_ELT(robj, i), mode)))
397
+ return -1;
398
+ break;
399
+ default:
400
+ return 0; /* failed */
401
+ }
402
+ rb_ary_store(tmp, i, it);
403
+ }
404
+
405
+ dim = GET_DIM(robj);
406
+ if (dim != R_NilValue) {
407
+ len = GET_LENGTH(dim);
408
+ *obj = to_ruby_array(tmp, INTEGER(dim), len);
409
+ return 1;
410
+ }
411
+
412
+ names = GET_NAMES(robj);
413
+ if (names == R_NilValue)
414
+ *obj = tmp;
415
+ else {
416
+ *obj = to_ruby_hash(tmp, names);
417
+ }
418
+
419
+ return 1;
420
+ }
421
+
422
+ /* Search a conversion procedure from the proc table */
423
+ int
424
+ from_proc_table(SEXP robj, VALUE *fun)
425
+ {
426
+ VALUE proc_table, procs, proc, funs, res, obj, mode;
427
+ int i, l, error;
428
+
429
+ proc_table = rb_cvar_get(rb_const_get(rb_cObject,
430
+ rb_intern("RSRuby")),
431
+ rb_intern("@@proc_table"));
432
+
433
+ proc = Qnil;
434
+
435
+ //TODO - Baffling. Not sure what's wrong with these functions?
436
+ //procs = rb_hash_keys(proc_table);
437
+ //funs = rb_hash_values(proc_table);
438
+ //l = FIX2INT(rb_hash_size(proc_table));
439
+
440
+ procs = rb_funcall(proc_table,rb_intern("keys"),0);
441
+ funs = rb_funcall(proc_table,rb_intern("values"),0);
442
+ l = FIX2INT(rb_funcall(proc_table,rb_intern("size"),0));
443
+
444
+ obj = Data_Wrap_Struct(rb_const_get(rb_cObject,
445
+ rb_intern("RObj")), 0, 0, robj);
446
+ rb_iv_set(obj,"@conversion",INT2FIX(TOP_MODE));
447
+
448
+ error = 0;
449
+ for (i=0; i<l; i++) {
450
+ proc = rb_ary_entry(procs, i);
451
+
452
+ //TODO - something strange here in RPy isn't there infinite
453
+ //recursion?? We set to basic mode in function to avoid.
454
+ mode = rb_cvar_get(rb_const_get(rb_cObject,
455
+ rb_intern("RSRuby")),
456
+ rb_intern("@@default_mode"));
457
+ rb_cvar_set(rb_const_get(rb_cObject,
458
+ rb_intern("RSRuby")),
459
+ rb_intern("@@default_mode"),
460
+ INT2FIX(BASIC_CONVERSION),Qtrue);
461
+
462
+ //Call function
463
+ res = rb_funcall(proc, rb_intern("call"), 1, obj);
464
+
465
+ //Reset mode
466
+ rb_cvar_set(rb_const_get(rb_cObject,
467
+ rb_intern("RSRuby")),
468
+ rb_intern("@@default_mode"),
469
+ mode,Qtrue);
470
+
471
+ if (!res) {
472
+ error = -1;
473
+ break;
474
+ }
475
+ if (RTEST(res)) {
476
+ *fun = rb_ary_entry(funs, i);
477
+ break;
478
+ }
479
+ }
480
+
481
+ return error;
482
+ }
483
+
484
+ int
485
+ to_ruby_proc(SEXP robj, VALUE *obj)
486
+ {
487
+ VALUE fun=Qnil, tmp, mode;
488
+ int i;
489
+
490
+ //Find function from proc table. integer is returned
491
+ //to indicate success/failure
492
+
493
+ i = from_proc_table(robj, &fun);
494
+
495
+ if (i < 0)
496
+ return -1; /* an error occurred */
497
+
498
+ if (fun==Qnil)
499
+ return 0; /* conversion failed */
500
+
501
+ //Create new object based on robj and call the function
502
+ //found above with it as argument
503
+ tmp = Data_Wrap_Struct(rb_const_get(rb_cObject,
504
+ rb_intern("RObj")), 0, 0, robj);
505
+ rb_iv_set(tmp,"@conversion",INT2FIX(TOP_MODE));
506
+
507
+ //Again set conversion mode to basic to prevent recursion
508
+ mode = rb_cvar_get(rb_const_get(rb_cObject,
509
+ rb_intern("RSRuby")),
510
+ rb_intern("@@default_mode"));
511
+ rb_cvar_set(rb_const_get(rb_cObject,
512
+ rb_intern("RSRuby")),
513
+ rb_intern("@@default_mode"),
514
+ INT2FIX(BASIC_CONVERSION),Qtrue);
515
+
516
+ *obj = rb_funcall(fun, rb_intern("call"), 1, tmp);
517
+
518
+ //And reset mode
519
+ rb_cvar_set(rb_const_get(rb_cObject,
520
+ rb_intern("RSRuby")),
521
+ rb_intern("@@default_mode"),
522
+ mode,Qtrue);
523
+
524
+ return 1; /* conversion succeed */
525
+ }
526
+
527
+ /* Search a conversion procedure from the class attribute */
528
+ VALUE from_class_table(SEXP robj)
529
+ {
530
+ SEXP rclass;
531
+ VALUE key, fun, class_table;
532
+ int i;
533
+
534
+ class_table = rb_cvar_get(rb_const_get(rb_cObject,
535
+ rb_intern("RSRuby")),
536
+ rb_intern("@@class_table"));
537
+
538
+ PROTECT(rclass = GET_CLASS(robj));
539
+
540
+ fun = Qnil;
541
+ if (rclass != R_NilValue) {
542
+
543
+ //key may be an array or string depending on
544
+ //the class specification
545
+ key = to_ruby_with_mode(rclass, BASIC_CONVERSION);
546
+ fun = rb_hash_aref(class_table, key);
547
+
548
+ //If we haven't found a function then go through
549
+ //each class in rclass and look for a match
550
+ if (fun==Qnil) {
551
+
552
+ for (i=0; i<GET_LENGTH(rclass); i++){
553
+ fun = rb_hash_aref(class_table,
554
+ rb_str_new2(CHAR(STRING_ELT(rclass, i))));
555
+ if (fun != Qnil){
556
+ break;
557
+ }
558
+ }
559
+ }
560
+ }
561
+ UNPROTECT(1);
562
+ return fun;
563
+ }
564
+
565
+ /* Convert a Robj to a Ruby object via the class table (mode 3) */
566
+ /* See the docs for conversion rules */
567
+ int
568
+ to_ruby_class(SEXP robj, VALUE *obj)
569
+ {
570
+ VALUE fun, tmp;
571
+
572
+ fun = from_class_table(robj);
573
+
574
+ if (fun==Qnil)
575
+ return 0; /* conversion failed */
576
+
577
+ tmp = Data_Wrap_Struct(rb_const_get(rb_cObject,
578
+ rb_intern("RObj")), 0, 0, robj);
579
+ rb_iv_set(tmp,"@conversion",INT2FIX(TOP_MODE));
580
+
581
+ *obj = rb_funcall(fun, rb_intern("call"), 1, tmp);
582
+
583
+ return 1; /* conversion succeed */
584
+ }
585
+
586
+ /* Convert a R named vector or list to a Ruby Hash */
587
+ static VALUE to_ruby_hash(VALUE obj, SEXP names)
588
+ {
589
+ int len, i;
590
+ VALUE it, hash;
591
+ char *name;
592
+
593
+ if ((len = RARRAY(obj)->len) < 0)
594
+ return Qnil;
595
+
596
+ hash = rb_hash_new();
597
+ for (i=0; i<len; i++) {
598
+ it = rb_ary_entry(obj, i);
599
+ name = CHAR(STRING_ELT(names, i));
600
+ rb_hash_aset(hash, rb_str_new2(name), it);
601
+ }
602
+
603
+ return hash;
604
+ }
605
+
606
+ /* We need to transpose the list because R makes array by the
607
+ * fastest index */
608
+ static VALUE ltranspose(VALUE list, int *dims, int *strides,
609
+ int pos, int shift, int len)
610
+ {
611
+ VALUE nl, it;
612
+ int i;
613
+
614
+ if (!(nl = rb_ary_new2(dims[pos])))
615
+ return Qnil;
616
+
617
+ if (pos == len-1) {
618
+ for (i=0; i<dims[pos]; i++) {
619
+ if (!(it = rb_ary_entry(list, i*strides[pos]+shift)))
620
+ return Qnil;
621
+ rb_ary_store(nl, i, it);
622
+ }
623
+ return nl;
624
+ }
625
+
626
+ for (i=0; i<dims[pos]; i++) {
627
+ if (!(it = ltranspose(list, dims, strides, pos+1, shift, len)))
628
+ return Qnil;
629
+ rb_ary_store(nl, i, it);
630
+ shift += strides[pos];
631
+ }
632
+
633
+ return nl;
634
+ }
635
+
636
+ /* Convert a R Array to a Ruby Array (in the form of
637
+ * array of arrays of ...) */
638
+ static VALUE to_ruby_array(VALUE obj, int *dims, int l)
639
+ {
640
+ VALUE list;
641
+ int i, c, *strides;
642
+
643
+ strides = (int *)ALLOC_N(int,l);
644
+ if (!strides)
645
+ rb_raise(rb_eRuntimeError,"Could not allocate memory for array\n");
646
+
647
+ c = 1;
648
+ for (i=0; i<l; i++) {
649
+ strides[i] = c;
650
+ c *= dims[i];
651
+ }
652
+
653
+ list = ltranspose(obj, dims, strides, 0, 0, l);
654
+ free(strides);
655
+
656
+ return list;
657
+ }