narray-nmatrix 0.6.1.0.pre

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,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
+ }