R4rb 1.0.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,7 @@
1
+ ---
2
+ SHA1:
3
+ metadata.gz: 1813c260a2bb6b3c20ddb178ab5b8ac5ff840c5e
4
+ data.tar.gz: 34c1e19b403d81d8cc8bb697c60b7a7263b3bdc0
5
+ SHA512:
6
+ metadata.gz: 799cfb1b41abe6d6dde3bac3e92eacd646b0be432c13b1d316780d6bfd9c803c6901b5cd3e0a69d7e90506ef7b6c7e2397f5324800641c84605add57019c38e9
7
+ data.tar.gz: ba654f94c2c4eb24b74054a52becbbf0d07c45db005522cb5f8891d39c91d862c7efc1abbc6cda6e0bc2e6c102d1897635eebffe6e8224ee4320366b2448913f
@@ -0,0 +1,32 @@
1
+ require 'rubygems'
2
+ require 'rubygems/package_task'
3
+
4
+ pkg_NAME='R4rb'
5
+ pkg_VERSION='1.0.0'
6
+ pkg_FILES=FileList[
7
+ 'Rakefile','R4rb.gemspec',
8
+ 'ext/R4rb/*.c',
9
+ 'ext/R4rb/extconf.rb',
10
+ 'ext/R4rb/MANIFEST',
11
+ 'lib/**/*.rb',
12
+ 'test/**/*.rb',
13
+ 'script/**/*'
14
+ ]
15
+
16
+ spec = Gem::Specification.new do |s|
17
+ s.platform = Gem::Platform::RUBY
18
+ s.summary = "R for ruby"
19
+ s.name = pkg_NAME
20
+ s.version = pkg_VERSION
21
+ s.requirements << 'none'
22
+ s.require_paths = ["lib","ext/R4rb"]
23
+ s.files = pkg_FILES.to_a
24
+ s.extensions = ["ext/R4rb/extconf.rb"]
25
+ s.description = <<-EOF
26
+ R is embedded in ruby with some communication support .
27
+ EOF
28
+ s.author = "CQLS"
29
+ s.email= "rdrouilh@gmail.com"
30
+ s.homepage = "http://cqls.upmf-grenoble.fr"
31
+ s.rubyforge_project = nil
32
+ end
@@ -0,0 +1,114 @@
1
+ require 'rubygems'
2
+ require 'rake'
3
+ require 'rubygems/package_task'
4
+
5
+ PKG_NAME='R4rb'
6
+ PKG_VERSION='1.0.0'
7
+ PKG_FILES=FileList[
8
+ 'Rakefile','R4rb.gemspec',
9
+ 'ext/R4rb/*.c',
10
+ 'ext/R4rb/extconf.rb',
11
+ 'ext/R4rb/MANIFEST',
12
+ 'lib/**/*.rb',
13
+ 'test/**/*.rb',
14
+ 'script/**/*'
15
+ ]
16
+
17
+ spec = Gem::Specification.new do |s|
18
+ s.platform = Gem::Platform::RUBY
19
+ s.summary = "R for ruby"
20
+ s.name = PKG_NAME
21
+ s.version = PKG_VERSION
22
+ s.requirements << 'none'
23
+ s.require_paths = ["lib","ext/R4rb"]
24
+ s.files = PKG_FILES.to_a
25
+ s.extensions = ["ext/R4rb/extconf.rb"]
26
+ s.description = <<-EOF
27
+ R is embedded in ruby with some communication support .
28
+ EOF
29
+ s.author = "CQLS"
30
+ s.email= "rdrouilh@gmail.com"
31
+ s.homepage = "http://cqls.upmf-grenoble.fr"
32
+ s.rubyforge_project = nil
33
+ end
34
+
35
+ ## this allows to produce some parameter for task like Gem::PackageTask (without additional argument!)
36
+ opt={};ARGV.select{|e| e=~/\=/ }.each{|e| tmp= e.split("=");opt[tmp[0]]=tmp[1]}
37
+
38
+ ## rake ... pkgdir=<path to provide> to update PKGDIR
39
+ PKGDIR=opt["pkgdir"] || ENV["RUBYGEMS_PKGDIR"] || "pkg"
40
+ PKGDIR=opt["pkgdir"] if opt["pkgdir"]
41
+
42
+ ## OLD: gem task!!!
43
+ # desc "Create #{PKG_NAME+'-'+PKG_VERSION+'.gem'}"
44
+ # Gem::PackageTask.new(spec) do |pkg|
45
+ # pkg.package_dir=PKGDIR
46
+ # pkg.need_zip = false
47
+ # pkg.need_tar = false
48
+ # end
49
+
50
+
51
+ # it is less verbose than the previous one
52
+ desc "Create #{PKG_NAME+'-'+PKG_VERSION+'.gem'}"
53
+ task :package do |t|
54
+ #Gem::Builder.new(spec_client).build
55
+ unless File.directory? PKGDIR
56
+ require 'fileutils'
57
+ FileUtils.mkdir_p PKGDIR
58
+ end
59
+ Gem::Package.build(spec)
60
+ `mv #{PKG_NAME+'-'+PKG_VERSION+'.gem'} #{PKGDIR}`
61
+ end
62
+
63
+ ## clean task
64
+ desc "Remove #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')}"
65
+ task :clean do |t|
66
+ rm File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem') if File.exists? File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')
67
+ rm_rf File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION) if File.exists? File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION)
68
+ end
69
+
70
+
71
+ ## install task with doc
72
+ desc "Install #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')}"
73
+ task :install_with_doc do |t|
74
+ `gem install #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')} --local`
75
+ end
76
+
77
+ ## quick install task
78
+ desc "Quick install #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')}"
79
+ task :install => :package do |t|
80
+ `gem install #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')} --local --no-rdoc --no-ri --user-install`
81
+ rm_rf File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION) if File.exists? File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION)
82
+ end
83
+
84
+ desc "Docker install #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')}"
85
+ task :docker => :package do |t|
86
+ `gem install #{File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION+'.gem')} --local --no-rdoc --no-ri`
87
+ rm_rf File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION) if File.exists? File.join(PKGDIR,PKG_NAME+'-'+PKG_VERSION)
88
+ end
89
+
90
+
91
+ ## binary task (mainly for Windows binary)
92
+ spec_bin=Gem::Specification.new do |s|
93
+ s.platform = Gem::Platform::CURRENT
94
+ s.summary = "R for ruby"
95
+ s.name = PKG_NAME
96
+ s.version = PKG_VERSION
97
+ s.requirements << 'none'
98
+ s.require_paths = ["lib"]
99
+ s.files = Dir['lib/**/*.rb'] + Dir['lib/*.so']
100
+ s.required_ruby_version = '>= 1.8.0'
101
+ s.description = <<-EOF
102
+ R is embedded in ruby with some communication support .
103
+ EOF
104
+ s.author = "CQLS"
105
+ s.email= "rdrouilh@gmail.com"
106
+ s.homepage = "http://cqls.upmf-grenoble.fr"
107
+ s.rubyforge_project = nil
108
+ s.has_rdoc = false
109
+ end
110
+
111
+ task :gem_bin do |t|
112
+ `cp ext/R4rb/*.so lib`
113
+ Gem::Builder.new(spec_bin).build
114
+ end
File without changes
@@ -0,0 +1,595 @@
1
+ /**********************************************************************
2
+
3
+ R4rb.c
4
+
5
+ **********************************************************************/
6
+ #include <stdio.h>
7
+ #include <string.h>
8
+
9
+ #include "ruby.h"
10
+ #include <R.h>
11
+ #include <Rinternals.h>
12
+ #include <Rdefines.h>
13
+ #include <Rversion.h>
14
+
15
+
16
+ /* From Parse.h -- must find better solution: */
17
+ #define PARSE_NULL 0
18
+ #define PARSE_OK 1
19
+ #define PARSE_INCOMPLETE 2
20
+ #define PARSE_ERROR 3
21
+ #define PARSE_EOF 4
22
+
23
+
24
+ #define Need_Integer(x) (x) = rb_Integer(x)
25
+ #define Need_Float(x) (x) = rb_Float(x)
26
+ #define Need_Float2(x,y) {\
27
+ Need_Float(x);\
28
+ Need_Float(y);\
29
+ }
30
+ #define Need_Float3(x,y,z) {\
31
+ Need_Float(x);\
32
+ Need_Float(y);\
33
+ Need_Float(z);\
34
+ }
35
+
36
+ #if (R_VERSION < 132352) /* before 2.5 to check!*/
37
+ SEXP R_ParseVector(SEXP, int, int *);
38
+ #define RR_ParseVector(x,y,z) R_ParseVector(x, y, z)
39
+ #else
40
+ SEXP R_ParseVector(SEXP, int, int *,SEXP);
41
+ #define RR_ParseVector(x,y,z) R_ParseVector(x, y, z, R_NilValue)
42
+ #endif
43
+
44
+ /************* INIT *********************/
45
+
46
+ extern Rboolean R_Interactive;
47
+ extern int Rf_initEmbeddedR(int argc, char *argv[]);
48
+
49
+ VALUE R2rb_init(VALUE obj, VALUE args)
50
+ {
51
+ char **argv;//={"REmbed","--save","--slave","--quiet"};
52
+ int i,argc;//=sizeof(argv)/sizeof(argv[0]);
53
+ VALUE tmp;
54
+
55
+ argc=RARRAY_LEN(args) + 1;
56
+ //printf("argc=%d\n",argc);
57
+ argv=malloc(sizeof(char*)*argc);
58
+ argv[0]="REmbed";
59
+ for (i = 1 ; i < argc ; i++) {
60
+ tmp=rb_ary_entry(args,i-1);
61
+ argv[i]=StringValuePtr(tmp);
62
+ //printf("argv[%d]=%s\n",i,argv[i]);
63
+ }
64
+ //printf("argc=%d\n",argc);
65
+ Rf_initEmbeddedR(argc,argv);
66
+ R_Interactive = FALSE;
67
+ return Qtrue;
68
+ }
69
+
70
+ /***************** EVAL **********************/
71
+
72
+ VALUE R2rb_eval(VALUE obj, VALUE cmd, VALUE print)
73
+ {
74
+ char *cmdString;
75
+ int nbCmds;
76
+ VALUE tmp;
77
+ int errorOccurred,status, i;
78
+
79
+ SEXP text, expr, ans=R_NilValue /* -Wall */;
80
+
81
+
82
+ //printf("Avant parsing\n");
83
+
84
+ nbCmds=RARRAY_LEN(cmd);
85
+
86
+ //printf("nbCmds : %d\n",nbCmds);
87
+
88
+ text = PROTECT(allocVector(STRSXP, nbCmds));
89
+ for (i = 0 ; i < nbCmds ; i++) {
90
+ tmp=rb_ary_entry(cmd,i);
91
+ cmdString=StringValuePtr(tmp);
92
+ SET_STRING_ELT(text, i, mkChar(cmdString));
93
+ }
94
+ expr = PROTECT(RR_ParseVector(text, -1, &status));
95
+
96
+ if (status != PARSE_OK) {
97
+ //printf("Parsing error (status=%d) in:\n",status);
98
+ for (i = 0 ; i < nbCmds ; i++) {
99
+ tmp=rb_ary_entry(cmd,i);
100
+ cmdString=StringValuePtr(tmp);
101
+ //printf("%s\n",cmdString);
102
+ }
103
+ UNPROTECT(2);
104
+ return Qfalse;
105
+ }
106
+
107
+ /* Note that expr becomes an EXPRSXP and hence we need the loop
108
+ below (a straight eval(expr, R_GlobalEnv) won't work) */
109
+ {
110
+ for(i = 0 ; i < nbCmds ; i++)
111
+ ans = R_tryEval(VECTOR_ELT(expr, i),NULL, &errorOccurred);
112
+ if(errorOccurred) {
113
+ //fprintf(stderr, "Caught another error calling sqrt()\n");
114
+ fflush(stderr);
115
+ UNPROTECT(2);
116
+ return Qfalse;
117
+ }
118
+
119
+ if (print != Qnil) {
120
+ Rf_PrintValue(ans);
121
+ }
122
+ }
123
+
124
+ UNPROTECT(2);
125
+ return Qtrue;
126
+ }
127
+
128
+ /***************** PARSE **********************/
129
+
130
+ VALUE R2rb_parse(VALUE obj, VALUE cmd,VALUE print)
131
+ {
132
+ char *cmdString;
133
+ int nbCmds;
134
+ VALUE tmp;
135
+ int status,i;
136
+
137
+ SEXP text, expr, ans=R_NilValue /* -Wall */;
138
+
139
+
140
+ //printf("Avant parsing\n");
141
+
142
+ nbCmds=RARRAY_LEN(cmd);
143
+
144
+ //printf("nbCmds : %d\n",nbCmds);
145
+
146
+ text = PROTECT(allocVector(STRSXP, nbCmds));
147
+ for (i = 0 ; i < nbCmds ; i++) {
148
+ tmp=rb_ary_entry(cmd,i);
149
+ cmdString=StringValuePtr(tmp);
150
+ SET_STRING_ELT(text, i, mkChar(cmdString));
151
+ }
152
+ expr = PROTECT(RR_ParseVector(text, -1, &status));
153
+
154
+ if (status != PARSE_OK) {
155
+ if (print != Qnil) printf("Parsing error (status=%d) in:\n",status);
156
+ for (i = 0 ; i < nbCmds ; i++) {
157
+ tmp=rb_ary_entry(cmd,i);
158
+ cmdString=StringValuePtr(tmp);
159
+ if (print != Qnil) printf("%s\n",cmdString);
160
+ }
161
+ //UNPROTECT(2);
162
+ //return Qfalse;
163
+ }
164
+ UNPROTECT(2);
165
+ //return Qtrue;
166
+ return INT2FIX(status);
167
+ }
168
+
169
+
170
+ /*****************************************
171
+
172
+ Interface to get values of RObj from Ruby
173
+ The basic idea : no copy of the R Vector
174
+ just methods to extract value !!!
175
+
176
+ ******************************************/
177
+
178
+ // used internally !!! -> eval only one string line
179
+ SEXP util_eval1string(VALUE cmd)
180
+ {
181
+ char *cmdString;
182
+ int errorOccurred,status, i;
183
+
184
+ SEXP text, expr, ans=R_NilValue /* -Wall */;
185
+
186
+ text = PROTECT(allocVector(STRSXP, 1));
187
+ cmdString=StringValuePtr(cmd);
188
+ //printf("cmd: %s\n",cmdString);
189
+ SET_STRING_ELT(text, 0, mkChar(cmdString));
190
+ expr = PROTECT(RR_ParseVector(text, -1, &status));
191
+ if (status != PARSE_OK) {
192
+ printf("Parsing error in: %s\n",cmdString);
193
+ UNPROTECT(2);
194
+ return R_NilValue;
195
+ }
196
+ /* Note that expr becomes an EXPRSXP and hence we need the loop
197
+ below (a straight eval(expr, R_GlobalEnv) won't work) */
198
+ ans = R_tryEval(VECTOR_ELT(expr, 0),R_GlobalEnv,&errorOccurred);
199
+ //ans = eval(VECTOR_ELT(expr, 0),R_GlobalEnv);
200
+ if(errorOccurred) {
201
+ //fflush(stderr);
202
+ printf("Exec error in: %s\n",cmdString);
203
+ UNPROTECT(2);
204
+ return R_NilValue;
205
+ }
206
+ UNPROTECT(2);
207
+ return ans;
208
+ }
209
+
210
+ int util_isVector(SEXP ans)
211
+ {
212
+ return (!isNewList(ans) & isVector(ans));
213
+ }
214
+
215
+ int util_isVariable(VALUE self)
216
+ {
217
+ VALUE tmp;
218
+ tmp=rb_iv_get(self,"@type");
219
+ return strcmp(StringValuePtr(tmp),"var")==0;
220
+ }
221
+
222
+ SEXP util_getVar(VALUE self)
223
+ {
224
+ SEXP ans;
225
+ char *name;
226
+ VALUE tmp;
227
+
228
+ tmp=rb_iv_get(self,"@name");
229
+ name=StringValuePtr(tmp);
230
+ if(util_isVariable(self)) {
231
+ ans = findVar(install(name),R_GlobalEnv); //currently in R_GlobalEnv!!!
232
+ } else {
233
+ //printf("getVar:%s\n",name);
234
+ ans=util_eval1string(rb_iv_get(self,"@name"));
235
+ if(ans==R_NilValue) return ans;
236
+ }
237
+ if(!util_isVector(ans)) return R_NilValue;
238
+ return ans;
239
+ }
240
+
241
+ //with argument!! necessarily an expression and not a variable
242
+ SEXP util_getExpr_with_arg(VALUE self)
243
+ {
244
+ SEXP ans;
245
+ VALUE tmp;
246
+
247
+ //printf("getVar:%s\n",name);
248
+ tmp=rb_str_dup(rb_iv_get(self,"@arg"));
249
+ ans=util_eval1string(rb_str_cat2(rb_str_dup(rb_iv_get(self,"@name")),StringValuePtr(tmp)));
250
+ if(ans==R_NilValue) return ans;
251
+ if(!util_isVector(ans)) return R_NilValue;
252
+ return ans;
253
+ }
254
+
255
+
256
+ VALUE util_SEXP2VALUE(SEXP ans)
257
+ {
258
+ VALUE res;
259
+ int n,i;
260
+ Rcomplex cpl;
261
+ VALUE res2;
262
+
263
+ n=length(ans);
264
+ res = rb_ary_new2(n);
265
+ switch(TYPEOF(ans)) {
266
+ case REALSXP:
267
+ for(i=0;i<n;i++) {
268
+ rb_ary_store(res,i,rb_float_new(REAL(ans)[i]));
269
+ }
270
+ break;
271
+ case INTSXP:
272
+ for(i=0;i<n;i++) {
273
+ rb_ary_store(res,i,INT2FIX(INTEGER(ans)[i]));
274
+ }
275
+ break;
276
+ case LGLSXP:
277
+ for(i=0;i<n;i++) {
278
+ rb_ary_store(res,i,(INTEGER(ans)[i] ? Qtrue : Qfalse));
279
+ }
280
+ break;
281
+ case STRSXP:
282
+ for(i=0;i<n;i++) {
283
+ rb_ary_store(res,i,rb_str_new2(CHAR(STRING_ELT(ans,i))));
284
+ }
285
+ break;
286
+ case CPLXSXP:
287
+ rb_require("complex");
288
+ for(i=0;i<n;i++) {
289
+ cpl=COMPLEX(ans)[i];
290
+ res2 = rb_eval_string("Complex.new(0,0)");
291
+ rb_iv_set(res2,"@real",rb_float_new(cpl.r));
292
+ rb_iv_set(res2,"@image",rb_float_new(cpl.i));
293
+ rb_ary_store(res,i,res2);
294
+ }
295
+ break;
296
+ }
297
+
298
+ return res;
299
+ }
300
+
301
+
302
+ SEXP util_VALUE2SEXP(VALUE arr)
303
+ {
304
+ SEXP ans;
305
+ VALUE res,class,tmp;
306
+ int i,n=0;
307
+
308
+ if(!rb_obj_is_kind_of(arr,rb_cArray)) {
309
+ n=1;
310
+ res = rb_ary_new2(1);
311
+ rb_ary_push(res,arr);
312
+ arr=res;
313
+ } else {
314
+ n=RARRAY_LEN(arr);
315
+ }
316
+
317
+ class=rb_class_of(rb_ary_entry(arr,0));
318
+
319
+ if(class==rb_cFloat) {
320
+ PROTECT(ans=allocVector(REALSXP,n));
321
+ for(i=0;i<n;i++) {
322
+ REAL(ans)[i]=NUM2DBL(rb_ary_entry(arr,i));
323
+ }
324
+ } else if(class==rb_cFixnum || class==rb_cBignum) {
325
+ PROTECT(ans=allocVector(INTSXP,n));
326
+ for(i=0;i<n;i++) {
327
+ INTEGER(ans)[i]=NUM2INT(rb_ary_entry(arr,i));
328
+ }
329
+ } else if(class==rb_cTrueClass || class==rb_cFalseClass) {
330
+ PROTECT(ans=allocVector(LGLSXP,n));
331
+ for(i=0;i<n;i++) {
332
+ LOGICAL(ans)[i]=(rb_class_of(rb_ary_entry(arr,i))==rb_cFalseClass ? FALSE : TRUE);
333
+ }
334
+ } else if(class==rb_cString) {
335
+ PROTECT(ans=allocVector(STRSXP,n));
336
+ for(i=0;i<n;i++) {
337
+ tmp=rb_ary_entry(arr,i);
338
+ SET_STRING_ELT(ans,i,mkChar(StringValuePtr(tmp)));
339
+ }
340
+ } else ans=R_NilValue;
341
+
342
+ if(n>0) UNPROTECT(1);
343
+ return ans;
344
+ }
345
+
346
+
347
+
348
+ VALUE RVect_initialize(VALUE self, VALUE name)
349
+ {
350
+ rb_iv_set(self,"@name",name);
351
+ rb_iv_set(self,"@type",rb_str_new2("var"));
352
+ rb_iv_set(self,"@arg",rb_str_new2(""));
353
+ return self;
354
+ }
355
+
356
+ VALUE RVect_isValid(VALUE self)
357
+ {
358
+ SEXP ans;
359
+ char *name;
360
+
361
+ #ifdef cqls
362
+ VALUE tmp;
363
+ tmp=rb_iv_get(self,"@name");
364
+ name = StringValuePtr(tmp);
365
+ ans = findVar(install(name),R_GlobalEnv); //currently in R_GlobalEnv!!!
366
+ #else
367
+ ans = util_getVar(self);
368
+ #endif
369
+ if(!util_isVector(ans)) {
370
+ #ifndef cqls
371
+ VALUE tmp;
372
+ tmp=rb_iv_get(self,"@name");
373
+ name = StringValuePtr(tmp);
374
+ #endif
375
+ rb_warn("%s is not a R vector !!!",name); //TODO name not defined
376
+ return Qfalse;
377
+ }
378
+ return Qtrue;
379
+ }
380
+
381
+ VALUE RVect_length(VALUE self)
382
+ {
383
+ SEXP ans;
384
+ char *name;
385
+ #ifdef cqls
386
+ VALUE tmp;
387
+ tmp=rb_iv_get(self,"@name");
388
+ if(!RVect_isValid(self)) return Qnil;
389
+ name = StringValuePtr(tmp);
390
+ ans = findVar(install(name),R_GlobalEnv); //currently in R_GlobalEnv!!!
391
+ #else
392
+ ans = util_getVar(self);
393
+
394
+ if(ans==R_NilValue) {
395
+ //printf("Sortie de length avec nil\n");
396
+ return Qnil;
397
+ }
398
+ #endif
399
+ return INT2NUM(length(ans));
400
+ }
401
+
402
+ VALUE RVect_get(VALUE self)
403
+ {
404
+ SEXP ans;
405
+ VALUE res;
406
+ char *name;
407
+ int n,i;
408
+ Rcomplex cpl;
409
+ VALUE res2;
410
+
411
+ //#define cqls
412
+ #ifdef cqls
413
+ VALUE tmp;
414
+ if(!RVect_isValid(self)) return Qnil;
415
+ #else
416
+ ans = util_getVar(self);
417
+
418
+ if(ans==R_NilValue) {
419
+ //printf("Sortie de get avec nil\n");
420
+ return Qnil;
421
+ }
422
+ #endif
423
+ #ifdef cqls
424
+ tmp=rb_iv_get(self,"@name");
425
+ name = StringValuePtr(tmp);
426
+ ans = findVar(install(name),R_GlobalEnv);
427
+ #endif
428
+
429
+ res=util_SEXP2VALUE(ans);
430
+ if(length(ans)==1) res=rb_ary_entry(res,0);
431
+ return res;
432
+ }
433
+
434
+ VALUE RVect_get_with_arg(VALUE self)
435
+ {
436
+ SEXP ans;
437
+ VALUE res;
438
+ char *name;
439
+ int n,i;
440
+ Rcomplex cpl;
441
+ VALUE res2;
442
+
443
+ ans = util_getExpr_with_arg(self);
444
+
445
+ if(ans==R_NilValue) {
446
+ //printf("Sortie de get avec nil\n");
447
+ return Qnil;
448
+ }
449
+ res=util_SEXP2VALUE(ans);
450
+
451
+ //printf("RVect_get_with_arg: length(ans)=%d\n",length(ans));
452
+ if (length(ans)==1) res=rb_ary_entry(res,0);
453
+
454
+ return res;
455
+ }
456
+
457
+
458
+
459
+ // faster than self.to_a[index]
460
+ VALUE RVect_aref(VALUE self, VALUE index)
461
+ {
462
+ SEXP ans;
463
+ VALUE res;
464
+ char *name;
465
+ int n,i;
466
+ Rcomplex cpl;
467
+ #ifdef cqls
468
+ VALUE tmp;
469
+ #endif
470
+ i = FIX2INT(index);
471
+
472
+ #ifdef cqls
473
+ if(!RVect_isValid(self)) return Qnil;
474
+ tmp=rb_iv_get(self,"@name");
475
+ name = StringValuePtr(tmp);
476
+ ans = findVar(install(name),R_GlobalEnv); //currently in R_GlobalEnv!!!
477
+ #else
478
+ ans = util_getVar(self);
479
+ #endif
480
+ n=length(ans);
481
+ //printf("i=%d and n=%d\n",i,n);
482
+ if(i<n) {
483
+ switch(TYPEOF(ans)) {
484
+ case REALSXP:
485
+ res=rb_float_new(REAL(ans)[i]);
486
+ break;
487
+ case INTSXP:
488
+ res=INT2FIX(INTEGER(ans)[i]);
489
+ break;
490
+ case LGLSXP:
491
+ res=(INTEGER(ans)[i] ? Qtrue : Qfalse);
492
+ break;
493
+ case STRSXP:
494
+ res=rb_str_new2(CHAR(STRING_ELT(ans,i)));
495
+ break;
496
+ case CPLXSXP:
497
+ rb_require("complex");
498
+ cpl=COMPLEX(ans)[i];
499
+ res = rb_eval_string("Complex.new(0,0)");
500
+ rb_iv_set(res,"@real",rb_float_new(cpl.r));
501
+ rb_iv_set(res,"@image",rb_float_new(cpl.i));
502
+ break;
503
+ }
504
+ } else {
505
+ res = Qnil;
506
+ }
507
+ return res;
508
+ }
509
+
510
+ VALUE RVect_set(VALUE self,VALUE arr)
511
+ {
512
+ SEXP ans;
513
+ char *name;
514
+ VALUE tmp;
515
+
516
+ ans=util_VALUE2SEXP(arr);
517
+
518
+ tmp=rb_iv_get(self,"@name");
519
+ name = StringValuePtr(tmp);
520
+ if(util_isVariable(self)) {
521
+ defineVar(install(name),ans,R_GlobalEnv); //currently in R_GlobalEnv!!!
522
+ } else {
523
+ defineVar(install(".rubyExport"),ans,R_GlobalEnv);
524
+ util_eval1string(rb_str_cat2(rb_str_dup(rb_iv_get(self,"@name")),"<-.rubyExport"));
525
+ }
526
+
527
+ return self;
528
+ }
529
+
530
+ VALUE RVect_assign(VALUE obj, VALUE name,VALUE arr)
531
+ {
532
+ SEXP ans;
533
+ char *tmp;
534
+
535
+ ans=util_VALUE2SEXP(arr);
536
+
537
+ tmp = StringValuePtr(name);
538
+ defineVar(install(tmp),ans,R_GlobalEnv);
539
+
540
+ return Qnil;
541
+ }
542
+
543
+ VALUE RVect_set_with_arg(VALUE self,VALUE arr)
544
+ {
545
+ VALUE tmp;
546
+ defineVar(install(".rubyExport"),util_VALUE2SEXP(arr),R_GlobalEnv);
547
+ tmp=rb_iv_get(self,"@arg");
548
+ util_eval1string(rb_str_cat2(rb_str_cat2(rb_str_dup(rb_iv_get(self,"@name")),StringValuePtr(tmp)),"<-.rubyExport"));
549
+ return self;
550
+ }
551
+
552
+
553
+
554
+ void
555
+ Init_R4rb()
556
+ {
557
+ VALUE mR2rb;
558
+
559
+ mR2rb = rb_define_module("R2rb");
560
+
561
+ rb_define_module_function(mR2rb, "initR", R2rb_init, 1);
562
+
563
+ rb_define_module_function(mR2rb, "evalLines", R2rb_eval, 2);
564
+
565
+ rb_define_module_function(mR2rb, "parseLines", R2rb_parse, 2);
566
+
567
+ VALUE cRVect;
568
+
569
+ cRVect = rb_define_class_under(mR2rb,"RVector",rb_cObject);
570
+
571
+ rb_define_module_function(cRVect, "assign", RVect_assign, 2);
572
+
573
+ rb_define_method(cRVect,"initialize",RVect_initialize,1);
574
+
575
+ rb_define_method(cRVect,"get",RVect_get,0);
576
+ rb_define_alias(cRVect,"to_a","get");
577
+ rb_define_alias(cRVect,"value","get");
578
+
579
+ rb_define_method(cRVect,"set",RVect_set,1);
580
+ rb_define_alias(cRVect,"<","set");
581
+ rb_define_alias(cRVect,"value=","set");
582
+
583
+ //method "arg=" defined in eval.rb!! @arg initialized in method "initialize"
584
+ rb_define_method(cRVect,"get_with_arg",RVect_get_with_arg,0);
585
+ rb_define_alias(cRVect,"value_with_arg","get_with_arg");
586
+ rb_define_method(cRVect,"set_with_arg",RVect_set_with_arg,1);
587
+ rb_define_alias(cRVect,"value_with_arg=","set_with_arg");
588
+
589
+ rb_define_method(cRVect,"valid?",RVect_isValid,0);
590
+ rb_define_method(cRVect,"length",RVect_length,0);
591
+ rb_define_method(cRVect,"[]",RVect_aref,1);
592
+ //[]= iter !!!
593
+ rb_define_attr(cRVect,"name",1,1);
594
+ rb_define_attr(cRVect,"type",1,1);
595
+ }