narray-nmatrix 0.6.1.0.pre

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,416 @@
1
+ /*
2
+ na_random.c
3
+ Numerical Array Extention for Ruby
4
+ (C) Copyright 2003-2008 by Masahiro TANAKA
5
+
6
+ This program is free software.
7
+ You can distribute/modify this program
8
+ under the same terms as Ruby itself.
9
+ NO WARRANTY.
10
+ */
11
+
12
+ /*
13
+ This is based on trimmed version of MT19937. To get the original version,
14
+ contact <http://www.math.keio.ac.jp/~matumoto/emt.html>.
15
+
16
+ The original copyright notice follows.
17
+
18
+ A C-program for MT19937, with initialization improved 2002/2/10.
19
+ Coded by Takuji Nishimura and Makoto Matsumoto.
20
+ This is a faster version by taking Shawn Cokus's optimization,
21
+ Matthe Bellew's simplification, Isaku Wada's real version.
22
+
23
+ Before using, initialize the state by using init_genrand(seed)
24
+ or init_by_array(init_key, key_length).
25
+
26
+ Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
27
+ All rights reserved.
28
+
29
+ Redistribution and use in source and binary forms, with or without
30
+ modification, are permitted provided that the following conditions
31
+ are met:
32
+
33
+ 1. Redistributions of source code must retain the above copyright
34
+ notice, this list of conditions and the following disclaimer.
35
+
36
+ 2. Redistributions in binary form must reproduce the above copyright
37
+ notice, this list of conditions and the following disclaimer in the
38
+ documentation and/or other materials provided with the distribution.
39
+
40
+ 3. The names of its contributors may not be used to endorse or promote
41
+ products derived from this software without specific prior written
42
+ permission.
43
+
44
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
45
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
46
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
47
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
48
+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
49
+ EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
50
+ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
51
+ PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
52
+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
53
+ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
54
+ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
55
+
56
+
57
+ Any feedback is very welcome.
58
+ http://www.math.keio.ac.jp/matumoto/emt.html
59
+ email: matumoto@math.keio.ac.jp
60
+ */
61
+ #include "ruby.h"
62
+ #include "narray.h"
63
+ #include "narray_local.h"
64
+
65
+ /* Period parameters */
66
+ #define N 624
67
+ #define M 397
68
+ #define MATRIX_A 0x9908b0dfUL /* constant vector a */
69
+ #define UMASK 0x80000000UL /* most significant w-r bits */
70
+ #define LMASK 0x7fffffffUL /* least significant r bits */
71
+ #define MIXBITS(u,v) ( ((u) & UMASK) | ((v) & LMASK) )
72
+ #define TWIST(u,v) ((MIXBITS(u,v) >> 1) ^ ((v)&1UL ? MATRIX_A : 0UL))
73
+
74
+ static u_int32_t state[N]; /* the array for the state vector */
75
+ static int left = 1;
76
+ static int initf = 0;
77
+ static u_int32_t *next;
78
+
79
+ /* initializes state[N] with a seed */
80
+ static void
81
+ init_genrand(u_int32_t s)
82
+ {
83
+ int j;
84
+ state[0]= s & 0xffffffffUL;
85
+ for (j=1; j<N; ++j) {
86
+ state[j] = (1812433253UL * (state[j-1] ^ (state[j-1] >> 30)) + j);
87
+ /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
88
+ /* In the previous versions, MSBs of the seed affect */
89
+ /* only MSBs of the array state[]. */
90
+ /* 2002/01/09 modified by Makoto Matsumoto */
91
+ state[j] &= 0xffffffffUL; /* for >32 bit machines */
92
+ }
93
+ left = 1; initf = 1;
94
+ }
95
+
96
+ static void
97
+ next_state()
98
+ {
99
+ u_int32_t *p=state;
100
+ int j;
101
+
102
+ /* if init_genrand() has not been called, */
103
+ /* a default initial seed is used */
104
+ if (initf==0) init_genrand(5489UL);
105
+
106
+ left = N;
107
+ next = state;
108
+
109
+ for (j=N-M+1; --j; ++p)
110
+ *p = p[M] ^ TWIST(p[0], p[1]);
111
+
112
+ for (j=M; --j; ++p)
113
+ *p = p[M-N] ^ TWIST(p[0], p[1]);
114
+
115
+ *p = p[M-N] ^ TWIST(p[0], state[0]);
116
+ }
117
+
118
+ #undef N
119
+ #undef M
120
+
121
+ /* These real versions are due to Isaku Wada, 2002/01/09 added */
122
+
123
+ #ifdef HAVE_UNISTD_H
124
+ #include <unistd.h>
125
+ #endif
126
+ #include <time.h>
127
+ #ifdef HAVE_SYS_TIME_H
128
+ #include <sys/time.h>
129
+ #endif
130
+
131
+ static int first = 1;
132
+
133
+ static int
134
+ rand_init(seed)
135
+ u_int32_t seed;
136
+ {
137
+ static u_int32_t saved_seed;
138
+ u_int32_t old;
139
+
140
+ first = 0;
141
+ init_genrand(seed);
142
+ old = saved_seed;
143
+ saved_seed = seed;
144
+
145
+ return old;
146
+ }
147
+
148
+ static u_int32_t
149
+ random_seed()
150
+ {
151
+ static int n = 0;
152
+ struct timeval tv;
153
+
154
+ gettimeofday(&tv, 0);
155
+ return tv.tv_sec ^ tv.tv_usec ^ getpid() ^ n++;
156
+ }
157
+
158
+ static VALUE
159
+ na_s_srand(int argc, VALUE *argv, VALUE obj)
160
+ {
161
+ VALUE sd;
162
+ u_int32_t seed, old;
163
+
164
+ rb_secure(4);
165
+ if (rb_scan_args(argc, argv, "01", &sd) == 0) {
166
+ seed = random_seed();
167
+ }
168
+ else {
169
+ seed = NUM2ULONG(sd);
170
+ }
171
+ old = rand_init(seed);
172
+
173
+ return ULONG2NUM(old);
174
+ }
175
+
176
+ /* - end of the code from ruby/random.c - */
177
+
178
+ #define genrand(y) \
179
+ { if (--left == 0) next_state();\
180
+ (y) = *next++;\
181
+ (y) ^= ((y) >> 11);\
182
+ (y) ^= ((y) << 7) & 0x9d2c5680UL;\
183
+ (y) ^= ((y) << 15) & 0xefc60000UL;\
184
+ (y) ^= ((y) >> 18); }
185
+
186
+ #define rand_double(x,y) \
187
+ (((double)((x)>>5)+(double)((y)>>6)*(1.0/67108864.0)) * (1.0/134217728.0))
188
+
189
+ #define rand_single(y) \
190
+ ((double)(y) * (1.0/4294967296.0))
191
+
192
+ static int n_bits(int32_t a)
193
+ {
194
+ int i, x, xu, xl, n=4;
195
+ int32_t m;
196
+
197
+ if (a==0) return 0;
198
+ if (a<0) a=-a;
199
+
200
+ x = 1<<n;
201
+ xu = 1<<(n+1);
202
+ xl = 0;
203
+
204
+ for (i=n; i>=0; --i) {
205
+ m = ~((1<<(x-1))-1);
206
+
207
+ if (m & a) {
208
+ xl = x;
209
+ x += 1<<(i-1);
210
+ } else {
211
+ xu = x;
212
+ x -= 1<<(i-1);
213
+ }
214
+ /* printf("%3i, [%3i, %3i], %x\n", i, xu, xl, m1); */
215
+ }
216
+ /* if (xu-xl!=1) printf("*** erorr %d - %d != 1\n", xu, xl); */
217
+ return xl;
218
+ }
219
+
220
+ // max&limit must be integer
221
+ static u_int32_t size_check(double rmax, double limit)
222
+ {
223
+ u_int32_t max;
224
+
225
+ if ( rmax == 0 ) {
226
+ return (u_int32_t)(limit-1);
227
+ }
228
+ if ( rmax < 0 ) {
229
+ rmax = -rmax;
230
+ }
231
+ max = (u_int32_t)(rmax - 1);
232
+ if ( max >= limit ) {
233
+ rb_raise(rb_eArgError, "rand-max(%.0f) must be <= %.0f", rmax, limit);
234
+ }
235
+ return max;
236
+ }
237
+
238
+ static void TpErr(void) {
239
+ rb_raise(rb_eTypeError,"illegal operation with this type");
240
+ }
241
+
242
+ static void RndB(int n, char *p1, int i1, double rmax)
243
+ {
244
+ u_int32_t y;
245
+ u_int8_t max;
246
+ int shift;
247
+
248
+ if ( rmax < 0 ) {
249
+ rb_raise(rb_eArgError, "rand-max must be positive");
250
+ }
251
+ max = size_check(rmax,0x100);
252
+ shift = 32 - n_bits(max);
253
+
254
+ if (max<1) {
255
+ for (; n; --n) {
256
+ *(u_int8_t*)p1 = 0;
257
+ p1+=i1;
258
+ }
259
+ } else {
260
+ for (; n; --n) {
261
+ do {
262
+ genrand(y);
263
+ y >>= shift;
264
+ } while (y > max);
265
+ *(u_int8_t*)p1 = (u_int8_t)y;
266
+ p1+=i1;
267
+ }
268
+ }
269
+ }
270
+
271
+ static void RndI(int n, char *p1, int i1, double rmax)
272
+ {
273
+ u_int32_t y;
274
+ u_int32_t max;
275
+ int shift, sign=1;
276
+
277
+ if ( rmax < 0 ) { rmax = -rmax; sign = -1; }
278
+ max = size_check(rmax,0x8000);
279
+ shift = 32 - n_bits(max);
280
+
281
+ if (max<1) {
282
+ for (; n; --n) {
283
+ *(int16_t*)p1 = 0;
284
+ p1+=i1;
285
+ }
286
+ } else {
287
+ for (; n; --n) {
288
+ do {
289
+ genrand(y);
290
+ y >>= shift;
291
+ } while (y > max);
292
+ *(int16_t*)p1 = (int16_t)y*sign;
293
+ p1+=i1;
294
+ }
295
+ }
296
+ }
297
+
298
+ static void RndL(int n, char *p1, int i1, double rmax)
299
+ {
300
+ u_int32_t y;
301
+ u_int32_t max;
302
+ int shift, sign=1;
303
+
304
+ if ( rmax < 0 ) { rmax = -rmax; sign = -1; }
305
+ max = size_check(rmax,0x80000000);
306
+ shift = 32 - n_bits(max);
307
+
308
+ if (max<1) {
309
+ for (; n; --n) {
310
+ *(int32_t*)p1 = 0;
311
+ p1+=i1;
312
+ }
313
+ } else {
314
+ for (; n; --n) {
315
+ do {
316
+ genrand(y);
317
+ y >>= shift;
318
+ } while (y > max);
319
+ *(int32_t*)p1 = (int32_t)y*sign;
320
+ p1+=i1;
321
+ }
322
+ }
323
+ }
324
+
325
+ static void RndF(int n, char *p1, int i1, double rmax)
326
+ {
327
+ u_int32_t y;
328
+
329
+ for (; n; --n) {
330
+ genrand(y);
331
+ *(float*)p1 = rand_single(y) * rmax;
332
+ p1+=i1;
333
+ }
334
+ }
335
+
336
+ static void RndD(int n, char *p1, int i1, double rmax)
337
+ {
338
+ u_int32_t x,y;
339
+
340
+ for (; n; --n) {
341
+ genrand(x);
342
+ genrand(y);
343
+ *(double*)p1 = rand_double(x,y) * rmax;
344
+ p1+=i1;
345
+ }
346
+ }
347
+
348
+ static void RndX(int n, char *p1, int i1, double rmax)
349
+ {
350
+ u_int32_t y;
351
+
352
+ for (; n; --n) {
353
+ genrand(y);
354
+ ((scomplex*)p1)->r = rand_single(y) * rmax;
355
+ ((scomplex*)p1)->i = 0;
356
+ p1+=i1;
357
+ }
358
+ }
359
+
360
+ static void RndC(int n, char *p1, int i1, double rmax)
361
+ {
362
+ u_int32_t x,y;
363
+
364
+ for (; n; --n) {
365
+ genrand(x);
366
+ genrand(y);
367
+ ((dcomplex*)p1)->r = rand_double(x,y) * rmax;
368
+ ((dcomplex*)p1)->i = 0;
369
+ p1+=i1;
370
+ }
371
+ }
372
+
373
+ na_func_t RndFuncs =
374
+ { TpErr, RndB, RndI, RndL, RndF, RndD, RndX, RndC, TpErr };
375
+
376
+
377
+ static VALUE
378
+ na_random_bang(int argc, VALUE *argv, VALUE self)
379
+ {
380
+ VALUE vmax;
381
+ struct NARRAY *ary;
382
+ double rmax;
383
+
384
+ rb_scan_args(argc, argv, "01", &vmax);
385
+ if (first) {
386
+ rand_init(random_seed());
387
+ }
388
+ if (NIL_P(vmax)) {
389
+ rmax = 1;
390
+ } else {
391
+ rmax = NUM2DBL(vmax);
392
+ }
393
+ if (isinf(rmax) || isnan(rmax)) {
394
+ rb_raise(rb_eArgError, "rand-max must be regular value");
395
+ }
396
+
397
+ GetNArray(self,ary);
398
+
399
+ (*RndFuncs[ary->type])( ary->total, ary->ptr, na_sizeof[ary->type], rmax );
400
+
401
+ return self;
402
+ }
403
+
404
+ static VALUE
405
+ na_random(int argc, VALUE *argv, VALUE self)
406
+ {
407
+ return na_random_bang(argc, argv, na_clone(self));
408
+ }
409
+
410
+ void
411
+ Init_na_random()
412
+ {
413
+ rb_define_singleton_method(cNArray,"srand",na_s_srand,-1);
414
+ rb_define_method(cNArray, "random!", na_random_bang,-1);
415
+ rb_define_method(cNArray, "random", na_random,-1);
416
+ }
@@ -0,0 +1,1321 @@
1
+ /*
2
+ narray.c
3
+ Numerical Array Extention for Ruby
4
+ (C) Copyright 1999-2008 by Masahiro TANAKA
5
+
6
+ This program is free software.
7
+ You can distribute/modify this program
8
+ under the same terms as Ruby itself.
9
+ NO WARRANTY.
10
+ */
11
+ #define NARRAY_C
12
+ #include <ruby.h>
13
+ #include "narray.h"
14
+ #include "narray_local.h"
15
+
16
+ /* global variables within this module */
17
+ VALUE cNArray, cNArrayScalar, cComplex;
18
+
19
+ ID na_id_beg, na_id_end, na_id_exclude_end;
20
+ ID na_id_minus, na_id_abs, na_id_power;
21
+ ID na_id_compare, na_id_ne, na_id_and, na_id_or;
22
+ ID na_id_class_dim;
23
+ ID na_id_add, na_id_sbt, na_id_mul, na_id_div, na_id_mod;
24
+ ID na_id_real, na_id_imag;
25
+ ID na_id_coerce_rev;
26
+ ID na_id_new;
27
+ ID na_id_Complex;
28
+ static ID na_id_to_i, na_id_usec, na_id_now;
29
+
30
+ const int na_sizeof[NA_NTYPES+1] = {
31
+ 0,
32
+ sizeof(u_int8_t),
33
+ sizeof(int16_t),
34
+ sizeof(int32_t),
35
+ sizeof(float),
36
+ sizeof(double),
37
+ sizeof(scomplex),
38
+ sizeof(dcomplex),
39
+ sizeof(VALUE),
40
+ 0
41
+ };
42
+
43
+ const char *na_typestring[] = {
44
+ "none",
45
+ "byte", /* 1 */
46
+ "sint", /* 2 */
47
+ "int", /* 3 */
48
+ "sfloat", /* 4 */
49
+ "float", /* 5 */
50
+ "scomplex", /* 6 */
51
+ "complex", /* 7 */
52
+ "object", /* 8 */
53
+ "ntypes" /* 9 */
54
+ };
55
+
56
+ #ifdef NARRAY_GC
57
+ static int mem_count = 0;
58
+ static int na_gc_freq = 2500000; /* Frequency of Garbage Collection */
59
+ #endif
60
+
61
+ void Init_na_array(void);
62
+ void Init_na_index(void);
63
+ void Init_nmath(void);
64
+ void Init_na_funcs(void);
65
+ void Init_na_linalg(void);
66
+ void Init_na_random(void);
67
+
68
+
69
+ #ifdef DEBUG
70
+ void na_xfree(void *ptr)
71
+ {
72
+ if (!ptr) abort();
73
+ free(ptr);
74
+ }
75
+ #endif
76
+
77
+ /* mark items */
78
+ static void
79
+ na_mark_obj(struct NARRAY *ary)
80
+ {
81
+ int i;
82
+ VALUE *ptr;
83
+
84
+ ptr = (VALUE*) ary->ptr;
85
+ for (i=ary->total; i>0; --i)
86
+ rb_gc_mark(*ptr++);
87
+ }
88
+
89
+ static void
90
+ na_mark_ref(struct NARRAY *ary)
91
+ {
92
+ struct NARRAY *a2;
93
+
94
+ rb_gc_mark( ary->ref );
95
+
96
+ GetNArray(ary->ref,a2);
97
+ if (a2->type == NA_ROBJ) na_mark_obj(a2);
98
+ }
99
+
100
+
101
+ static void
102
+ na_free(struct NARRAY* ary)
103
+ {
104
+ if ( ary->total > 0 ) {
105
+ if (ary->ref == Qnil || ary->ref == Qtrue) { /* non reference */
106
+ xfree(ary->ptr);
107
+ }
108
+ xfree(ary->shape);
109
+ #ifdef DEBUG
110
+ ary->shape = NULL;
111
+ ary->ptr = NULL;
112
+ #endif
113
+ }
114
+ xfree(ary);
115
+ }
116
+
117
+
118
+ /* allocation of NARRAY */
119
+ struct NARRAY*
120
+ na_alloc_struct(int type, int rank, int *shape)
121
+ {
122
+ int total=1, total_bak;
123
+ int i, memsz;
124
+ struct NARRAY *ary;
125
+
126
+ for (i=0; i<rank; ++i) {
127
+ if (shape[i] < 0) {
128
+ rb_raise(rb_eArgError, "negative array size");
129
+ } else if (shape[i] == 0) {
130
+ total = 0;
131
+ break;
132
+ }
133
+ total_bak = total;
134
+ total *= shape[i];
135
+ if (total < 1 || total > 2147483647 || total/shape[i] != total_bak) {
136
+ rb_raise(rb_eArgError, "array size is too large");
137
+ }
138
+ }
139
+
140
+ if (rank<=0 || total<=0) {
141
+ /* empty array */
142
+ ary = ALLOC(struct NARRAY);
143
+ ary->rank =
144
+ ary->total = 0;
145
+ ary->shape = NULL;
146
+ ary->ptr = NULL;
147
+ ary->type = type;
148
+ }
149
+ else {
150
+ memsz = na_sizeof[type] * total;
151
+
152
+ if (memsz < 1 || memsz > 2147483647 || memsz/na_sizeof[type] != total) {
153
+ rb_raise(rb_eArgError, "allocation size is too large");
154
+ }
155
+
156
+ /* Garbage Collection */
157
+ #ifdef NARRAY_GC
158
+ mem_count += memsz;
159
+ if ( mem_count > na_gc_freq ) { rb_gc(); mem_count=0; }
160
+ #endif
161
+
162
+ ary = ALLOC(struct NARRAY);
163
+ ary->shape = ALLOC_N(int, rank);
164
+ ary->ptr = ALLOC_N(char, memsz);
165
+
166
+ ary->rank = rank;
167
+ ary->total = total;
168
+ ary->type = type;
169
+ for (i=0; i<rank; ++i)
170
+ ary->shape[i] = shape[i];
171
+ }
172
+ ary->ref = Qtrue;
173
+ return ary;
174
+ }
175
+
176
+ #if !defined RCLASS_SUPER
177
+ #define RCLASS_SUPER(v) (RCLASS(v)->super)
178
+ #endif
179
+
180
+ static void
181
+ na_check_class_narray(VALUE v)
182
+ {
183
+ if (TYPE(v) != T_CLASS) {
184
+ rb_raise(rb_eRuntimeError, "class required");
185
+ }
186
+
187
+ if (v == cNArray)
188
+ return;
189
+ if (RTEST(rb_funcall(v, rb_intern("<="), 1, cNArray)))
190
+ return;
191
+
192
+ rb_raise(rb_eRuntimeError, "need NArray or its subclass");
193
+ }
194
+
195
+
196
+ static VALUE
197
+ na_wrap_struct_class(struct NARRAY *ary, VALUE klass)
198
+ {
199
+ VALUE v;
200
+ int class_dim;
201
+
202
+ /* Extract element */
203
+ if (ary->rank==0 && ary->total==1) {
204
+ SetFuncs[NA_ROBJ][ary->type](1,&v,0,ary->ptr,0);
205
+ na_free(ary);
206
+ return v;
207
+ }
208
+
209
+ /* check NArray >= klass */
210
+ na_check_class_narray(klass);
211
+
212
+ /* Check dimension */
213
+ class_dim = NUM2INT(rb_const_get(klass, na_id_class_dim));
214
+ if (ary->rank < class_dim)
215
+ rb_raise(rb_eTypeError, "array.dim(=%i) < CLASS_DIMENSION(=%i)",
216
+ ary->rank, class_dim);
217
+
218
+ if (ary->ref == Qnil)
219
+ rb_raise(rb_eRuntimeError, "already wrapped object");
220
+
221
+ /* Turn on WRAPPED flag */
222
+ if (ary->ref == Qtrue) {
223
+ ary->ref = Qnil;
224
+ if (NA_IsROBJ(ary))
225
+ return Data_Wrap_Struct(klass, na_mark_obj, na_free, ary);
226
+ else
227
+ return Data_Wrap_Struct(klass, 0, na_free, ary);
228
+ }
229
+
230
+ /* reference to another NArray*/
231
+ return Data_Wrap_Struct(klass, na_mark_ref, na_free, ary);
232
+ }
233
+
234
+
235
+ static VALUE
236
+ na_wrap_struct(struct NARRAY *ary, VALUE obj)
237
+ {
238
+ return na_wrap_struct_class(ary,CLASS_OF(obj));
239
+ }
240
+
241
+
242
+ VALUE
243
+ na_make_object(int type, int rank, int *shape, VALUE klass)
244
+ {
245
+ struct NARRAY *na;
246
+
247
+ na = na_alloc_struct(type, rank, shape);
248
+
249
+ if (type==NA_ROBJ) {
250
+ rb_mem_clear((VALUE*)(na->ptr), na->total);
251
+ }
252
+ return na_wrap_struct_class(na, klass);
253
+ }
254
+
255
+
256
+ /* restriction: Integer, Float, Complex === obj */
257
+ VALUE
258
+ na_make_scalar(VALUE obj, int type)
259
+ {
260
+ static int shape=1;
261
+ VALUE v;
262
+ struct NARRAY *ary;
263
+
264
+ v = na_make_object(type,1,&shape,cNArrayScalar);
265
+ GetNArray(v,ary);
266
+ SetFuncs[ary->type][NA_ROBJ](1, ary->ptr,0, &obj,0);
267
+
268
+ return v;
269
+ }
270
+
271
+
272
+ VALUE
273
+ na_make_empty(int type, VALUE klass)
274
+ {
275
+ struct NARRAY *na;
276
+
277
+ na = na_alloc_struct(type, 0, NULL);
278
+ return na_wrap_struct_class(na, klass);
279
+ }
280
+
281
+
282
+ /* allocate reference to NArray */
283
+ struct NARRAY*
284
+ na_ref_alloc_struct(VALUE obj)
285
+ {
286
+ int i;
287
+ struct NARRAY *orig, *ary;
288
+
289
+ GetNArray(obj,orig);
290
+
291
+ if (orig->rank<=0)
292
+ rb_raise(rb_eRuntimeError, "cannot create NArrayRefer of Empty NArray");
293
+
294
+ ary = ALLOC(struct NARRAY);
295
+ ary->shape = ALLOC_N(int, orig->rank);
296
+ ary->ptr = orig->ptr;
297
+ ary->rank = orig->rank;
298
+ ary->total = orig->total;
299
+ ary->type = orig->type;
300
+ for (i=0; i<orig->rank; ++i)
301
+ ary->shape[i] = orig->shape[i];
302
+ ary->ref = obj;
303
+
304
+ return ary;
305
+ }
306
+
307
+ /* method: self.refer */
308
+ static VALUE
309
+ na_refer(VALUE self)
310
+ {
311
+ return na_wrap_struct(na_ref_alloc_struct(self), self);
312
+ }
313
+
314
+ /* singleton method: NArray.refer( other ) */
315
+ static VALUE
316
+ na_s_refer(VALUE klass, VALUE self)
317
+ {
318
+ return na_wrap_struct_class(na_ref_alloc_struct(self), klass);
319
+ }
320
+
321
+ /* method: self.original */
322
+ static VALUE
323
+ na_original(VALUE self)
324
+ {
325
+ struct NARRAY *ary;
326
+
327
+ GetNArray(self,ary);
328
+ return ary->ref;
329
+ }
330
+
331
+
332
+ void
333
+ na_clear_data(struct NARRAY *ary)
334
+ {
335
+ if (NA_IsROBJ(ary))
336
+ rb_mem_clear((VALUE*)(ary->ptr), ary->total);
337
+ else
338
+ MEMZERO(ary->ptr, char, na_sizeof[ary->type]*ary->total);
339
+ }
340
+
341
+
342
+ /* local function for new array creation */
343
+ static VALUE
344
+ na_new2(int argc, VALUE *argv, int type, VALUE klass)
345
+ {
346
+ int i, *shape;
347
+ struct NARRAY *ary;
348
+ VALUE v;
349
+
350
+ if (argc == 0)
351
+ rb_raise(rb_eArgError, "Argument required");
352
+
353
+ shape = ALLOCA_N(int,argc);
354
+ for (i=0; i<argc; ++i) shape[i]=NUM2INT(argv[i]);
355
+
356
+ v = na_make_object(type,argc,shape,klass);
357
+ GetNArray(v,ary);
358
+
359
+ if (ary->type != NA_ROBJ)
360
+ na_clear_data(ary);
361
+
362
+ /* rb_obj_call_init(v, 0, 0); */
363
+ return v;
364
+ }
365
+
366
+
367
+ /* Convert type arguments -> typecode */
368
+ int
369
+ na_get_typecode(VALUE v)
370
+ {
371
+ struct NARRAY *na;
372
+ int i;
373
+
374
+ if (v==rb_cFloat) return NA_DFLOAT;
375
+ if (v==rb_cInteger) return NA_LINT;
376
+ if (v==cComplex) return NA_DCOMPLEX;
377
+ if (v==rb_cObject) return NA_ROBJ;
378
+ if (FIXNUM_P(v)) {
379
+ i = NUM2INT(v);
380
+ if (i<=NA_NONE || i>=NA_NTYPES)
381
+ rb_raise(rb_eArgError, "Wrong type code");
382
+ return i;
383
+ }
384
+ if (NA_IsNArray(v)) {
385
+ GetNArray(v,na);
386
+ return na->type;
387
+ }
388
+ if (TYPE(v)==T_STRING) {
389
+ for (i=1; i<NA_NTYPES; ++i) {
390
+ if ( !strncmp( RSTRING_PTR(v), na_typestring[i], RSTRING_LEN(v)) )
391
+ return i;
392
+ }
393
+ }
394
+ rb_raise(rb_eArgError, "Unrecognized NArray type");
395
+ return 0;
396
+ }
397
+
398
+
399
+ /* class method: new(type, size1,size2,...,sizeN) */
400
+ static VALUE
401
+ na_s_new(int argc, VALUE *argv, VALUE klass)
402
+ {
403
+ if (argc == 0)
404
+ rb_raise(rb_eArgError, "Argument required");
405
+ return na_new2(argc-1, argv+1, na_get_typecode(argv[0]), klass);
406
+ }
407
+
408
+ /* class method: byte(size1,size2,...,sizeN) */
409
+ static VALUE
410
+ na_s_new_byte(int argc, VALUE *argv, VALUE klass)
411
+ { return na_new2(argc, argv, NA_BYTE, klass); }
412
+
413
+ /* class method: sint(size1,size2,...,sizeN) */
414
+ static VALUE
415
+ na_s_new_sint(int argc, VALUE *argv, VALUE klass)
416
+ { return na_new2(argc, argv, NA_SINT, klass); }
417
+
418
+ /* class method: int(size1,size2,...,sizeN) */
419
+ static VALUE
420
+ na_s_new_int(int argc, VALUE *argv, VALUE klass)
421
+ { return na_new2(argc, argv, NA_LINT, klass); }
422
+
423
+ /* class method: sfloat(size1,size2,...,sizeN) */
424
+ static VALUE
425
+ na_s_new_sfloat(int argc, VALUE *argv, VALUE klass)
426
+ { return na_new2(argc, argv, NA_SFLOAT, klass); }
427
+
428
+ /* class method: float(size1,size2,...,sizeN) */
429
+ static VALUE
430
+ na_s_new_float(int argc, VALUE *argv, VALUE klass)
431
+ { return na_new2(argc, argv, NA_DFLOAT, klass); }
432
+
433
+ /* class method: scomplex(size1,size2,...,sizeN) */
434
+ static VALUE
435
+ na_s_new_scomplex(int argc, VALUE *argv, VALUE klass)
436
+ { return na_new2(argc, argv, NA_SCOMPLEX, klass); }
437
+
438
+ /* class method: complex(size1,size2,...,sizeN) */
439
+ static VALUE
440
+ na_s_new_complex(int argc, VALUE *argv, VALUE klass)
441
+ { return na_new2(argc, argv, NA_DCOMPLEX, klass); }
442
+
443
+ /* class method: object(size1,size2,...,sizeN) */
444
+ static VALUE
445
+ na_s_new_object(int argc, VALUE *argv, VALUE klass)
446
+ { return na_new2(argc, argv, NA_ROBJ, klass); }
447
+
448
+
449
+
450
+ /* method: dup() */
451
+ VALUE
452
+ na_clone(VALUE self)
453
+ {
454
+ struct NARRAY *org, *cpy;
455
+
456
+ GetNArray(self,org);
457
+ cpy = na_alloc_struct(org->type,org->rank,org->shape);
458
+ memcpy(cpy->ptr, org->ptr, na_sizeof[org->type] * org->total);
459
+ return na_wrap_struct(cpy,self);
460
+ }
461
+
462
+
463
+ /* local function */
464
+ void
465
+ na_copy_nary(struct NARRAY *dst, struct NARRAY *src)
466
+ {
467
+ if (dst->total != src->total)
468
+ rb_raise(rb_eRuntimeError, "src and dst array sizes mismatch");
469
+
470
+ if (dst->type == src->type)
471
+ memcpy(dst->ptr, src->ptr, src->total*na_sizeof[src->type]);
472
+ else {
473
+ SetFuncs[dst->type][src->type]( src->total,
474
+ dst->ptr, na_sizeof[dst->type],
475
+ src->ptr, na_sizeof[src->type] );
476
+ }
477
+ }
478
+
479
+
480
+ /* method: to_type(type) */
481
+ static VALUE
482
+ na_to_type(VALUE self, VALUE vtype)
483
+ {
484
+ struct NARRAY *a1, *a2;
485
+ VALUE v;
486
+
487
+ GetNArray(self,a1);
488
+
489
+ v = na_make_object(na_get_typecode(vtype), a1->rank, a1->shape,
490
+ CLASS_OF(self));
491
+ GetNArray(v,a2);
492
+ na_copy_nary(a2,a1);
493
+ return v;
494
+ }
495
+
496
+
497
+ /* method: to_f() */
498
+ static VALUE
499
+ na_to_float(VALUE self)
500
+ {
501
+ struct NARRAY *a1, *a2;
502
+ VALUE v;
503
+
504
+ GetNArray(self,a1);
505
+
506
+ v = na_make_object(na_upcast[NA_SFLOAT][a1->type], a1->rank, a1->shape,
507
+ CLASS_OF(self));
508
+ GetNArray(v,a2);
509
+ na_copy_nary(a2,a1);
510
+ return v;
511
+ }
512
+
513
+
514
+ /* method: to_i() */
515
+ static VALUE
516
+ na_to_integer(VALUE self)
517
+ {
518
+ int type;
519
+ struct NARRAY *a1, *a2;
520
+ VALUE v;
521
+
522
+ GetNArray(self,a1);
523
+ if (!NA_IsINTEGER(a1))
524
+ type = NA_LINT;
525
+ else
526
+ type = a1->type;
527
+ v = na_make_object(type, a1->rank, a1->shape, CLASS_OF(self));
528
+ GetNArray(v,a2);
529
+ na_copy_nary(a2,a1);
530
+ return v;
531
+ }
532
+
533
+
534
+ /* method: shape() -- returns an array of shape of each rank */
535
+ static VALUE
536
+ na_shape(VALUE self)
537
+ {
538
+ struct NARRAY *ary;
539
+ VALUE *shape;
540
+ int i;
541
+
542
+ GetNArray(self,ary);
543
+ shape = ALLOCA_N(VALUE,ary->rank);
544
+ for (i = 0; i < ary->rank; ++i)
545
+ shape[i] = INT2FIX(ary->shape[i]);
546
+ return rb_ary_new4(ary->rank,shape);
547
+ }
548
+
549
+
550
+ /* method: rank() -- returns the rank of the array */
551
+ static VALUE
552
+ na_rank(VALUE self)
553
+ {
554
+ struct NARRAY *ary;
555
+ GetNArray(self,ary);
556
+ return INT2FIX(ary->rank);
557
+ }
558
+
559
+
560
+ /* method: size() -- returns the total number of elements */
561
+ static VALUE
562
+ na_size(VALUE self)
563
+ {
564
+ struct NARRAY *ary;
565
+ GetNArray(self,ary);
566
+ return INT2FIX(ary->total);
567
+ }
568
+
569
+
570
+ /* method: typecode -- returns the type of the array */
571
+ static VALUE
572
+ na_typecode(VALUE self)
573
+ {
574
+ struct NARRAY *ary;
575
+ GetNArray(self,ary);
576
+ return INT2FIX(ary->type);
577
+ }
578
+
579
+
580
+ /* method: element_size -- returns the element size of the array type */
581
+ static VALUE
582
+ na_element_size(VALUE self)
583
+ {
584
+ struct NARRAY *ary;
585
+ GetNArray(self,ary);
586
+ return INT2FIX(na_sizeof[ary->type]);
587
+ }
588
+
589
+
590
+ /* method: empty? -- returns true if empty array */
591
+ static VALUE
592
+ na_is_empty(VALUE self)
593
+ {
594
+ struct NARRAY *ary;
595
+ GetNArray(self,ary);
596
+ if (ary->total==0) return Qtrue;
597
+ return Qfalse;
598
+ }
599
+
600
+
601
+ /* Binary copy of String => NArray */
602
+ static VALUE
603
+ na_str_to_na(int argc, VALUE *argv, VALUE str)
604
+ {
605
+ struct NARRAY *ary;
606
+ VALUE v;
607
+ int i, type, len=1, str_len, *shape, rank=argc-1;
608
+
609
+ if (argc < 1)
610
+ rb_raise(rb_eArgError, "Type and Size Arguments required");
611
+
612
+ type = na_get_typecode(argv[0]);
613
+
614
+ str_len = RSTRING_LEN(str);
615
+
616
+ if (argc == 1) {
617
+ rank = 1;
618
+ shape = ALLOCA_N(int,rank);
619
+ if ( str_len % na_sizeof[type] != 0 )
620
+ rb_raise(rb_eArgError, "string size mismatch");
621
+ shape[0] = str_len / na_sizeof[type];
622
+ }
623
+ else {
624
+ shape = ALLOCA_N(int,rank);
625
+ for (i=0; i<rank; ++i)
626
+ len *= shape[i] = NUM2INT(argv[i+1]);
627
+ len *= na_sizeof[type];
628
+ if ( len != str_len )
629
+ rb_raise(rb_eArgError, "size mismatch");
630
+ }
631
+
632
+ v = na_make_object( type, rank, shape, cNArray );
633
+ GetNArray(v,ary);
634
+ memcpy( ary->ptr, RSTRING_PTR(str), ary->total*na_sizeof[type] );
635
+
636
+ return v;
637
+ }
638
+
639
+
640
+ /* method: to_s -- convert the data contents to a binary string */
641
+ static VALUE
642
+ na_to_s(VALUE self)
643
+ {
644
+ struct NARRAY *ary;
645
+ GetNArray(self,ary);
646
+ if (NA_IsROBJ(ary))
647
+ rb_raise(rb_eTypeError,"cannot convert object-type NArray");
648
+ return rb_str_new(ary->ptr,ary->total*na_sizeof[ary->type]);
649
+ }
650
+
651
+
652
+ /* method: to_binary -- convert the data contents to a BYTE type NArray */
653
+ static VALUE
654
+ na_to_binary(VALUE self)
655
+ {
656
+ struct NARRAY *a1, *a2;
657
+ int i, *shape, rank;
658
+ VALUE v;
659
+
660
+ GetNArray(self,a1);
661
+
662
+ rank = a1->rank+1;
663
+ shape = ALLOCA_N(int,rank);
664
+ shape[0] = na_sizeof[a1->type];
665
+ for (i=1; i<rank; ++i)
666
+ shape[i] = a1->shape[i-1];
667
+
668
+ v = na_make_object( NA_BYTE, rank, shape, cNArray );
669
+ GetNArray(v,a2);
670
+ MEMCPY(a2->ptr,a1->ptr,char,a2->total);
671
+
672
+ return v;
673
+ }
674
+
675
+
676
+ /* method: to_type_as_binary(type) */
677
+ static VALUE
678
+ na_to_type_as_binary(VALUE self, VALUE vtype)
679
+ {
680
+ struct NARRAY *a1, *a2;
681
+ int size, total, type;
682
+ VALUE v;
683
+
684
+ type = na_get_typecode(vtype);
685
+ GetNArray(self,a1);
686
+
687
+ size = a1->total * na_sizeof[a1->type];
688
+ if ( size % na_sizeof[type] != 0 )
689
+ rb_raise(rb_eRuntimeError, "bina1 size mismatch");
690
+ total = size / na_sizeof[type];
691
+
692
+ v = na_make_object( type, 1, &total, cNArray );
693
+ GetNArray(v,a2);
694
+ MEMCPY(a2->ptr,a1->ptr,char,size);
695
+
696
+ return v;
697
+ }
698
+
699
+
700
+ static void
701
+ na_to_string_binary(int n, char *p1, int i1, char *p2, int i2)
702
+ {
703
+ for (; n>0; --n) {
704
+ *(VALUE*)p1 = rb_str_new(p2,i2);
705
+ p1+=i1; p2+=i2;
706
+ }
707
+ }
708
+
709
+
710
+ /* method: to_string */
711
+ static VALUE
712
+ na_to_string(VALUE self)
713
+ {
714
+ VALUE v;
715
+ struct NARRAY *a1, *a2;
716
+
717
+ GetNArray(self,a1);
718
+
719
+ if (a1->total==0)
720
+ v = na_make_empty(NA_ROBJ, CLASS_OF(self));
721
+ else
722
+ if (a1->type==NA_BYTE) {
723
+ if (a1->rank==1)
724
+ return rb_str_new(a1->ptr,a1->shape[0]);
725
+ v = na_make_object(NA_ROBJ, a1->rank-1, a1->shape+1, cNArray);
726
+ GetNArray(v,a2);
727
+ na_to_string_binary( a2->total,
728
+ a2->ptr, sizeof(VALUE),
729
+ a1->ptr, a1->shape[0] );
730
+ } else {
731
+ v = na_make_object(NA_ROBJ, a1->rank, a1->shape, CLASS_OF(self));
732
+ GetNArray(v,a2);
733
+ ToStrFuncs[a1->type]( a2->total,
734
+ a2->ptr, sizeof(VALUE),
735
+ a1->ptr, na_sizeof[a1->type] );
736
+ }
737
+ return v;
738
+ }
739
+
740
+
741
+ /* singleton method:
742
+ NArray.to_na( string, type, size1,size2,...,sizeN )
743
+ NArray.to_na( array )
744
+ */
745
+ static VALUE
746
+ na_s_to_na(int argc, VALUE *argv, VALUE klass)
747
+ {
748
+ if (argc < 1) {
749
+ rb_raise(rb_eArgError, "Argument is required");
750
+ }
751
+ if (TYPE(argv[0]) == T_STRING) {
752
+ return na_str_to_na(argc-1,argv+1,argv[0]);
753
+ }
754
+ if (argc > 1) {
755
+ rb_raise(rb_eArgError, "Only one array argument must be provided");
756
+ }
757
+ if (TYPE(argv[0]) == T_ARRAY) {
758
+ return na_ary_to_nary( argv[0], klass );
759
+ }
760
+ if (NA_IsNArray(argv[0])) {
761
+ return argv[0];
762
+ }
763
+ rb_raise(rb_eTypeError, "Argument must be Array or String (or NArray)");
764
+ return Qnil;
765
+ }
766
+
767
+
768
+ /* singleton method:
769
+ NArray[object]
770
+ */
771
+ static VALUE
772
+ na_s_bracket(int argc, VALUE *argv, VALUE klass)
773
+ {
774
+ VALUE v = rb_ary_new4(argc, argv);
775
+ return na_ary_to_nary( v, klass );
776
+ }
777
+
778
+
779
+ /* method: coerce(other) */
780
+ static VALUE na_coerce(VALUE self, VALUE other)
781
+ {
782
+ struct NARRAY *a1;
783
+
784
+ GetNArray(self,a1);
785
+ return rb_assoc_new( na_cast_object(other,a1->type), self );
786
+ }
787
+
788
+
789
+ /* method: inspect() -- returns the inspect of the array */
790
+ static VALUE
791
+ na_inspect(VALUE self)
792
+ {
793
+ VALUE str;
794
+ struct NARRAY *ary;
795
+ int i;
796
+ char buf[256];
797
+ const char *classname;
798
+ const char *ref = "%s(ref).%s(%i";
799
+ const char *org = "%s.%s(%i";
800
+
801
+ GetNArray(self,ary);
802
+ classname = rb_class2name(CLASS_OF(self));
803
+
804
+ str = rb_str_new(0,0);
805
+ if (ary->rank < 1) {
806
+ sprintf(buf, "%s.%s(): []", classname, na_typestring[ary->type]);
807
+ rb_str_cat(str,buf,strlen(buf));
808
+ }
809
+ else {
810
+ sprintf(buf, (ary->ref==Qnil) ? org:ref,
811
+ classname, na_typestring[ary->type], ary->shape[0]);
812
+ rb_str_cat(str,buf,strlen(buf));
813
+ for (i=1; i<ary->rank; ++i) {
814
+ sprintf(buf,",%i",ary->shape[i]);
815
+ rb_str_cat(str,buf,strlen(buf));
816
+ }
817
+ rb_str_cat(str,")",1);
818
+ rb_str_cat(str,": \n",3);
819
+ rb_str_concat(str, na_make_inspect(self));
820
+ }
821
+ return str;
822
+ }
823
+
824
+
825
+ /* private function for reshape */
826
+ static void
827
+ na_reshape(int argc, VALUE *argv, struct NARRAY *ary, VALUE self)
828
+ {
829
+ int *shape, class_dim;
830
+ int i, total=1, unfixed=-1;
831
+ VALUE klass;
832
+
833
+ if (ary->total==0)
834
+ rb_raise(rb_eRuntimeError, "cannot reshape empty array");
835
+
836
+ klass = CLASS_OF(self);
837
+ class_dim = NUM2INT(rb_const_get(klass, na_id_class_dim));
838
+
839
+ if (argc == 0) { /* trim ranks of size=1 */
840
+ shape = ALLOCA_N(int,ary->rank+1);
841
+ for (i=0; i<class_dim; ++i) shape[i]=0;
842
+ for ( ; i<ary->rank; ++i) shape[i]=1;
843
+ na_shrink_rank( self, class_dim, shape );
844
+ if (ary->rank==0) ary->rank=1;
845
+ return;
846
+ }
847
+
848
+ /* get shape from argument */
849
+ shape = ALLOC_N(int,argc);
850
+ for (i=0; i<argc; ++i)
851
+ switch(TYPE(argv[i])) {
852
+ case T_FIXNUM:
853
+ total *= shape[i] = NUM2INT(argv[i]);
854
+ break;
855
+ case T_TRUE:
856
+ unfixed = i;
857
+ break;
858
+ default:
859
+ rb_raise(rb_eArgError,"illegal type");
860
+ }
861
+
862
+ if (unfixed>=0) {
863
+ if (ary->total % total != 0)
864
+ rb_raise(rb_eArgError, "Total size size must be divisor");
865
+ shape[unfixed] = ary->total / total;
866
+ }
867
+ else if (total != ary->total)
868
+ rb_raise(rb_eArgError, "Total size must be same");
869
+
870
+ /* exchange */
871
+ xfree(ary->shape);
872
+ ary->shape = shape;
873
+ ary->rank = argc;
874
+ }
875
+
876
+
877
+ /* method: reshape!(size1,size2,...,sizeN) */
878
+ static VALUE
879
+ na_reshape_bang(int argc, VALUE *argv, VALUE self)
880
+ {
881
+ struct NARRAY *ary;
882
+
883
+ GetNArray(self,ary);
884
+ na_reshape(argc, argv, ary, self);
885
+ return self;
886
+ }
887
+
888
+
889
+ /* method: reshape(size1,size2,...,sizeN) */
890
+ static VALUE
891
+ na_reshape_ref(int argc, VALUE *argv, VALUE self)
892
+ {
893
+ struct NARRAY *ary;
894
+
895
+ GetNArray(self,ary);
896
+ ary = na_ref_alloc_struct(self);
897
+ na_reshape(argc, argv, ary, self);
898
+ return na_wrap_struct(ary,self);
899
+ }
900
+
901
+
902
+ /* method: flatten! */
903
+ static VALUE
904
+ na_flatten_bang(VALUE self)
905
+ {
906
+ struct NARRAY *ary;
907
+
908
+ GetNArray(self,ary);
909
+ if (ary->total==0 || ary->rank==0)
910
+ rb_raise(rb_eRuntimeError, "cannot reshape empty array");
911
+ ary->shape[0] = ary->total;
912
+ ary->rank = 1;
913
+ return self;
914
+ }
915
+
916
+
917
+ /* method: flatten */
918
+ static VALUE
919
+ na_flatten_ref(VALUE self)
920
+ {
921
+ return na_flatten_bang( na_wrap_struct( na_ref_alloc_struct(self), self ));
922
+ }
923
+
924
+
925
+ /* private function for newdim */
926
+ static void
927
+ na_newdim(int argc, VALUE *argv, struct NARRAY *ary)
928
+ {
929
+ int *shape, *count;
930
+ int i, j;
931
+
932
+ if (argc==0)
933
+ rb_raise(rb_eArgError, "Argument required");
934
+ if (ary->rank + argc > NA_MAX_RANK-1)
935
+ rb_raise(rb_eArgError, "Exceed maximum ranks");
936
+ if (ary->total==0)
937
+ rb_raise(rb_eRuntimeError, "cannot extend empty array");
938
+
939
+ /* count new rank */
940
+ count = ALLOCA_N(int,ary->rank+1);
941
+ for (i=0; i<=ary->rank; ++i)
942
+ count[i]=0;
943
+ for (i=0; i<argc; ++i) {
944
+ j = NUM2INT(argv[i]);
945
+ if (j<0) /* negative rank : -1=>append after last rank */
946
+ j += ary->rank+1;
947
+ if (j<0 || j>ary->rank) /* range check */
948
+ rb_raise(rb_eArgError, "rank out of range");
949
+ ++count[j];
950
+ }
951
+ /* extend shape shape */
952
+ shape = ALLOC_N(int,ary->rank+argc);
953
+ for (j=i=0; i<ary->rank; ++i) {
954
+ while (count[i]-->0) shape[j++] = 1;
955
+ shape[j++] = ary->shape[i];
956
+ }
957
+ while (count[i]-->0) shape[j++] = 1;
958
+
959
+ /* exchange shape */
960
+ xfree(ary->shape);
961
+ ary->shape = shape;
962
+ ary->rank += argc;
963
+ }
964
+
965
+
966
+ /* method: newdim!(size1,size2,...,sizeN) */
967
+ static VALUE
968
+ na_newdim_bang(int argc, VALUE *argv, VALUE self)
969
+ {
970
+ struct NARRAY *ary;
971
+
972
+ GetNArray(self,ary);
973
+ na_newdim(argc, argv, ary);
974
+ return self;
975
+ }
976
+
977
+
978
+ /* method: newdim(size1,size2,...,sizeN) */
979
+ VALUE
980
+ na_newdim_ref(int argc, VALUE *argv, VALUE self)
981
+ {
982
+ struct NARRAY *ary;
983
+
984
+ GetNArray(self,ary);
985
+ ary = na_ref_alloc_struct(self);
986
+ na_newdim(argc, argv, ary);
987
+ return na_wrap_struct(ary,self);
988
+ }
989
+
990
+
991
+ /* method: fill!(val) */
992
+ VALUE na_fill(VALUE self, volatile VALUE val)
993
+ {
994
+ struct NARRAY *a1, *a2;
995
+
996
+ GetNArray(self,a1);
997
+ val = na_cast_unless_narray(val,a1->type);
998
+ GetNArray(val,a2);
999
+
1000
+ if (a2->total != 1)
1001
+ rb_raise(rb_eArgError, "single-element argument required");
1002
+
1003
+ SetFuncs[a1->type][a2->type]( a1->total,
1004
+ a1->ptr, na_sizeof[a1->type],
1005
+ a2->ptr, 0 );
1006
+ return self;
1007
+ }
1008
+
1009
+
1010
+ /* method: indgen!([start,[step]]) */
1011
+ VALUE
1012
+ na_indgen(int argc, VALUE *argv, VALUE self)
1013
+ {
1014
+ int start=0, step=1;
1015
+ struct NARRAY *ary;
1016
+
1017
+ if (argc>0) {
1018
+ start = NUM2INT(argv[0]);
1019
+ if (argc==2)
1020
+ step = NUM2INT(argv[1]);
1021
+ else
1022
+ if (argc>2)
1023
+ rb_raise(rb_eArgError, "wrong # of arguments (%d for <= 2)", argc);
1024
+ }
1025
+
1026
+ GetNArray(self,ary);
1027
+ IndGenFuncs[ary->type]( ary->total,
1028
+ ary->ptr, na_sizeof[ary->type],
1029
+ start, step );
1030
+ return self;
1031
+ }
1032
+
1033
+
1034
+ /* method: where2
1035
+ idx_true, idx_false = narray.where2 */
1036
+ static VALUE
1037
+ na_where2(volatile VALUE obj)
1038
+ {
1039
+ VALUE v1, v0;
1040
+ int n, i, n1, n0;
1041
+ char *c;
1042
+ int32_t *idx1, *idx0;
1043
+ struct NARRAY *ary, *a1, *a0; /* a1=true, a0=false */
1044
+
1045
+ GetNArray(obj,ary);
1046
+ /* Convert to NA_BYTE by calling "obj.ne(0)", if needed */
1047
+ if(ary->type != NA_BYTE) {
1048
+ obj = rb_funcall(obj, na_id_ne, 1, INT2FIX(0));
1049
+ GetNArray(obj,ary);
1050
+ }
1051
+ n = ary->total;
1052
+
1053
+ /* Count true */
1054
+ c = ary->ptr;
1055
+ n1 = 0;
1056
+ for (i=0; i<n; ++i)
1057
+ if (*(c++)) ++n1;
1058
+
1059
+ n0 = n-n1;
1060
+
1061
+ /* partially true and false */
1062
+ v1 = na_make_object( NA_LINT, 1, &n1, cNArray );
1063
+ GetNArray(v1,a1);
1064
+ idx1 = (int32_t*) a1->ptr;
1065
+ v0 = na_make_object( NA_LINT, 1, &n0, cNArray );
1066
+ GetNArray(v0,a0);
1067
+ idx0 = (int32_t*) a0->ptr;
1068
+
1069
+ /* Get Indices */
1070
+ c = ary->ptr;
1071
+ for ( i=0; i<n; ++i ) {
1072
+ if (*(c++))
1073
+ *(idx1++) = i;
1074
+ else
1075
+ *(idx0++) = i;
1076
+ }
1077
+
1078
+ return rb_assoc_new( v1, v0 );
1079
+ }
1080
+
1081
+
1082
+ /* method: where
1083
+ idx_true = narray.where */
1084
+ static VALUE
1085
+ na_where(VALUE self)
1086
+ {
1087
+ return RARRAY_PTR( na_where2(self) )[0];
1088
+ }
1089
+
1090
+
1091
+ /* iterator: each() */
1092
+ static VALUE
1093
+ na_each(VALUE obj)
1094
+ {
1095
+ int i, sz;
1096
+ VALUE v;
1097
+ struct NARRAY *ary;
1098
+ char *p;
1099
+ void (*func)();
1100
+
1101
+ GetNArray(obj,ary);
1102
+
1103
+ p = ary->ptr;
1104
+ sz = na_sizeof[ary->type];
1105
+ func = SetFuncs[NA_ROBJ][ary->type];
1106
+
1107
+ for ( i=ary->total; i-->0; ) {
1108
+ (*func)( 1, &v, 0, p, 0 );
1109
+ rb_yield(v);
1110
+ p += sz;
1111
+ }
1112
+ return Qnil;
1113
+ }
1114
+
1115
+
1116
+ /* iterator: collect() */
1117
+ static VALUE
1118
+ na_collect(VALUE obj1)
1119
+ {
1120
+ int i, sz;
1121
+ VALUE v, obj2;
1122
+ struct NARRAY *a1, *a2;
1123
+ char *p1, *p2;
1124
+ void (*get)(), (*set)();
1125
+
1126
+ GetNArray(obj1,a1);
1127
+ obj2 = na_make_object(a1->type, a1->rank, a1->shape, CLASS_OF(obj1));
1128
+ GetNArray(obj2,a2);
1129
+
1130
+ p1 = a1->ptr;
1131
+ p2 = a2->ptr;
1132
+ sz = na_sizeof[a1->type];
1133
+ get = SetFuncs[NA_ROBJ][a1->type];
1134
+ set = SetFuncs[a1->type][NA_ROBJ];
1135
+
1136
+ for ( i=a1->total; i-->0; ) {
1137
+ (*get)( 1, &v, 0, p1, 0 );
1138
+ v = rb_yield(v);
1139
+ (*set)( 1, p2, 0, &v, 0 );
1140
+ p1 += sz;
1141
+ p2 += sz;
1142
+ }
1143
+ return obj2;
1144
+ }
1145
+
1146
+
1147
+ /* iterator: collect!() */
1148
+ static VALUE
1149
+ na_collect_bang(VALUE self)
1150
+ {
1151
+ int i, sz;
1152
+ VALUE v;
1153
+ struct NARRAY *a1;
1154
+ char *p1;
1155
+ void (*get)(), (*set)();
1156
+
1157
+ GetNArray(self,a1);
1158
+
1159
+ p1 = a1->ptr;
1160
+ sz = na_sizeof[a1->type];
1161
+ get = SetFuncs[NA_ROBJ][a1->type];
1162
+ set = SetFuncs[a1->type][NA_ROBJ];
1163
+
1164
+ for ( i=a1->total; i-->0; ) {
1165
+ (*get)( 1, &v, 0, p1, 0 );
1166
+ v = rb_yield(v);
1167
+ (*set)( 1, p1, 0, &v, 0 );
1168
+ p1 += sz;
1169
+ }
1170
+ return self;
1171
+ }
1172
+
1173
+
1174
+ /* initialization of NArray Class */
1175
+ void
1176
+ Init_narray()
1177
+ {
1178
+ ID id_Complex = rb_intern("Complex");
1179
+
1180
+ if (!rb_const_defined( rb_cObject, id_Complex)) {
1181
+ /* require Complex class */
1182
+ rb_require("complex");
1183
+ }
1184
+ cComplex = rb_const_get( rb_cObject, rb_intern("Complex") );
1185
+
1186
+ /* define NArray class */
1187
+ cNArray = rb_define_class("NArray",rb_cObject);
1188
+
1189
+ /* class methods */
1190
+ rb_define_singleton_method(cNArray,"new",na_s_new,-1);
1191
+ rb_define_singleton_method(cNArray,"byte",na_s_new_byte,-1);
1192
+ rb_define_singleton_method(cNArray,"sint",na_s_new_sint,-1);
1193
+ rb_define_singleton_method(cNArray,"lint",na_s_new_int,-1);
1194
+ rb_define_singleton_method(cNArray,"int", na_s_new_int,-1);
1195
+ rb_define_singleton_method(cNArray,"sfloat",na_s_new_sfloat,-1);
1196
+ rb_define_singleton_method(cNArray,"dfloat",na_s_new_float,-1);
1197
+ rb_define_singleton_method(cNArray,"float", na_s_new_float,-1);
1198
+ rb_define_singleton_method(cNArray,"scomplex",na_s_new_scomplex,-1);
1199
+ rb_define_singleton_method(cNArray,"dcomplex",na_s_new_complex,-1);
1200
+ rb_define_singleton_method(cNArray,"complex", na_s_new_complex,-1);
1201
+ rb_define_singleton_method(cNArray,"object",na_s_new_object,-1);
1202
+
1203
+ rb_define_singleton_method(cNArray,"to_na",na_s_to_na,-1);
1204
+ rb_define_singleton_method(cNArray,"to_narray",na_s_to_na,-1);
1205
+ rb_define_singleton_method(cNArray,"[]",na_s_bracket,-1);
1206
+
1207
+ /* methods */
1208
+ rb_define_method(cNArray, "shape", na_shape,0);
1209
+ rb_define_alias(cNArray, "sizes","shape");
1210
+ rb_define_method(cNArray, "size", na_size,0);
1211
+ rb_define_alias(cNArray, "total","size");
1212
+ rb_define_alias(cNArray, "length","size");
1213
+ rb_define_method(cNArray, "rank", na_rank,0);
1214
+ rb_define_alias(cNArray, "dim","rank");
1215
+ rb_define_alias(cNArray, "dimension","rank");
1216
+ rb_define_method(cNArray, "typecode", na_typecode,0);
1217
+ rb_define_method(cNArray, "element_size", na_element_size,0);
1218
+ rb_define_method(cNArray, "empty?", na_is_empty,0);
1219
+ rb_define_method(cNArray, "clone", na_clone,0);
1220
+ rb_define_alias(cNArray, "dup","clone");
1221
+ rb_define_method(cNArray, "inspect", na_inspect,0);
1222
+ rb_define_method(cNArray, "coerce", na_coerce,1);
1223
+ rb_define_method(cNArray, "reshape", na_reshape_ref,-1);
1224
+ rb_define_method(cNArray, "reshape!", na_reshape_bang,-1);
1225
+ rb_define_alias(cNArray, "shape=","reshape!");
1226
+ rb_define_method(cNArray, "newdim", na_newdim_ref,-1);
1227
+ rb_define_alias(cNArray, "newrank","newdim");
1228
+ rb_define_method(cNArray, "newdim!", na_newdim_bang,-1);
1229
+ rb_define_alias(cNArray, "newdim=","newdim!");
1230
+ rb_define_alias(cNArray, "newrank!","newdim!");
1231
+ rb_define_alias(cNArray, "newrank=","newdim!");
1232
+ rb_define_method(cNArray, "flatten", na_flatten_ref,0);
1233
+ rb_define_method(cNArray, "flatten!", na_flatten_bang,0);
1234
+ rb_define_method(cNArray, "fill!", na_fill,1);
1235
+ rb_define_alias(cNArray, "fill","fill!");
1236
+ rb_define_method(cNArray, "indgen!", na_indgen,-1);
1237
+ rb_define_alias(cNArray, "indgen","indgen!");
1238
+ rb_define_method(cNArray, "where", na_where, 0);
1239
+ rb_define_method(cNArray, "where2", na_where2, 0);
1240
+ rb_define_method(cNArray, "each", na_each,0);
1241
+ rb_define_method(cNArray, "collect", na_collect,0);
1242
+ rb_define_method(cNArray, "collect!", na_collect_bang,0);
1243
+ rb_define_alias(cNArray, "map", "collect");
1244
+ rb_define_alias(cNArray, "map!", "collect!");
1245
+ rb_define_method(cNArray, "to_s", na_to_s, 0);
1246
+ rb_define_method(cNArray, "to_f", na_to_float, 0);
1247
+ rb_define_method(cNArray, "to_i", na_to_integer, 0);
1248
+ rb_define_method(cNArray, "to_type", na_to_type, 1);
1249
+ rb_define_method(cNArray, "to_binary", na_to_binary, 0);
1250
+ rb_define_method(cNArray, "to_type_as_binary", na_to_type_as_binary, 1);
1251
+ rb_define_method(cNArray, "to_string", na_to_string, 0);
1252
+
1253
+ rb_define_const(cNArray, "NARRAY_VERSION", rb_str_new2(NARRAY_VERSION));
1254
+ rb_define_const(cNArray, "BYTE", INT2FIX(NA_BYTE));
1255
+ rb_define_const(cNArray, "SINT", INT2FIX(NA_SINT));
1256
+ rb_define_const(cNArray, "LINT", INT2FIX(NA_LINT));
1257
+ rb_define_const(cNArray, "INT", INT2FIX(NA_LINT));
1258
+ rb_define_const(cNArray, "SFLOAT", INT2FIX(NA_SFLOAT));
1259
+ rb_define_const(cNArray, "DFLOAT", INT2FIX(NA_DFLOAT));
1260
+ rb_define_const(cNArray, "FLOAT", INT2FIX(NA_DFLOAT));
1261
+ rb_define_const(cNArray, "SCOMPLEX", INT2FIX(NA_SCOMPLEX));
1262
+ rb_define_const(cNArray, "DCOMPLEX", INT2FIX(NA_DCOMPLEX));
1263
+ rb_define_const(cNArray, "COMPLEX", INT2FIX(NA_DCOMPLEX));
1264
+ rb_define_const(cNArray, "ROBJ", INT2FIX(NA_ROBJ));
1265
+ rb_define_const(cNArray, "OBJECT", INT2FIX(NA_ROBJ));
1266
+ rb_define_const(cNArray, "NONE", INT2FIX(NA_NONE));
1267
+ rb_define_const(cNArray, "CLASS_DIMENSION", INT2FIX(0));
1268
+ #ifdef WORDS_BIGENDIAN
1269
+ rb_define_const(cNArray, "ENDIAN", INT2FIX(1));
1270
+ #else
1271
+ #ifdef DYNAMIC_ENDIAN /* not supported yet */
1272
+ rb_define_const(cNArray, "ENDIAN", INT2FIX(-1));
1273
+ #else /* LITTLE_ENDIAN */
1274
+ rb_define_const(cNArray, "ENDIAN", INT2FIX(0));
1275
+ #endif
1276
+ #endif
1277
+ /* Reference */
1278
+ rb_define_singleton_method(cNArray, "refer", na_s_refer,1);
1279
+ rb_define_singleton_method(cNArray, "ref", na_s_refer,1);
1280
+ rb_define_method(cNArray, "refer", na_refer,0);
1281
+ rb_define_method(cNArray, "original", na_original,0);
1282
+
1283
+ Init_na_array();
1284
+ Init_na_index();
1285
+ Init_nmath();
1286
+ Init_na_funcs();
1287
+ Init_na_random();
1288
+
1289
+ cNArrayScalar = rb_define_class_under(cNArray, "NArrayScalar", cNArray);
1290
+
1291
+ na_id_beg = rb_intern("begin");
1292
+ na_id_end = rb_intern("end");
1293
+ na_id_exclude_end = rb_intern("exclude_end?");
1294
+ na_id_real = rb_intern("real");
1295
+ na_id_imag = rb_intern("imag");
1296
+ na_id_new = rb_intern("new");
1297
+ na_id_to_i = rb_intern("to_i");
1298
+ na_id_usec = rb_intern("usec");
1299
+ na_id_now = rb_intern("now");
1300
+ na_id_compare = rb_intern("<=>");
1301
+ na_id_ne = rb_intern("ne");
1302
+ na_id_and = rb_intern("&&");
1303
+ na_id_or = rb_intern("||");
1304
+ na_id_minus = rb_intern("-@");
1305
+ na_id_abs = rb_intern("abs");
1306
+ na_id_power = rb_intern("**");
1307
+ na_id_add = rb_intern("+");
1308
+ na_id_sbt = rb_intern("-");
1309
+ na_id_mul = rb_intern("*");
1310
+ na_id_div = rb_intern("/");
1311
+ na_id_mod = rb_intern("%");
1312
+ na_id_coerce_rev = rb_intern("coerce_rev");
1313
+ na_id_Complex = rb_intern("Complex");
1314
+
1315
+ na_id_class_dim = rb_intern("CLASS_DIMENSION");
1316
+
1317
+ Init_na_linalg();
1318
+
1319
+ /* NArray extention script */
1320
+ rb_require("narray_ext.rb");
1321
+ }