narray 0.5.9.4

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.
Files changed (81) hide show
  1. data/src/ChangeLog +614 -0
  2. data/src/MANIFEST +82 -0
  3. data/src/README.en +54 -0
  4. data/src/README.ja +63 -0
  5. data/src/SPEC.en +300 -0
  6. data/src/SPEC.ja +284 -0
  7. data/src/depend +14 -0
  8. data/src/extconf.rb +111 -0
  9. data/src/lib/narray_ext.rb +211 -0
  10. data/src/lib/nmatrix.rb +244 -0
  11. data/src/mkmath.rb +780 -0
  12. data/src/mknafunc.rb +190 -0
  13. data/src/mkop.rb +638 -0
  14. data/src/na_array.c +644 -0
  15. data/src/na_func.c +1624 -0
  16. data/src/na_index.c +988 -0
  17. data/src/na_linalg.c +616 -0
  18. data/src/na_random.c +409 -0
  19. data/src/narray.c +1308 -0
  20. data/src/narray.def +29 -0
  21. data/src/narray.h +170 -0
  22. data/src/narray_local.h +210 -0
  23. data/src/nimage/README.en +38 -0
  24. data/src/nimage/demo/fits.rb +97 -0
  25. data/src/nimage/demo/fits_convol.rb +28 -0
  26. data/src/nimage/demo/fits_fftdemo.rb +27 -0
  27. data/src/nimage/demo/fitsdemo1.rb +13 -0
  28. data/src/nimage/demo/fitsdemo2.rb +30 -0
  29. data/src/nimage/demo/fitsdemo3.rb +26 -0
  30. data/src/nimage/demo/fitsmorph.rb +39 -0
  31. data/src/nimage/demo/life_na.rb +57 -0
  32. data/src/nimage/demo/mandel.rb +41 -0
  33. data/src/nimage/extconf.rb +12 -0
  34. data/src/nimage/lib/nimage.rb +51 -0
  35. data/src/nimage/nimage.c +328 -0
  36. data/src/speed/add.py +12 -0
  37. data/src/speed/add.rb +8 -0
  38. data/src/speed/add_int.py +12 -0
  39. data/src/speed/add_int.rb +9 -0
  40. data/src/speed/lu.m +14 -0
  41. data/src/speed/lu.rb +22 -0
  42. data/src/speed/mat.m +23 -0
  43. data/src/speed/mat.rb +28 -0
  44. data/src/speed/mul.py +12 -0
  45. data/src/speed/mul.rb +9 -0
  46. data/src/speed/mul2.py +15 -0
  47. data/src/speed/mul2.rb +13 -0
  48. data/src/speed/mul_comp.py +12 -0
  49. data/src/speed/mul_comp.rb +9 -0
  50. data/src/speed/mul_int.py +12 -0
  51. data/src/speed/mul_int.rb +9 -0
  52. data/src/speed/mybench.py +15 -0
  53. data/src/speed/mybench.rb +31 -0
  54. data/src/speed/solve.m +18 -0
  55. data/src/speed/solve.py +16 -0
  56. data/src/speed/solve.rb +21 -0
  57. data/src/test/statistics.rb +22 -0
  58. data/src/test/testarray.rb +20 -0
  59. data/src/test/testbit.rb +27 -0
  60. data/src/test/testcast.rb +14 -0
  61. data/src/test/testcomplex.rb +35 -0
  62. data/src/test/testfftw.rb +16 -0
  63. data/src/test/testindex.rb +11 -0
  64. data/src/test/testindexary.rb +26 -0
  65. data/src/test/testindexset.rb +55 -0
  66. data/src/test/testmask.rb +40 -0
  67. data/src/test/testmath.rb +48 -0
  68. data/src/test/testmath2.rb +46 -0
  69. data/src/test/testmatrix.rb +13 -0
  70. data/src/test/testmatrix2.rb +33 -0
  71. data/src/test/testmatrix3.rb +19 -0
  72. data/src/test/testminmax.rb +46 -0
  73. data/src/test/testobject.rb +29 -0
  74. data/src/test/testpow.rb +19 -0
  75. data/src/test/testrandom.rb +23 -0
  76. data/src/test/testround.rb +11 -0
  77. data/src/test/testsort.rb +37 -0
  78. data/src/test/teststr.rb +13 -0
  79. data/src/test/testtrans.rb +18 -0
  80. data/src/test/testwhere.rb +27 -0
  81. metadata +127 -0
