R4rb 1.0.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +7 -0
- data/R4rb.gemspec +32 -0
- data/Rakefile +114 -0
- data/ext/R4rb/MANIFEST +0 -0
- data/ext/R4rb/R4rb.c +595 -0
- data/ext/R4rb/extconf.rb +133 -0
- data/lib/R2rb.rb +5 -0
- data/lib/R4rb.rb +59 -0
- data/lib/R4rb/R2rb_eval.rb +116 -0
- data/lib/R4rb/R2rb_init.rb +109 -0
- data/lib/R4rb/R4rb.rb +164 -0
- data/lib/R4rb/Rserve.rb +208 -0
- data/lib/R4rb/converter.rb +69 -0
- data/lib/R4rb/init.rb +127 -0
- data/lib/R4rb/robj.rb +46 -0
- data/lib/Rserve.rb +8 -0
- data/script/README +5 -0
- data/script/Rserv +39 -0
- data/script/install_Rserv +8 -0
- data/test/R4rbRserve.rb +30 -0
- data/test/compR4rbRserve.rb +2 -0
- data/test/test.rb +89 -0
- data/test/testArray.rb +27 -0
- data/test/testBuffer.rb +12 -0
- data/test/testConsole.rb +5 -0
- data/test/testR4rb.rb +42 -0
- data/test/testRVect.rb +18 -0
- data/test/testRserve.rb +90 -0
- data/test/test_error.rb +32 -0
- metadata +74 -0
checksums.yaml
ADDED
@@ -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
|
data/R4rb.gemspec
ADDED
@@ -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
|
data/Rakefile
ADDED
@@ -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
|
data/ext/R4rb/MANIFEST
ADDED
File without changes
|
data/ext/R4rb/R4rb.c
ADDED
@@ -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
|
+
}
|