R4rb 1.0.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -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
+ }