data/src/mkmath.rb ADDED
@@ -0,0 +1,780 @@
1
+ require "mknafunc"
2
+
3
+ # File name
4
+ fname = "na_math.c"
5
+ $> = open(fname,"w")
6
+
7
+ print <<EOM
8
+ /*
9
+ #{fname}
10
+ Automatically generated code
11
+ Numerical Array Extention for Ruby
12
+ (C) Copyright 1999-2002 by Masahiro TANAKA
13
+
14
+ This program is free software.
15
+ You can distribute/modify this program
16
+ under the same terms as Ruby itself.
17
+ NO WARRANTY.
18
+ */
19
+ #include <ruby.h>
20
+ #include "narray.h"
21
+ #include "narray_local.h"
22
+
23
+ #ifndef M_LOG2E
24
+ #define M_LOG2E 1.4426950408889634074
25
+ #endif
26
+ #ifndef M_LOG10E
27
+ #define M_LOG10E 0.43429448190325182765
28
+ #endif
29
+
30
+ VALUE rb_mNMath;
31
+
32
+ static void TpErr(void) {
33
+ rb_raise(rb_eTypeError,"illegal operation with this type");
34
+ }
35
+
36
+ #if 0
37
+ void sincos(double x, double *s, double *c)
38
+ {
39
+ *s=sin(x); *c=cos(x);
40
+ }
41
+ #endif
42
+
43
+ #ifndef HAVE_ACOSH
44
+ static double rb_log1p (const double x)
45
+ {
46
+ double y;
47
+ y = 1+x;
48
+
49
+ if (y==1)
50
+ return x;
51
+ else
52
+ return log(y)*(x/(y-1));
53
+ }
54
+
55
+ static double zero=0;
56
+
57
+ static double acosh(double x)
58
+ {
59
+ /* acosh(x) = log(x+sqrt(x*x-1)) */
60
+ if (x>2) {
61
+ return log(2*x-1/(sqrt(x*x-1)+x));
62
+ } else if (x>=1) {
63
+ x-=1;
64
+ return rb_log1p(x+sqrt(2*x+x*x));
65
+ }
66
+ return zero/(x-x); /* x<1: NaN */
67
+ }
68
+
69
+ static double asinh(double x)
70
+ {
71
+ double a, x2;
72
+ int neg;
73
+
74
+ /* asinh(x) = log(x+sqrt(x*x+1)) */
75
+ neg = x<0;
76
+ if (neg) {x=-x;}
77
+ x2 = x*x;
78
+
79
+ if (x>2) {
80
+ a = log(2*x+1/(x+sqrt(x2+1)));
81
+ } else {
82
+ a = rb_log1p(x+x2/(1+sqrt(x2+1)));
83
+ }
84
+ if (neg) {a=-a;}
85
+ return a;
86
+ }
87
+
88
+ static double atanh(double x)
89
+ {
90
+ double a, x2;
91
+ int neg;
92
+
93
+ /* atanh(x) = 0.5*log((1+x)/(1-x)) */
94
+ neg = x<0;
95
+ if (neg) {x=-x;}
96
+ x2 = x*2;
97
+
98
+ if (x<0.5) {
99
+ a = 0.5*rb_log1p(x2+x2*x/(1-x));
100
+ } else if (x<1) {
101
+ a = 0.5*rb_log1p(x2/(1-x));
102
+ } else if (x==1) {
103
+ a = 1/zero; /* Infinity */
104
+ } else {
105
+ return zero/(x-x); /* x>1: NaN */
106
+ }
107
+ if (neg) {a=-a;}
108
+ return a;
109
+ }
110
+ #endif
111
+
112
+ static void squareX(scomplex *x) {
113
+ float r=x->r;
114
+ x->r = r*r - x->i*x->i;
115
+ x->i = 2*r*x->i;
116
+ }
117
+
118
+ static void squareC(dcomplex *x) {
119
+ double r=x->r;
120
+ x->r = r*r - x->i*x->i;
121
+ x->i = 2*r*x->i;
122
+ }
123
+
124
+
125
+ static void mulX(scomplex *x, scomplex *y) {
126
+ scomplex z=*x;
127
+ x->r = z.r*y->r - z.i*y->i;
128
+ x->i = z.r*y->i + z.i*y->r;
129
+ }
130
+
131
+ static void mulC(dcomplex *x, dcomplex *y) {
132
+ dcomplex z=*x;
133
+ x->r = z.r*y->r - z.i*y->i;
134
+ x->i = z.r*y->i + z.i*y->r;
135
+ }
136
+
137
+
138
+ static void divX(scomplex *p1, scomplex *p2) {
139
+ scomplex x = *p1;
140
+ float a = p2->r*p2->r + p2->i*p2->i;
141
+ p1->r = (x.r*p2->r + x.i*p2->i)/a;
142
+ p1->i = (x.i*p2->r - x.r*p2->i)/a;
143
+ }
144
+
145
+ static void divC(dcomplex *p1, dcomplex *p2) {
146
+ dcomplex x = *p1;
147
+ double a = p2->r*p2->r + p2->i*p2->i;
148
+ p1->r = (x.r*p2->r + x.i*p2->i)/a;
149
+ p1->i = (x.i*p2->r - x.r*p2->i)/a;
150
+ }
151
+
152
+
153
+ static scomplex recipX(scomplex *z)
154
+ {
155
+ scomplex r;
156
+ float n;
157
+
158
+ if ( (z->r<0 ? -z->r:z->r) > (z->i<0 ? -z->i:z->i) ) {
159
+ r.i = z->i/z->r;
160
+ n = (1+r.i*r.i)*z->r;
161
+ r.r = 1/n;
162
+ r.i /= -n;
163
+ } else {
164
+ r.r = z->r/z->i;
165
+ n = (1+r.r*r.r)*z->i;
166
+ r.r /= n;
167
+ r.i = -1/n;
168
+ }
169
+ return r;
170
+ }
171
+
172
+ static dcomplex recipC(dcomplex *z)
173
+ {
174
+ dcomplex r;
175
+ double n;
176
+
177
+ if ( (z->r<0 ? -z->r:z->r) > (z->i<0 ? -z->i:z->i) ) {
178
+ r.i = z->i/z->r;
179
+ n = (1+r.i*r.i)*z->r;
180
+ r.r = 1/n;
181
+ r.i /= -n;
182
+ } else {
183
+ r.r = z->r/z->i;
184
+ n = (1+r.r*r.r)*z->i;
185
+ r.r /= n;
186
+ r.i = -1/n;
187
+ }
188
+ return r;
189
+ }
190
+
191
+
192
+ static int powInt(int x, int p)
193
+ {
194
+ int r=1;
195
+
196
+ switch(p) {
197
+ case 2: return x*x;
198
+ case 3: return x*x*x;
199
+ case 1: return x;
200
+ case 0: return 1;
201
+ }
202
+ if (p<0) return 0;
203
+ /* if(p>3) */
204
+ while (p) {
205
+ if ( (p%2) == 1 ) r *= x;
206
+ x *= x;
207
+ p /= 2;
208
+ }
209
+ return r;
210
+ }
211
+
212
+
213
+ static float powFi(float x, int p)
214
+ {
215
+ float r=1;
216
+
217
+ switch(p) {
218
+ case 2: return x*x;
219
+ case 3: return x*x*x;
220
+ case 1: return x;
221
+ case 0: return 1;
222
+ }
223
+ if (p<0) return 1/powFi(x,-p);
224
+ /* if(p>3) */
225
+ while (p) {
226
+ if ( (p%2) == 1 ) r *= x;
227
+ x *= x;
228
+ p /= 2;
229
+ }
230
+ return r;
231
+ }
232
+
233
+
234
+ static double powDi(double x, int p)
235
+ {
236
+ double r=1;
237
+
238
+ switch(p) {
239
+ case 2: return x*x;
240
+ case 3: return x*x*x;
241
+ case 1: return x;
242
+ case 0: return 1;
243
+ }
244
+ if (p<0) return 1/powDi(x,-p);
245
+ /* if(p>3) */
246
+ while (p) {
247
+ if ( (p%2) == 1 ) r *= x;
248
+ x *= x;
249
+ p /= 2;
250
+ }
251
+ return r;
252
+ }
253
+
254
+
255
+ static scomplex powXi(scomplex *x, int p)
256
+ {
257
+ scomplex y=*x, r={1,0};
258
+
259
+ if (p==2) { squareX(&y); return y; }
260
+ if (p==1) { return y; }
261
+ if (p==0) { return r; }
262
+ if (p<0) {
263
+ y = powXi(x,-p);
264
+ return recipX(&y);
265
+ }
266
+ /* if (p>2) */
267
+ while (p) {
268
+ if ( (p%2) == 1 ) mulX(&r,&y);
269
+ squareX(&y);
270
+ p /= 2;
271
+ }
272
+ return r;
273
+ }
274
+
275
+ static dcomplex powCi(dcomplex *x, int p)
276
+ {
277
+ dcomplex y=*x, r={1,0};
278
+
279
+ if (p==2) { squareC(&y); return y; }
280
+ if (p==1) { return y; }
281
+ if (p==0) { return r; }
282
+ if (p<0) {
283
+ y = powCi(x,-p);
284
+ return recipC(&y);
285
+ }
286
+ /* if (p>2) */
287
+ while (p) {
288
+ if ( (p%2) == 1 ) mulC(&r,&y);
289
+ squareC(&y);
290
+ p /= 2;
291
+ }
292
+ return r;
293
+ }
294
+
295
+
296
+ EOM
297
+
298
+ data = [
299
+ ['sqrt',
300
+ [nil]*4 +
301
+ ["{ *p1 = sqrt(*p2); }"]*2 +
302
+ ["{
303
+ typer xr=p2->r/2, xi=p2->i/2, r=hypot(xr,xi);
304
+ if (xr>0) {
305
+ p1->r = sqrt(r+xr);
306
+ p1->i = xi/p1->r;
307
+ } else if ( (r-=xr) ) {
308
+ p1->i = (xi>=0) ? sqrt(r):-sqrt(r);
309
+ p1->r = xi/p1->i;
310
+ } else {
311
+ p1->r = p1->i = 0;
312
+ }
313
+ }"]*2 +
314
+ [nil] ],
315
+
316
+ ['sin',
317
+ [nil]*4 +
318
+ ["{ *p1 = sin(*p2); }"]*2 +
319
+ ["{
320
+ p1->r = sin(p2->r)*cosh(p2->i);
321
+ p1->i = cos(p2->r)*sinh(p2->i); }"]*2 +
322
+ [nil] ],
323
+
324
+ ['cos',
325
+ [nil]*4 +
326
+ ["{ *p1 = cos(*p2); }"]*2 +
327
+ ["{
328
+ p1->r = cos(p2->r)*cosh(p2->i);
329
+ p1->i = -sin(p2->r)*sinh(p2->i); }"]*2 +
330
+ [nil] ],
331
+
332
+ ['tan',
333
+ [nil]*4 +
334
+ ["{ *p1 = tan(*p2); }"]*2 +
335
+ ["{
336
+ typer d, th;
337
+ p1->i = th = tanh(2*p2->i);
338
+ p1->r = sqrt(1-th*th); /* sech */
339
+ d = 1 + cos(2*p2->r) * p1->r;
340
+ p1->r *= sin(2*p2->r)/d;
341
+ p1->i /= d;
342
+ }"]*2 +
343
+ [nil] ],
344
+
345
+ ['sinh',
346
+ [nil]*4 +
347
+ ["{ *p1 = sinh(*p2); }"]*2 +
348
+ ["{
349
+ p1->r = sinh(p2->r)*cos(p2->i);
350
+ p1->i = cosh(p2->r)*sin(p2->i);
351
+ }"]*2 +
352
+ [nil] ],
353
+
354
+ ['cosh',
355
+ [nil]*4 +
356
+ ["{ *p1 = cosh(*p2); }"]*2 +
357
+ ["{
358
+ p1->r = cosh(p2->r)*cos(p2->i);
359
+ p1->i = sinh(p2->r)*sin(p2->i);
360
+ }"]*2 +
361
+ [nil] ],
362
+
363
+ ['tanh',
364
+ [nil]*4 +
365
+ ["{ *p1 = tanh(*p2); }"]*2 +
366
+ ["{
367
+ typer d, th;
368
+ p1->r = th = tanh(2*p2->r);
369
+ p1->i = sqrt(1-th*th); /* sech */
370
+ d = 1 + cos(2*p2->i) * p1->i;
371
+ p1->r /= d;
372
+ p1->i *= sin(2*p2->i)/d;
373
+ }"]*2 +
374
+ [nil] ],
375
+
376
+ ['exp',
377
+ [nil]*4 +
378
+ ["{ *p1 = exp(*p2); }"]*2 +
379
+ ["{
380
+ typer a = exp(p2->r);
381
+ p1->r = a*cos(p2->i);
382
+ p1->i = a*sin(p2->i);
383
+ }"]*2 +
384
+ [nil] ],
385
+
386
+ ['log',
387
+ [nil]*4 +
388
+ ["{ *p1 = log(*p2); }"]*2 +
389
+ ["{
390
+ typed x = *p2;
391
+ p1->r = log(hypot(x.r, x.i));
392
+ p1->i = atan2(x.i, x.r);
393
+ }"]*2 +
394
+ [nil] ],
395
+
396
+ ['log10',
397
+ [nil]*4 +
398
+ ["{ *p1 = log10(*p2); }"]*2 +
399
+ ["{
400
+ log#code(p1,p2);
401
+ p1->r *= M_LOG10E;
402
+ p1->i *= M_LOG10E;
403
+ }"]*2 +
404
+ [nil] ],
405
+
406
+
407
+ ['log2',
408
+ [nil]*4 +
409
+ ["{ *p1 = log(*p2)*M_LOG2E; }"]*2 +
410
+ ["{
411
+ log#code(p1,p2);
412
+ p1->r *= M_LOG2E;
413
+ p1->i *= M_LOG2E;
414
+ }"]*2 +
415
+ [nil] ],
416
+
417
+
418
+ ['asin',
419
+ [nil]*4 +
420
+ ["{ *p1 = asin(*p2); }"]*2 +
421
+ # -i * log( sqrt(1-x**2) + x*i )
422
+ ["{
423
+ typed x = *p2;
424
+ square#code(&x);
425
+ x.r = 1 - x.r;
426
+ x.i = - x.i;
427
+ sqrt#code(&x,&x);
428
+ x.r -= p2->i;
429
+ x.i += p2->r;
430
+ log#code(&x,&x);
431
+ p1->r = x.i;
432
+ p1->i = -x.r;
433
+ }"]*2 +
434
+ [nil]*1 ],
435
+
436
+ ['asinh',
437
+ [nil]*4 +
438
+ ["{ *p1 = asinh(*p2); }"]*2 +
439
+ # log(sqrt(x**2+1)+x)
440
+ ["{
441
+ typed x = *p2;
442
+ square#code(&x);
443
+ x.r += 1;
444
+ sqrt#code(&x,&x);
445
+ x.r += p2->r;
446
+ x.i += p2->i;
447
+ log#code(p1,&x);
448
+ }"]*2 +
449
+ [nil]*1 ],
450
+
451
+ ['acos',
452
+ [nil]*4 +
453
+ ["{ *p1 = acos(*p2); }"]*2 +
454
+ # -i * log( sqrt(1-x**2)*i + x )
455
+ ["{
456
+ typed x = *p2;
457
+ typer tmp;
458
+ square#code(&x);
459
+ x.r = 1 - x.r;
460
+ x.i = - x.i;
461
+ sqrt#code(&x,&x);
462
+ tmp = x.r + p2->i;
463
+ x.r = -x.i + p2->r;
464
+ x.i = tmp;
465
+ log#code(&x,&x);
466
+ p1->r = x.i;
467
+ p1->i = -x.r;
468
+ }"]*2 +
469
+ [nil]*1 ],
470
+
471
+ ['acosh',
472
+ [nil]*4 +
473
+ ["{ *p1 = acosh(*p2); }"]*2 +
474
+ # log(x+sqrt(x**2-1))
475
+ ["{
476
+ typed x = *p2;
477
+ square#code(&x);
478
+ x.r -= 1;
479
+ sqrt#code(&x,&x);
480
+ x.r += p2->r;
481
+ x.i += p2->i;
482
+ log#code(p1,&x);
483
+ }"]*2 +
484
+ [nil]*1 ],
485
+
486
+ ['atan',
487
+ [nil]*4 +
488
+ ["{ *p1 = atan(*p2); }"]*2 +
489
+ # i/2 * log((i+x)/(i-x))
490
+ ["{
491
+ typed x,y;
492
+ x.r=-p2->r; x.i=1-p2->i;
493
+ y.r= p2->r; y.i=1+p2->i;
494
+ div#code((void*)&y,(void*)&x);
495
+ log#code((void*)&x,(void*)&y);
496
+ p1->r = -x.i/2;
497
+ p1->i = x.r/2;
498
+ }"]*2 +
499
+ [nil]*1 ],
500
+
501
+ ['atanh',
502
+ [nil]*4 +
503
+ ["{ *p1 = atanh(*p2); }"]*2 +
504
+ # 1/2 * log((1+x)/(1-x))
505
+ ["{
506
+ typed x,y;
507
+ x.r=1-p2->r; x.i=-p2->i;
508
+ y.r=1+p2->r; y.i= p2->i;
509
+ div#code((void*)&y,(void*)&x);
510
+ log#code((void*)&x,(void*)&y);
511
+ p1->r = x.r/2;
512
+ p1->i = x.i/2;
513
+ }"]*2 +
514
+ [nil]*1 ] ]
515
+
516
+
517
+
518
+ def mkmathfuncs(bsname,func)
519
+
520
+ print "
521
+ /* ------------------------- #{bsname} --------------------------- */\n"
522
+ c = $type_codes
523
+ tr = $real_types
524
+ td = $data_types
525
+ name = bsname
526
+
527
+ # Function Definition
528
+ head = "static void #{name}#code(void *p1, void *p2)"
529
+ for i in 0...c.size
530
+ if func[i] != nil && func[i]=~/^\{/
531
+ f = func[i].
532
+ gsub(/p1->/,"((#{td[i]}*)p1)->").
533
+ gsub(/p2->/,"((#{td[i]}*)p2)->").
534
+ gsub(/\*p1/,"*(#{td[i]}*)p1").
535
+ gsub(/\*p2/,"*(#{td[i]}*)p2").
536
+ gsub(/typer/, tr[i]).
537
+ gsub(/typed/, td[i])
538
+ puts( (head+f).gsub(/#code/,c[i]) )
539
+ end
540
+ end
541
+
542
+ # Function Array
543
+
544
+ print "\nna_mathfunc_t #{name}Funcs =\n{ "
545
+ m = []
546
+ for i in 0...c.size
547
+ if func[i] == nil
548
+ m += ['TpErr']
549
+ elsif func[i]=='copy'
550
+ m += ['Set'+c[i]*2]
551
+ elsif !( func[i] =~ /^\{/ )
552
+ m += [func[i]]
553
+ else
554
+ m += [name+c[i]]
555
+ end
556
+ end
557
+ print m.join(", ")+" };\n"
558
+
559
+ end
560
+
561
+
562
+ # Function Definitions
563
+ for i in data
564
+ mkmathfuncs( i[0], i[1] )
565
+ end
566
+
567
+
568
+ #
569
+ # Recip
570
+ #
571
+ $func_body =
572
+ "static void #name#C(int n, char *p1, int i1, char *p2, int i2)
573
+ {
574
+ for (; n; n--) {
575
+ OPERATION
576
+ p1+=i1; p2+=i2;
577
+ }
578
+ }
579
+ "
580
+ mkfuncs('Rcp', $data_types, $data_types,
581
+ [nil] +
582
+ ["*p1 = 1/(*p2);"]*5 +
583
+ ["*p1 = recip#C((type1*)p2);"]*2 +
584
+ ["*p1 = rb_funcall(INT2FIX(1),na_id_div,1,*p2);"]
585
+ )
586
+
587
+
588
+ #
589
+ # Power
590
+ #
591
+ def mkpowfuncs(name,funcs)
592
+
593
+ print "
594
+ /* ------------------------- #{name} --------------------------- */\n"
595
+ c = $type_codes
596
+ n = $type_codes.size
597
+ td = $data_types
598
+ tr = $real_types
599
+
600
+ # Function Definition
601
+
602
+ for i in 0...n
603
+ for j in 0...n
604
+ funcs.each do |k|
605
+ if c[i]=~k[0] && c[j]=~k[1]
606
+ tu = $data_types[$upcast[i][j]]
607
+ f = k[2].
608
+ gsub(/p1->/,"((#{tu}*)p1)->").
609
+ gsub(/p2->/,"((#{td[i]}*)p2)->").
610
+ gsub(/p3->/,"((#{td[j]}*)p3)->").
611
+ gsub(/\*p1/,"*(#{tu}*)p1").
612
+ gsub(/\*p2/,"*(#{td[i]}*)p2").
613
+ gsub(/\*p3/,"*(#{td[j]}*)p3").
614
+ gsub(/typed/,td[i]).
615
+ gsub(/typef/,tr[i])
616
+ puts $func_body.
617
+ gsub(/#name/,name).
618
+ sub(/OPERATION/,f).
619
+ gsub(/#CC/,c[i]+c[j]).
620
+ gsub(/#C/, c[i])
621
+ end
622
+ end
623
+ end
624
+ end
625
+
626
+ # function pointer array
627
+ print "\nna_setfunc_t "+name+"Funcs = {\n"
628
+ m = []
629
+ for i in 0...n
630
+ l = []
631
+ for j in 0...n
632
+ f = true
633
+ for k in funcs
634
+ if c[i]=~k[0] && c[j]=~k[1]
635
+ l += [name+c[i]+c[j]]
636
+ f = false
637
+ break
638
+ end
639
+ end
640
+ if f
641
+ l += ['TpErr']
642
+ end
643
+ end
644
+ m += [' { '+l.join(', ')+' }']
645
+ end
646
+ print m.join(",\n")+"\n};\n"
647
+
648
+ end
649
+
650
+ $func_body =
651
+ "static void #name#CC(int n, char *p1, int i1, char *p2, int i2, char *p3, int i3)
652
+ {
653
+ for (; n; n--) {
654
+ OPERATION
655
+ p1+=i1; p2+=i2; p3+=i3;
656
+ }
657
+ }
658
+ "
659
+ mkpowfuncs('Pow',
660
+ [
661
+ [/[O]/,/[O]/, "*p1 = rb_funcall(*p1,na_id_power,1,*p2);"],
662
+ [/[BIL]/,/[BIL]/, "*p1 = powInt(*p2,*p3);"],
663
+ [/[FD]/,/[BIL]/, "*p1 = pow#Ci(*p2,*p3);"],
664
+ [/[BILFD]/,/[FD]/,"*p1 = pow(*p2,*p3);"],
665
+ [/[XC]/,/[BIL]/, "*p1 = pow#Ci((typed*)p2,*p3);"],
666
+ [/[XC]/,/[FD]/,
667
+ "typed r;
668
+ if (*p3==0)
669
+ { p1->r=1; p1->i=0; } else
670
+ if (p2->r==0 && p2->i==0 && *p3>0)
671
+ { p1->r=0; p1->i=0; } else {
672
+ log#C(&r, p2);
673
+ r.r *= *p3;
674
+ r.i *= *p3;
675
+ exp#C(p1, &r); }"],
676
+ [/[XC]/,/[XC]/,
677
+ "typed l, r;
678
+ if (p3->r==0 && p3->i==0)
679
+ { p1->r=1; p1->i=0; } else
680
+ if (p2->r==0 && p2->i==0 && p3->r>0 && p3->i==0)
681
+ { p1->r=0; p1->i=0; } else {
682
+ log#C(&l, p2);
683
+ r.r = p3->r * l.r - p3->i * l.i;
684
+ r.i = p3->r * l.i + p3->i * l.r;
685
+ exp#C(p1, &r); }"]
686
+ ])
687
+
688
+
689
+ # Execution
690
+ print <<EOM
691
+
692
+
693
+ /* ------------------------- Execution -------------------------- */
694
+
695
+ static void
696
+ na_exec_math(struct NARRAY *a1, struct NARRAY *a2, void (*func)())
697
+ {
698
+ int i, s1, s2;
699
+ char *p1, *p2;
700
+
701
+ s1 = na_sizeof[a1->type];
702
+ s2 = na_sizeof[a2->type];
703
+ p1 = a1->ptr;
704
+ p2 = a2->ptr;
705
+ for (i=a1->total; i ; i--) {
706
+ (*func)( p1, p2 );
707
+ p1 += s1;
708
+ p2 += s2;
709
+ }
710
+ }
711
+
712
+
713
+ static VALUE
714
+ na_math_func(volatile VALUE self, na_mathfunc_t funcs)
715
+ {
716
+ struct NARRAY *a1, *a2;
717
+ VALUE ans;
718
+
719
+ if (TYPE(self) == T_ARRAY) {
720
+ self = na_ary_to_nary(self,cNArray);
721
+ } else
722
+ if (!IsNArray(self)) {
723
+ self = na_make_scalar(self,na_object_type(self));
724
+ }
725
+
726
+ GetNArray(self,a2);
727
+ if (NA_IsINTEGER(a2)) {
728
+ self = na_upcast_type(self,NA_DFLOAT);
729
+ GetNArray(self,a2);
730
+ }
731
+ ans = na_make_object(a2->type, a2->rank, a2->shape, CLASS_OF(self));
732
+ GetNArray(ans,a1);
733
+
734
+ na_exec_math(a1, a2, funcs[a2->type]);
735
+
736
+ if (CLASS_OF(self) == cNArrayScalar)
737
+ SetFuncs[NA_ROBJ][a1->type](1,&ans,0,a1->ptr,0);
738
+
739
+ return ans;
740
+ }
741
+ EOM
742
+
743
+
744
+ # Module Methods
745
+ print <<EOM
746
+
747
+ /* ------------------------- Module Methods -------------------------- */
748
+ EOM
749
+ for i in data
750
+ bsname=i[0]
751
+ name=bsname
752
+ print <<EOM
753
+
754
+ static VALUE na_math_#{bsname}(VALUE obj, VALUE x)
755
+ { return na_math_func(x,#{name}Funcs); }
756
+ EOM
757
+ end
758
+
759
+
760
+
761
+ # Initializer
762
+ print <<EOM
763
+
764
+
765
+ /* Initialization of NMath module */
766
+ void Init_nmath(void)
767
+ {
768
+ /* define ExtMath module */
769
+ rb_mNMath = rb_define_module("NMath");
770
+
771
+ /* methods */
772
+ EOM
773
+
774
+ for i in data
775
+ print " rb_define_module_function(rb_mNMath,\"#{i[0]}\",na_math_#{i[0]},1);\n"
776
+ end
777
+
778
+ print <<EOM
779
+ }
780
+ EOM