gsl 1.12.108

Sign up to get free protection for your applications and to get access to all the features.
Files changed (158) hide show
  1. data/README.rdoc +29 -0
  2. data/Rakefile +54 -0
  3. data/VERSION +2 -0
  4. data/ext/MANIFEST +119 -0
  5. data/ext/alf.c +206 -0
  6. data/ext/array.c +666 -0
  7. data/ext/array_complex.c +247 -0
  8. data/ext/blas.c +29 -0
  9. data/ext/blas1.c +731 -0
  10. data/ext/blas2.c +1093 -0
  11. data/ext/blas3.c +881 -0
  12. data/ext/block.c +44 -0
  13. data/ext/block_source.c +886 -0
  14. data/ext/bspline.c +130 -0
  15. data/ext/bundle.c +3 -0
  16. data/ext/cdf.c +754 -0
  17. data/ext/cheb.c +542 -0
  18. data/ext/combination.c +283 -0
  19. data/ext/common.c +325 -0
  20. data/ext/complex.c +1004 -0
  21. data/ext/const.c +673 -0
  22. data/ext/const_additional.c +120 -0
  23. data/ext/cqp.c +283 -0
  24. data/ext/deriv.c +195 -0
  25. data/ext/dht.c +361 -0
  26. data/ext/diff.c +166 -0
  27. data/ext/dirac.c +395 -0
  28. data/ext/eigen.c +2373 -0
  29. data/ext/error.c +194 -0
  30. data/ext/extconf.rb +281 -0
  31. data/ext/fcmp.c +66 -0
  32. data/ext/fft.c +1092 -0
  33. data/ext/fit.c +205 -0
  34. data/ext/fresnel.c +312 -0
  35. data/ext/function.c +524 -0
  36. data/ext/geometry.c +139 -0
  37. data/ext/graph.c +1638 -0
  38. data/ext/gsl.c +271 -0
  39. data/ext/gsl_narray.c +653 -0
  40. data/ext/histogram.c +1995 -0
  41. data/ext/histogram2d.c +1068 -0
  42. data/ext/histogram3d.c +884 -0
  43. data/ext/histogram3d_source.c +750 -0
  44. data/ext/histogram_find.c +101 -0
  45. data/ext/histogram_oper.c +159 -0
  46. data/ext/ieee.c +98 -0
  47. data/ext/integration.c +1138 -0
  48. data/ext/interp.c +512 -0
  49. data/ext/jacobi.c +739 -0
  50. data/ext/linalg.c +4047 -0
  51. data/ext/linalg_complex.c +741 -0
  52. data/ext/math.c +725 -0
  53. data/ext/matrix.c +39 -0
  54. data/ext/matrix_complex.c +1732 -0
  55. data/ext/matrix_double.c +560 -0
  56. data/ext/matrix_int.c +256 -0
  57. data/ext/matrix_source.c +2733 -0
  58. data/ext/min.c +250 -0
  59. data/ext/monte.c +992 -0
  60. data/ext/multifit.c +1879 -0
  61. data/ext/multimin.c +808 -0
  62. data/ext/multimin_fsdf.c +156 -0
  63. data/ext/multiroots.c +955 -0
  64. data/ext/ndlinear.c +321 -0
  65. data/ext/nmf.c +167 -0
  66. data/ext/nmf_wrap.c +72 -0
  67. data/ext/ntuple.c +469 -0
  68. data/ext/odeiv.c +959 -0
  69. data/ext/ool.c +879 -0
  70. data/ext/oper_complex_source.c +253 -0
  71. data/ext/permutation.c +596 -0
  72. data/ext/poly.c +42 -0
  73. data/ext/poly2.c +265 -0
  74. data/ext/poly_source.c +1885 -0
  75. data/ext/qrng.c +171 -0
  76. data/ext/randist.c +1873 -0
  77. data/ext/rational.c +480 -0
  78. data/ext/rng.c +612 -0
  79. data/ext/root.c +408 -0
  80. data/ext/sf.c +1494 -0
  81. data/ext/sf_airy.c +200 -0
  82. data/ext/sf_bessel.c +867 -0
  83. data/ext/sf_clausen.c +28 -0
  84. data/ext/sf_coulomb.c +206 -0
  85. data/ext/sf_coupling.c +118 -0
  86. data/ext/sf_dawson.c +29 -0
  87. data/ext/sf_debye.c +157 -0
  88. data/ext/sf_dilog.c +42 -0
  89. data/ext/sf_elementary.c +44 -0
  90. data/ext/sf_ellint.c +206 -0
  91. data/ext/sf_elljac.c +29 -0
  92. data/ext/sf_erfc.c +93 -0
  93. data/ext/sf_exp.c +164 -0
  94. data/ext/sf_expint.c +211 -0
  95. data/ext/sf_fermi_dirac.c +148 -0
  96. data/ext/sf_gamma.c +344 -0
  97. data/ext/sf_gegenbauer.c +96 -0
  98. data/ext/sf_hyperg.c +197 -0
  99. data/ext/sf_laguerre.c +112 -0
  100. data/ext/sf_lambert.c +47 -0
  101. data/ext/sf_legendre.c +367 -0
  102. data/ext/sf_log.c +104 -0
  103. data/ext/sf_mathieu.c +238 -0
  104. data/ext/sf_power.c +46 -0
  105. data/ext/sf_psi.c +98 -0
  106. data/ext/sf_synchrotron.c +48 -0
  107. data/ext/sf_transport.c +76 -0
  108. data/ext/sf_trigonometric.c +207 -0
  109. data/ext/sf_zeta.c +119 -0
  110. data/ext/signal.c +310 -0
  111. data/ext/siman.c +718 -0
  112. data/ext/sort.c +208 -0
  113. data/ext/spline.c +395 -0
  114. data/ext/stats.c +799 -0
  115. data/ext/sum.c +168 -0
  116. data/ext/tamu_anova.c +56 -0
  117. data/ext/tensor.c +38 -0
  118. data/ext/tensor_source.c +1123 -0
  119. data/ext/vector.c +38 -0
  120. data/ext/vector_complex.c +2236 -0
  121. data/ext/vector_double.c +1433 -0
  122. data/ext/vector_int.c +204 -0
  123. data/ext/vector_source.c +3329 -0
  124. data/ext/wavelet.c +937 -0
  125. data/include/rb_gsl.h +151 -0
  126. data/include/rb_gsl_array.h +238 -0
  127. data/include/rb_gsl_cheb.h +21 -0
  128. data/include/rb_gsl_common.h +343 -0
  129. data/include/rb_gsl_complex.h +25 -0
  130. data/include/rb_gsl_const.h +29 -0
  131. data/include/rb_gsl_dirac.h +13 -0
  132. data/include/rb_gsl_eigen.h +17 -0
  133. data/include/rb_gsl_fft.h +62 -0
  134. data/include/rb_gsl_fit.h +25 -0
  135. data/include/rb_gsl_function.h +27 -0
  136. data/include/rb_gsl_graph.h +70 -0
  137. data/include/rb_gsl_histogram.h +63 -0
  138. data/include/rb_gsl_histogram3d.h +97 -0
  139. data/include/rb_gsl_integration.h +17 -0
  140. data/include/rb_gsl_interp.h +46 -0
  141. data/include/rb_gsl_linalg.h +25 -0
  142. data/include/rb_gsl_math.h +26 -0
  143. data/include/rb_gsl_odeiv.h +21 -0
  144. data/include/rb_gsl_poly.h +71 -0
  145. data/include/rb_gsl_rational.h +37 -0
  146. data/include/rb_gsl_rng.h +21 -0
  147. data/include/rb_gsl_root.h +22 -0
  148. data/include/rb_gsl_sf.h +119 -0
  149. data/include/rb_gsl_statistics.h +17 -0
  150. data/include/rb_gsl_tensor.h +45 -0
  151. data/include/rb_gsl_with_narray.h +22 -0
  152. data/include/templates_off.h +87 -0
  153. data/include/templates_on.h +241 -0
  154. data/lib/gsl/gnuplot.rb +41 -0
  155. data/lib/gsl/oper.rb +68 -0
  156. data/lib/ool.rb +22 -0
  157. data/lib/ool/conmin.rb +30 -0
  158. metadata +224 -0
@@ -0,0 +1,4047 @@
1
+ /*
2
+ linalg.c
3
+ Ruby/GSL: Ruby extension library for GSL (GNU Scientific Library)
4
+ (C) Copyright 2001-2006 by Yoshiki Tsunesada
5
+
6
+ Ruby/GSL is free software: you can redistribute it and/or modify it
7
+ under the terms of the GNU General Public License.
8
+ This library is distributed in the hope that it will be useful, but
9
+ WITHOUT ANY WARRANTY.
10
+ */
11
+
12
+ #include "rb_gsl_config.h"
13
+ #include <gsl/gsl_math.h>
14
+ #include "rb_gsl_array.h"
15
+ #include "rb_gsl_common.h"
16
+ #include "rb_gsl_linalg.h"
17
+
18
+ static VALUE cgsl_matrix_LU;
19
+ static VALUE cgsl_matrix_QR;
20
+ static VALUE cgsl_matrix_QRPT;
21
+ static VALUE cgsl_vector_tau;
22
+ static VALUE cgsl_matrix_Q;
23
+ static VALUE cgsl_matrix_R;
24
+
25
+ static VALUE cgsl_matrix_LQ;
26
+ static VALUE cgsl_matrix_PTLQ;
27
+ static VALUE cgsl_matrix_L;
28
+
29
+ static VALUE cgsl_matrix_SV;
30
+ static VALUE cgsl_matrix_U;
31
+ static VALUE cgsl_matrix_V;
32
+ static VALUE cgsl_vector_S;
33
+ static VALUE cgsl_matrix_C;
34
+
35
+ enum {
36
+ LINALG_DECOMP,
37
+ LINALG_DECOMP_BANG,
38
+ };
39
+
40
+ #ifdef HAVE_NARRAY_H
41
+ static VALUE rb_gsl_linalg_LU_decomp_narray(int argc, VALUE *argv, VALUE obj,
42
+ int flag);
43
+ #endif
44
+
45
+ static VALUE rb_gsl_linalg_LU_decomposition(int argc, VALUE *argv, VALUE obj, int flag)
46
+ {
47
+ gsl_matrix *mtmp = NULL, *m = NULL;
48
+ gsl_permutation *p = NULL;
49
+ int signum, itmp;
50
+ size_t size;
51
+ VALUE objp, objm, omatrix;
52
+ switch (TYPE(obj)) {
53
+ case T_MODULE: case T_CLASS: case T_OBJECT:
54
+ #ifdef HAVE_NARRAY_H
55
+ if (NA_IsNArray(argv[0]))
56
+ return rb_gsl_linalg_LU_decomp_narray(argc, argv, obj, flag);
57
+ #endif
58
+ if (MATRIX_COMPLEX_P(argv[0]))
59
+ return rb_gsl_linalg_complex_LU_decomp2(argc, argv, obj);
60
+ omatrix = argv[0];
61
+ itmp = 1;
62
+ break;
63
+ default:
64
+ if (MATRIX_COMPLEX_P(obj))
65
+ return rb_gsl_linalg_complex_LU_decomp2(argc, argv, obj);
66
+ omatrix = obj;
67
+ itmp = 0;
68
+ break;
69
+ }
70
+ CHECK_MATRIX(omatrix);
71
+ Data_Get_Struct(omatrix, gsl_matrix, mtmp);
72
+ if (flag == LINALG_DECOMP_BANG) {
73
+ m = mtmp;
74
+ RBASIC(omatrix)->klass = cgsl_matrix_LU;
75
+ objm = omatrix;
76
+ } else {
77
+ m = make_matrix_clone(mtmp);
78
+ objm = Data_Wrap_Struct(cgsl_matrix_LU, 0, gsl_matrix_free, m);
79
+ }
80
+ size = m->size1;
81
+ switch (argc-itmp) {
82
+ case 0:
83
+ p = gsl_permutation_alloc(size);
84
+ gsl_linalg_LU_decomp(m, p, &signum);
85
+ objp = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
86
+ if (flag == LINALG_DECOMP_BANG) return rb_ary_new3(2, objp, INT2FIX(signum));
87
+ else return rb_ary_new3(3, objm, objp, INT2FIX(signum));
88
+ break;
89
+ case 1:
90
+ CHECK_PERMUTATION(argv[itmp]);
91
+ Data_Get_Struct(argv[itmp], gsl_permutation, p);
92
+ gsl_linalg_LU_decomp(m, p, &signum);
93
+ if (flag == LINALG_DECOMP_BANG) return INT2FIX(signum);
94
+ else return rb_ary_new3(2, objm, INT2FIX(signum));
95
+ break;
96
+ default:
97
+ rb_raise(rb_eArgError, "Usage: LU_decomp() or LU_decomp(permutation)");
98
+ break;
99
+ }
100
+ return Qnil; /* never reach here */
101
+ }
102
+
103
+ static VALUE rb_gsl_linalg_LU_decomp(int argc, VALUE *argv, VALUE obj)
104
+ {
105
+ return rb_gsl_linalg_LU_decomposition(argc, argv, obj, LINALG_DECOMP);
106
+ }
107
+
108
+ static VALUE rb_gsl_linalg_LU_decomp_bang(int argc, VALUE *argv, VALUE obj)
109
+ {
110
+ return rb_gsl_linalg_LU_decomposition(argc, argv, obj, LINALG_DECOMP_BANG);
111
+ }
112
+
113
+ #ifdef HAVE_NARRAY_H
114
+ static VALUE rb_gsl_linalg_LU_decomp_narray(int argc, VALUE *argv, VALUE obj,
115
+ int flag)
116
+ {
117
+ struct NARRAY *na, *na2;
118
+ VALUE m;
119
+ gsl_matrix_view mv;
120
+ gsl_permutation *p;
121
+ int signum;
122
+
123
+ if (argc != 1)
124
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc);
125
+ GetNArray(argv[0], na);
126
+ if (na->rank < 2) rb_raise(rb_eRuntimeError, "rank >= 2 required");
127
+ if (na->shape[0] != na->shape[1])
128
+ rb_raise(rb_eRuntimeError, "square matrix required");
129
+ if (flag == LINALG_DECOMP) {
130
+ m = na_make_object(NA_DFLOAT, 2, na->shape, CLASS_OF(argv[0]));
131
+ GetNArray(m, na2);
132
+ memcpy((double*)na2->ptr, (double*)na->ptr, sizeof(double)*na2->total);
133
+ mv = gsl_matrix_view_array((double*)na2->ptr, na->shape[1], na->shape[0]);
134
+ } else {
135
+ mv = gsl_matrix_view_array((double*)na->ptr, na->shape[1], na->shape[0]);
136
+ }
137
+ p = gsl_permutation_alloc(mv.matrix.size1);
138
+ gsl_linalg_LU_decomp(&mv.matrix, p, &signum);
139
+ if (flag == LINALG_DECOMP) {
140
+ return rb_ary_new3(3, m,
141
+ Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p),
142
+ INT2FIX(signum));
143
+ } else {
144
+ return rb_ary_new3(3, argv[0],
145
+ Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p),
146
+ INT2FIX(signum));
147
+ }
148
+
149
+ }
150
+ #endif
151
+
152
+ static gsl_matrix* get_matrix(VALUE obj, VALUE klass,int *flagm);
153
+ static gsl_permutation* get_permutation(VALUE obj, size_t size, int *flagp);
154
+ static gsl_vector* get_vector2(VALUE obj, int *flagv);
155
+
156
+ static gsl_matrix* get_matrix(VALUE obj, VALUE klass, int *flagm)
157
+ {
158
+ gsl_matrix *mtmp = NULL, *m = NULL;
159
+ #ifdef HAVE_NARRAY_H
160
+ gsl_matrix_view mv;
161
+ struct NARRAY *na;
162
+ #endif
163
+ if (CLASS_OF(obj) == klass) {
164
+ Data_Get_Struct(obj, gsl_matrix, m);
165
+ *flagm = 0;
166
+ #ifdef HAVE_NARRAY_H
167
+ } else if (NA_IsNArray(obj)) {
168
+ GetNArray(obj, na);
169
+ mv = gsl_matrix_view_array((double*)na->ptr, na->shape[1], na->shape[0]);
170
+ m = &mv.matrix;
171
+ *flagm = -1;
172
+ #endif
173
+ } else {
174
+ CHECK_MATRIX(obj);
175
+ Data_Get_Struct(obj, gsl_matrix, mtmp);
176
+ m = make_matrix_clone(mtmp);
177
+ *flagm = 1;
178
+ }
179
+ return m;
180
+ }
181
+
182
+ static gsl_permutation* get_permutation(VALUE obj, size_t size, int *flagp)
183
+ {
184
+ gsl_permutation *p = NULL;
185
+ if (CLASS_OF(obj) == cgsl_permutation) {
186
+ Data_Get_Struct(obj, gsl_permutation, p);
187
+ *flagp = 0;
188
+ } else {
189
+ p = gsl_permutation_alloc(size);
190
+ *flagp = 1;
191
+ }
192
+ return p;
193
+ }
194
+
195
+ static gsl_vector* get_vector2(VALUE obj, int *flagv)
196
+ {
197
+ gsl_vector *v = NULL;
198
+ #ifdef HAVE_NARRAY_H
199
+ gsl_vector_view vv;
200
+ struct NARRAY *na;
201
+ #endif
202
+ if (TYPE(obj) == T_ARRAY) {
203
+ v = make_cvector_from_rarray(obj);
204
+ *flagv = 1;
205
+ #ifdef HAVE_NARRAY_H
206
+ } else if (NA_IsNArray(obj)) {
207
+ GetNArray(obj, na);
208
+ vv = gsl_vector_view_array((double*) na->ptr, na->total);
209
+ v = &vv.vector;
210
+ *flagv = -1;
211
+ #endif
212
+ } else {
213
+ CHECK_VECTOR(obj);
214
+ Data_Get_Struct(obj, gsl_vector, v);
215
+ *flagv = 0;
216
+ }
217
+ return v;
218
+ }
219
+
220
+ #ifdef HAVE_NARRAY_H
221
+ static VALUE rb_gsl_linalg_LU_solve_narray(int argc, VALUE *argv, VALUE obj);
222
+ #endif
223
+
224
+ VALUE rb_gsl_linalg_LU_solve(int argc, VALUE *argv, VALUE obj)
225
+ {
226
+ gsl_matrix *m = NULL;
227
+ gsl_permutation *p = NULL;
228
+ gsl_vector *b = NULL, *x = NULL;
229
+ int signum, flagm = 0, flagp = 0, flagb = 0, flagx = 0, itmp;
230
+ size_t size;
231
+ VALUE bb;
232
+ switch (TYPE(obj)) {
233
+ case T_MODULE: case T_CLASS: case T_OBJECT:
234
+ if (argc < 2 || argc > 4)
235
+ rb_raise(rb_eArgError, "Usage: solve(m, b), solve(m, b, x), solve(lu, p, b), solve(lu, p, b, x)");
236
+ #ifdef HAVE_NARRAY_H
237
+ if (NA_IsNArray(argv[0]))
238
+ return rb_gsl_linalg_LU_solve_narray(argc, argv, obj);
239
+ #endif
240
+ m = get_matrix(argv[0], cgsl_matrix_LU, &flagm);
241
+ itmp = 1;
242
+ break;
243
+ default:
244
+ if (argc < 1 || argc > 3)
245
+ rb_raise(rb_eArgError, "Usage: LU_solve(b), LU_solve(p, b), LU_solve(b, x), solve(p, b, x)");
246
+
247
+ m = get_matrix(obj, cgsl_matrix_LU, &flagm);
248
+ itmp = 0;
249
+ break;
250
+ }
251
+ size = m->size1;
252
+
253
+ p = get_permutation(argv[itmp], size, &flagp);
254
+ if (flagp == 1 && flagm == 0) rb_raise(rb_eArgError, "permutation must be given");
255
+ if (flagp == 0) itmp++;
256
+
257
+ bb = argv[itmp];
258
+ b = get_vector2(argv[itmp], &flagb);
259
+ itmp++;
260
+
261
+ if (itmp == argc) {
262
+ x = gsl_vector_alloc(size);
263
+ flagx = 1;
264
+ } else {
265
+ CHECK_VECTOR(argv[itmp]);
266
+ Data_Get_Struct(argv[itmp], gsl_vector, x);
267
+ }
268
+ if (flagm == 1) gsl_linalg_LU_decomp(m, p, &signum);
269
+ gsl_linalg_LU_solve(m, p, b, x);
270
+ if (flagm == 1) gsl_matrix_free(m);
271
+ if (flagp == 1) gsl_permutation_free(p);
272
+ if (flagb == 1) gsl_vector_free(b);
273
+ if (flagx == 1) return Data_Wrap_Struct(VECTOR_ROW_COL(bb), 0, gsl_vector_free, x);
274
+ else return argv[argc-1];
275
+ }
276
+
277
+ #ifdef HAVE_NARRAY_H
278
+ static VALUE rb_gsl_linalg_LU_solve_narray(int argc, VALUE *argv, VALUE obj)
279
+ {
280
+ struct NARRAY *na, *b;
281
+ VALUE ret;
282
+ gsl_permutation *p;
283
+ gsl_matrix_view mv;
284
+ gsl_vector_view bv, xv;
285
+ double *x;
286
+ int shape[1];
287
+ if (argc < 3)
288
+ rb_raise(rb_eArgError,
289
+ "wrong number of arguments %d(NArray, GSL::Permutation and NArray expected",
290
+ argc);
291
+ GetNArray(argv[0], na);
292
+ mv = gsl_matrix_view_array((double*) na->ptr, na->shape[1], na->shape[0]);
293
+ CHECK_PERMUTATION(argv[1]);
294
+ Data_Get_Struct(argv[1], gsl_permutation, p);
295
+ GetNArray(argv[2], b);
296
+ bv = gsl_vector_view_array((double*) b->ptr, b->total);
297
+ if (argc == 3) {
298
+ shape[0] = b->total;
299
+ ret = na_make_object(NA_DFLOAT, 1, shape, CLASS_OF(argv[0]));
300
+ } else {
301
+ ret = argv[3];
302
+ }
303
+ x = NA_PTR_TYPE(ret,double*);
304
+ xv = gsl_vector_view_array(x, b->total);
305
+ gsl_linalg_LU_solve(&mv.matrix, p, &bv.vector, &xv.vector);
306
+ return ret;
307
+ }
308
+ #endif
309
+
310
+ #ifdef HAVE_NARRAY_H
311
+ static VALUE rb_gsl_linalg_LU_svx_narray(int argc, VALUE *argv, VALUE obj);
312
+ #endif
313
+
314
+ /* bb must be Vector, it is replaced by the root of the system */
315
+ static VALUE rb_gsl_linalg_LU_svx(int argc, VALUE *argv, VALUE obj)
316
+ {
317
+ gsl_matrix *m = NULL;
318
+ gsl_permutation *p = NULL;
319
+ gsl_vector *b = NULL;
320
+ int signum, flagm = 0, flagp = 0, flagb = 0, itmp;
321
+ size_t size;
322
+
323
+ switch (TYPE(obj)) {
324
+ case T_MODULE: case T_CLASS: case T_OBJECT:
325
+ if (argc < 2 || argc > 3)
326
+ rb_raise(rb_eArgError, "Usage: svx(m, b), svx(lu, p, b)");
327
+ #ifdef HAVE_NARRAY_H
328
+ if (NA_IsNArray(argv[0]))
329
+ return rb_gsl_linalg_LU_svx_narray(argc, argv, obj);
330
+ #endif
331
+ m = get_matrix(argv[0], cgsl_matrix_LU, &flagm);
332
+ itmp = 1;
333
+ break;
334
+ default:
335
+ if (argc < 1 || argc > 2)
336
+ rb_raise(rb_eArgError, "Usage: LU_svx(b), LU_svx(p, b)");
337
+ m = get_matrix(obj, cgsl_matrix_LU, &flagm);
338
+ itmp = 0;
339
+ break;
340
+ }
341
+ size = m->size1;
342
+ p = get_permutation(argv[itmp], size, &flagp);
343
+ if (flagp == 1 && flagm == 0) rb_raise(rb_eArgError, "permutation must be given");
344
+ if (flagp == 0) itmp++;
345
+ CHECK_VECTOR(argv[itmp]);
346
+ b = get_vector2(argv[itmp], &flagb);
347
+ if (flagm == 1) gsl_linalg_LU_decomp(m, p, &signum);
348
+ gsl_linalg_LU_svx(m, p, b);
349
+ if (flagm == 1) gsl_matrix_free(m);
350
+ if (flagp == 1) gsl_permutation_free(p);
351
+ return argv[itmp];
352
+ }
353
+
354
+ #ifdef HAVE_NARRAY_H
355
+ static VALUE rb_gsl_linalg_LU_svx_narray(int argc, VALUE *argv, VALUE obj)
356
+ {
357
+ struct NARRAY *na, *b;
358
+ gsl_permutation *p;
359
+ gsl_matrix_view mv;
360
+ gsl_vector_view bv;
361
+ if (argc != 3)
362
+ rb_raise(rb_eArgError,
363
+ "wrong number of arguments %d(NArray, GSL::Permutation and NArray expected",
364
+ argc);
365
+ GetNArray(argv[0], na);
366
+ mv = gsl_matrix_view_array((double*) na->ptr, na->shape[1], na->shape[0]);
367
+ CHECK_PERMUTATION(argv[1]);
368
+ Data_Get_Struct(argv[1], gsl_permutation, p);
369
+ GetNArray(argv[2], b);
370
+ bv = gsl_vector_view_array((double*) b->ptr, b->total);
371
+ gsl_linalg_LU_svx(&mv.matrix, p, &bv.vector);
372
+ return argv[2];
373
+ }
374
+ #endif
375
+
376
+ /* singleton */
377
+ static VALUE rb_gsl_linalg_LU_refine(VALUE obj, VALUE vm,
378
+ VALUE lu, VALUE pp, VALUE bb,
379
+ VALUE xx)
380
+ {
381
+ gsl_matrix *m = NULL, *mlu = NULL;
382
+ gsl_permutation *p = NULL;
383
+ gsl_vector *b = NULL, *x = NULL, *r = NULL;
384
+ int flagb = 0;
385
+ VALUE vr;
386
+ CHECK_MATRIX(vm); CHECK_MATRIX(lu);
387
+ CHECK_PERMUTATION(pp); CHECK_VECTOR(xx);
388
+ Data_Get_Struct(vm, gsl_matrix, m);
389
+ Data_Get_Struct(lu, gsl_matrix, mlu);
390
+ Data_Get_Struct(pp, gsl_permutation, p);
391
+ if (TYPE(bb) == T_ARRAY) {
392
+ b = make_cvector_from_rarray(bb);
393
+ flagb = 1;
394
+ } else {
395
+ CHECK_VECTOR(bb);
396
+ Data_Get_Struct(bb, gsl_vector, b);
397
+ }
398
+ Data_Get_Struct(xx, gsl_vector, x);
399
+ r = gsl_vector_alloc(m->size1);
400
+ gsl_linalg_LU_refine(m, mlu, p, b, x, r);
401
+ vr = Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, r);
402
+ if (flagb == 1) gsl_vector_free(b);
403
+ return rb_ary_new3(2, xx, vr);
404
+ }
405
+
406
+ #ifdef HAVE_NARRAY_H
407
+ static VALUE rb_gsl_linalg_LU_invert_narray(int argc, VALUE *argv, VALUE obj);
408
+ #endif
409
+
410
+ static VALUE rb_gsl_linalg_LU_invert(int argc, VALUE *argv, VALUE obj)
411
+ {
412
+ gsl_matrix *m = NULL, *inverse = NULL;
413
+ gsl_permutation *p = NULL;
414
+ int signum, flagm = 0, flagp = 0, itmp;
415
+ size_t size;
416
+ switch (TYPE(obj)) {
417
+ case T_MODULE: case T_CLASS: case T_OBJECT:
418
+ #ifdef HAVE_NARRAY_H
419
+ if (NA_IsNArray(argv[0]))
420
+ return rb_gsl_linalg_LU_invert_narray(argc, argv, obj);
421
+ #endif
422
+ m = get_matrix(argv[0], cgsl_matrix_LU, &flagm);
423
+ itmp = 1;
424
+ break;
425
+ default:
426
+ m = get_matrix(obj, cgsl_matrix_LU, &flagm);
427
+ itmp = 0;
428
+ }
429
+ size = m->size1;
430
+
431
+ if (argc == itmp) {
432
+ p = gsl_permutation_alloc(size);
433
+ flagp = 1;
434
+ } else {
435
+ CHECK_PERMUTATION(argv[itmp]);
436
+ p = get_permutation(argv[itmp], size, &flagp);
437
+ }
438
+ if (flagp == 1 && flagm == 0) rb_raise(rb_eArgError, "permutation must be given");
439
+ if (flagp == 0) itmp++;
440
+
441
+ if (flagm == 1 || flagp == 1) {
442
+ gsl_linalg_LU_decomp(m, p, &signum);
443
+ }
444
+
445
+ if (argc-1 == itmp) {
446
+ CHECK_MATRIX(argv[itmp]);
447
+ Data_Get_Struct(argv[itmp], gsl_matrix, inverse);
448
+ } else {
449
+ inverse = gsl_matrix_alloc(size, size);
450
+ }
451
+ gsl_linalg_LU_invert(m, p, inverse);
452
+ if (flagm == 1) gsl_matrix_free(m);
453
+ if (flagp == 1) gsl_permutation_free(p);
454
+ if (argc-1 == itmp) return argv[itmp];
455
+ else return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, inverse);
456
+
457
+ }
458
+
459
+ #ifdef HAVE_NARRAY_H
460
+ static VALUE rb_gsl_linalg_LU_invert_narray(int argc, VALUE *argv, VALUE obj)
461
+ {
462
+ struct NARRAY *na;
463
+ VALUE inv;
464
+ gsl_permutation *p;
465
+ gsl_matrix_view mv1, mv2;
466
+ if (argc != 2) {
467
+ rb_raise(rb_eArgError, "Usage: LU.invert(lu, perm)");
468
+ }
469
+ CHECK_PERMUTATION(argv[1]);
470
+ GetNArray(argv[0], na);
471
+ inv = na_make_object(NA_DFLOAT, 2, na->shape, CLASS_OF(argv[0]));
472
+ mv1 = gsl_matrix_view_array((double*)na->ptr, na->shape[1], na->shape[0]);
473
+ mv2 = gsl_matrix_view_array(NA_PTR_TYPE(inv, double*), na->shape[1], na->shape[0]);
474
+ CHECK_PERMUTATION(argv[1]);
475
+ Data_Get_Struct(argv[1], gsl_permutation, p);
476
+ gsl_linalg_LU_invert(&mv1.matrix, p, &mv2.matrix);
477
+ return inv;
478
+ }
479
+ static VALUE rb_gsl_linalg_LU_det_narray(int argc, VALUE *argv, VALUE obj)
480
+ {
481
+ struct NARRAY *na;
482
+ gsl_matrix_view mv;
483
+ int signum = 1;
484
+ switch (argc) {
485
+ case 2:
486
+ signum = FIX2INT(argv[1]);
487
+ /* no break */
488
+ case 1:
489
+ GetNArray(argv[0], na);
490
+ mv = gsl_matrix_view_array((double*)na->ptr, na->shape[1], na->shape[0]);
491
+ break;
492
+ default:
493
+ rb_raise(rb_eArgError, "Usage: LU.det(lu, perm)");
494
+ break;
495
+ }
496
+ return rb_float_new(gsl_linalg_LU_det(&mv.matrix, signum));
497
+ }
498
+ static VALUE rb_gsl_linalg_LU_lndet_narray(int argc, VALUE *argv, VALUE obj)
499
+ {
500
+ struct NARRAY *na;
501
+ gsl_matrix_view mv;
502
+ switch (argc) {
503
+ case 1:
504
+ GetNArray(argv[0], na);
505
+ mv = gsl_matrix_view_array((double*)na->ptr, na->shape[1], na->shape[0]);
506
+ break;
507
+ default:
508
+ rb_raise(rb_eArgError, "Usage: LU.lndet(lu)");
509
+ break;
510
+ }
511
+ return rb_float_new(gsl_linalg_LU_lndet(&mv.matrix));
512
+ }
513
+
514
+ #endif
515
+
516
+ static VALUE rb_gsl_linalg_LU_det(int argc, VALUE *argv, VALUE obj)
517
+ {
518
+ gsl_matrix *m = NULL;
519
+ gsl_permutation *p = NULL;
520
+ int flagm = 0, flagp = 0, itmp, sign;
521
+ size_t size;
522
+ double det;
523
+ switch (TYPE(obj)) {
524
+ case T_MODULE: case T_CLASS: case T_OBJECT:
525
+ if (argc < 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
526
+ argc);
527
+ #ifdef HAVE_NARRAY_H
528
+ if (NA_IsNArray(argv[0]))
529
+ return rb_gsl_linalg_LU_det_narray(argc, argv, obj);
530
+ #endif
531
+
532
+ m = get_matrix(argv[0], cgsl_matrix_LU, &flagm);
533
+ itmp = 1;
534
+ break;
535
+ default:
536
+ m = get_matrix(obj, cgsl_matrix_LU, &flagm);
537
+ itmp = 0;
538
+ break;
539
+ }
540
+ size = m->size1;
541
+ if (flagm == 0) {
542
+ if (argc-itmp == 1) sign = FIX2INT(argv[itmp]);
543
+ else sign = 1;
544
+ } else {
545
+ if (argc-itmp >= 2) {
546
+ get_permutation(argv[itmp], size, &flagp);
547
+ } else {
548
+ p = gsl_permutation_alloc(size);
549
+ flagp = 1;
550
+ }
551
+ }
552
+ if (flagm == 1) gsl_linalg_LU_decomp(m, p, &sign);
553
+ det = gsl_linalg_LU_det(m, sign);
554
+ if (flagm == 1) gsl_matrix_free(m);
555
+ if (flagp == 1) gsl_permutation_free(p);
556
+ return rb_float_new(det);
557
+ }
558
+
559
+ static VALUE rb_gsl_linalg_LU_lndet(int argc, VALUE *argv, VALUE obj)
560
+ {
561
+ gsl_matrix *m = NULL;
562
+ gsl_permutation *p = NULL;
563
+ int flagm = 0, sign;
564
+ double lndet;
565
+
566
+ switch (TYPE(obj)) {
567
+ case T_MODULE: case T_CLASS: case T_OBJECT:
568
+ if (argc < 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
569
+ argc);
570
+ #ifdef HAVE_NARRAY_H
571
+ if (NA_IsNArray(argv[0]))
572
+ return rb_gsl_linalg_LU_lndet_narray(argc, argv, obj);
573
+ #endif
574
+
575
+ m = get_matrix(argv[0], cgsl_matrix_LU, &flagm);
576
+ break;
577
+ default:
578
+ m = get_matrix(obj, cgsl_matrix_LU, &flagm);
579
+ break;
580
+ }
581
+ if (flagm == 1) {
582
+ p = gsl_permutation_alloc(m->size1);
583
+ gsl_linalg_LU_decomp(m, p, &sign);
584
+ }
585
+ lndet = gsl_linalg_LU_lndet(m);
586
+ if (flagm == 1) {
587
+ gsl_matrix_free(m);
588
+ gsl_permutation_free(p);
589
+ }
590
+ return rb_float_new(lndet);
591
+ }
592
+
593
+ static VALUE rb_gsl_linalg_LU_sgndet(int argc, VALUE *argv, VALUE obj)
594
+ {
595
+ gsl_matrix *m = NULL;
596
+ gsl_permutation *p = NULL;
597
+ int flagm = 0, sign, signdet, itmp;
598
+ switch (TYPE(obj)) {
599
+ case T_MODULE: case T_CLASS: case T_OBJECT:
600
+ m = get_matrix(argv[0], cgsl_matrix_LU, &flagm);
601
+ itmp = 1;
602
+ break;
603
+ default:
604
+ m = get_matrix(obj, cgsl_matrix_LU, &flagm);
605
+ itmp = 0;
606
+ break;
607
+ }
608
+ if (flagm == 1) {
609
+ p = gsl_permutation_alloc(m->size1);
610
+ gsl_linalg_LU_decomp(m, p, &sign);
611
+ } else {
612
+ if (argc-itmp != 1) rb_raise(rb_eArgError, "sign must be given");
613
+ sign = FIX2INT(argv[itmp]);
614
+ }
615
+ signdet = gsl_linalg_LU_sgndet(m, sign);
616
+ if (flagm == 1) {
617
+ gsl_matrix_free(m);
618
+ gsl_permutation_free(p);
619
+ }
620
+ return INT2FIX(signdet);
621
+ }
622
+
623
+ #ifdef GSL_1_6_LATER
624
+ int gsl_linalg_LQ_solve_T(const gsl_matrix*, const gsl_vector*, const gsl_vector*, gsl_vector*);
625
+ int gsl_linalg_LQ_svx_T (const gsl_matrix*, const gsl_vector*, gsl_vector*);
626
+ int gsl_linalg_LQ_lssolve_T(const gsl_matrix * LQ, const gsl_vector * tau,
627
+ const gsl_vector * b, gsl_vector * x,
628
+ gsl_vector * residual);
629
+ int
630
+ gsl_linalg_LQ_Lsolve_T (const gsl_matrix * LQ, const gsl_vector * b, gsl_vector* x);
631
+ int
632
+ gsl_linalg_LQ_Lsvx_T (const gsl_matrix * LQ, gsl_vector * x);
633
+ int
634
+ gsl_linalg_L_solve_T (const gsl_matrix * L, const gsl_vector * b, gsl_vector * x);
635
+
636
+
637
+ #endif
638
+
639
+ enum {
640
+ LINALG_QR_DECOMP,
641
+ LINALG_QR_DECOMP_BANG,
642
+ LINALG_LQ_DECOMP,
643
+ LINALG_LQ_DECOMP_BANG,
644
+ LINALG_QR_SOLVE,
645
+ LINALG_LQ_SOLVE,
646
+ LINALG_QR_QTvec,
647
+ LINALG_QR_Qvec,
648
+ LINALG_LQ_vecQ,
649
+ LINALG_LQ_vecQT,
650
+ LINALG_QR_RSOLVE,
651
+ LINALG_LQ_LSOLVE,
652
+ LINALG_QR_RSVX,
653
+ LINALG_LQ_LSVX,
654
+ LINALG_R_SOLVE,
655
+ LINALG_R_SVX,
656
+ LINALG_L_SOLVE,
657
+ LINALG_L_SVX,
658
+ LINALG_QR_UNPACK,
659
+ LINALG_LQ_UNPACK,
660
+ };
661
+
662
+ static VALUE rb_gsl_linalg_QR_LQ_decomposition(int argc, VALUE *argv, VALUE obj,
663
+ int flag)
664
+ {
665
+ gsl_matrix *m = NULL, *mtmp = NULL;
666
+ gsl_vector *tau = NULL;
667
+ int (*fdecomp)(gsl_matrix *, gsl_vector *);
668
+ int itmp, status;
669
+ size_t size;
670
+ VALUE vtau, mdecomp, omatrix;
671
+
672
+ switch (TYPE(obj)) {
673
+ case T_MODULE: case T_CLASS: case T_OBJECT:
674
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
675
+ omatrix = argv[0];
676
+ itmp = 1;
677
+ break;
678
+ default:
679
+ omatrix = obj;
680
+ itmp = 0;
681
+ break;
682
+ }
683
+ CHECK_MATRIX(omatrix);
684
+ Data_Get_Struct(omatrix, gsl_matrix, mtmp);
685
+
686
+ switch (flag) {
687
+ case LINALG_QR_DECOMP:
688
+ fdecomp = &gsl_linalg_QR_decomp;
689
+ m = make_matrix_clone(mtmp);
690
+ mdecomp = Data_Wrap_Struct(cgsl_matrix_QR, 0, gsl_matrix_free, m);
691
+ break;
692
+ case LINALG_QR_DECOMP_BANG:
693
+ fdecomp = &gsl_linalg_QR_decomp;
694
+ m = mtmp;
695
+ mdecomp = omatrix;
696
+ RBASIC(mdecomp)->klass = cgsl_matrix_QR;
697
+ break;
698
+ #ifdef GSL_1_6_LATER
699
+ case LINALG_LQ_DECOMP:
700
+ fdecomp = &gsl_linalg_LQ_decomp;
701
+ m = make_matrix_clone(mtmp);
702
+ mdecomp = Data_Wrap_Struct(cgsl_matrix_LQ, 0, gsl_matrix_free, m);
703
+ break;
704
+ case LINALG_LQ_DECOMP_BANG:
705
+ fdecomp = &gsl_linalg_LQ_decomp;
706
+ m = mtmp;
707
+ mdecomp = omatrix;
708
+ RBASIC(mdecomp)->klass = cgsl_matrix_LQ;
709
+ break;
710
+ #endif
711
+ default:
712
+ rb_raise(rb_eRuntimeError, "unknown operation");
713
+ break;
714
+ }
715
+ size = m->size1;
716
+ switch (argc - itmp) {
717
+ case 0:
718
+ tau = gsl_vector_alloc(GSL_MIN(mtmp->size1, mtmp->size2));
719
+ break;
720
+ case 1:
721
+ CHECK_VECTOR(argv[itmp]);
722
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
723
+ break;
724
+ default:
725
+ rb_raise(rb_eArgError, "wrong number of arguments");
726
+ break;
727
+ }
728
+ status = (*fdecomp)(m, tau);
729
+ switch (flag) {
730
+ case LINALG_QR_DECOMP:
731
+ case LINALG_LQ_DECOMP:
732
+ if (argc == itmp) {
733
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
734
+ return rb_ary_new3(2, mdecomp, vtau);
735
+ } else {
736
+ RBASIC(argv[itmp])->klass = cgsl_vector_tau;
737
+ return mdecomp;
738
+ }
739
+ break;
740
+ case LINALG_QR_DECOMP_BANG:
741
+ case LINALG_LQ_DECOMP_BANG:
742
+ if (argc == itmp) {
743
+ return Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
744
+ } else {
745
+ RBASIC(argv[itmp])->klass = cgsl_vector_tau;
746
+ return INT2FIX(status);
747
+ }
748
+ break;
749
+ default:
750
+ rb_raise(rb_eRuntimeError, "unknown operation");
751
+ break;
752
+ }
753
+ return Qnil;
754
+ }
755
+
756
+ #ifdef HAVE_NARRAY_H
757
+ static VALUE rb_gsl_linalg_QR_decomp_narray(int argc, VALUE *argv, VALUE obj);
758
+ #endif
759
+
760
+ static VALUE rb_gsl_linalg_QR_decomp(int argc, VALUE *argv, VALUE obj)
761
+ {
762
+ #ifdef HAVE_NARRAY_H
763
+ if (argc >= 1 && NA_IsNArray(argv[0]))
764
+ return rb_gsl_linalg_QR_decomp_narray(argc, argv, obj);
765
+ #endif
766
+ return rb_gsl_linalg_QR_LQ_decomposition(argc, argv, obj, LINALG_QR_DECOMP);
767
+ }
768
+
769
+ static VALUE rb_gsl_linalg_QR_decomp_bang(int argc, VALUE *argv, VALUE obj)
770
+ {
771
+ return rb_gsl_linalg_QR_LQ_decomposition(argc, argv, obj, LINALG_QR_DECOMP_BANG);
772
+ }
773
+
774
+ #ifdef GSL_1_6_LATER
775
+ static VALUE rb_gsl_linalg_LQ_decomp(int argc, VALUE *argv, VALUE obj)
776
+ {
777
+ return rb_gsl_linalg_QR_LQ_decomposition(argc, argv, obj, LINALG_LQ_DECOMP);
778
+ }
779
+
780
+ static VALUE rb_gsl_linalg_LQ_decomp_bang(int argc, VALUE *argv, VALUE obj)
781
+ {
782
+ return rb_gsl_linalg_QR_LQ_decomposition(argc, argv, obj, LINALG_LQ_DECOMP_BANG);
783
+ }
784
+ #endif
785
+
786
+ static VALUE rb_gsl_linalg_QR_LQ_solve(int argc, VALUE *argv, VALUE obj, int flag)
787
+ {
788
+ gsl_matrix *m = NULL;
789
+ gsl_vector *b = NULL, *x = NULL, *tau = NULL;
790
+ VALUE omatrix;
791
+ int flagm = 0, flagt = 0, flagb = 0, flagx = 0, itmp;
792
+ size_t size;
793
+ int (*fdecomp)(gsl_matrix*, gsl_vector*);
794
+ int (*fsolve)(const gsl_matrix*, const gsl_vector*, const gsl_vector*, gsl_vector*);
795
+
796
+ switch (TYPE(obj)) {
797
+ case T_MODULE: case T_CLASS: case T_OBJECT:
798
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
799
+ omatrix = argv[0];
800
+ itmp = 1;
801
+ break;
802
+ default:
803
+ omatrix = obj;
804
+ itmp = 0;
805
+ break;
806
+ }
807
+ if (argc-itmp < 1 || argc-itmp > 3)
808
+ rb_raise(rb_eArgError, "wrong number of arguments");
809
+ CHECK_MATRIX(omatrix);
810
+ switch (flag) {
811
+ case LINALG_QR_SOLVE:
812
+ m = get_matrix(omatrix, cgsl_matrix_QR, &flagm);
813
+ fdecomp = &gsl_linalg_QR_decomp;
814
+ fsolve = &gsl_linalg_QR_solve;
815
+ break;
816
+ #ifdef GSL_1_6_LATER
817
+ case LINALG_LQ_SOLVE:
818
+ m = get_matrix(omatrix, cgsl_matrix_LQ, &flagm);
819
+ fdecomp = &gsl_linalg_LQ_decomp;
820
+ fsolve = &gsl_linalg_LQ_solve_T;
821
+ break;
822
+ #endif
823
+ default:
824
+ rb_raise(rb_eRuntimeError, "unknown operatioin");
825
+ break;
826
+ }
827
+ size = m->size1;
828
+ if (flagm == 0) { /* the matrix given is already decomped */
829
+ if (CLASS_OF(argv[itmp]) != cgsl_vector_tau)
830
+ rb_raise(rb_eArgError, "tau vector must be given");
831
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
832
+ flagt = 0;
833
+ itmp++;
834
+ } else {
835
+ if (CLASS_OF(argv[itmp]) == cgsl_vector_tau) {
836
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
837
+ flagt = 0;
838
+ itmp++;
839
+ } else {
840
+ tau = gsl_vector_alloc(size);
841
+ flagt = 1;
842
+ }
843
+ }
844
+ b = get_vector2(argv[itmp], &flagb);
845
+ itmp++;
846
+ if (itmp == argc) {
847
+ x = gsl_vector_alloc(m->size1);
848
+ flagx = 1;
849
+ } else {
850
+ CHECK_VECTOR(argv[itmp]);
851
+ Data_Get_Struct(argv[itmp], gsl_vector, x);
852
+ flagx = 0;
853
+ }
854
+ if (flagm == 1) (*fdecomp)(m, tau);
855
+ (*fsolve)(m, tau, b, x);
856
+ if (flagm == 1) gsl_matrix_free(m);
857
+ if (flagt == 1) gsl_vector_free(tau);
858
+ if (flagb == 1) gsl_vector_free(b);
859
+ if (flagx == 1) return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
860
+ else return argv[itmp];
861
+ }
862
+
863
+ static VALUE rb_gsl_linalg_QR_LQ_svx(int argc, VALUE *argv, VALUE obj, int flag)
864
+ {
865
+ gsl_matrix *m = NULL;
866
+ gsl_vector *b = NULL, *tau = NULL;
867
+ VALUE omatrix;
868
+ int flagm = 0, flagt = 0, flagb = 0, itmp;
869
+ size_t size;
870
+ int (*fdecomp)(gsl_matrix*, gsl_vector*);
871
+ int (*fsvx)(const gsl_matrix*, const gsl_vector*, gsl_vector*);
872
+
873
+ switch (TYPE(obj)) {
874
+ case T_MODULE: case T_CLASS: case T_OBJECT:
875
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
876
+ omatrix = argv[0];
877
+ itmp = 1;
878
+ break;
879
+ default:
880
+ omatrix = obj;
881
+ itmp = 0;
882
+ break;
883
+ }
884
+ if (argc-itmp < 1 || argc-itmp > 2)
885
+ rb_raise(rb_eArgError, "wrong number of arguments");
886
+ CHECK_MATRIX(omatrix);
887
+ switch (flag) {
888
+ case LINALG_QR_SOLVE:
889
+ m = get_matrix(omatrix, cgsl_matrix_QR, &flagm);
890
+ fdecomp = &gsl_linalg_QR_decomp;
891
+ fsvx = &gsl_linalg_QR_svx;
892
+ break;
893
+ #ifdef GSL_1_6_LATER
894
+ case LINALG_LQ_SOLVE:
895
+ m = get_matrix(omatrix, cgsl_matrix_LQ, &flagm);
896
+ fdecomp = &gsl_linalg_LQ_decomp;
897
+ fsvx = &gsl_linalg_LQ_svx_T;
898
+ break;
899
+ #endif
900
+ default:
901
+ rb_raise(rb_eRuntimeError, "unknown operatioin");
902
+ break;
903
+ }
904
+ size = m->size1;
905
+ if (flagm == 0) { /* the matrix given is already decomped */
906
+ if (CLASS_OF(argv[itmp]) != cgsl_vector_tau)
907
+ rb_raise(rb_eArgError, "tau vector must be given");
908
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
909
+ flagt = 0;
910
+ itmp++;
911
+ } else {
912
+ if (CLASS_OF(argv[itmp]) == cgsl_vector_tau) {
913
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
914
+ flagt = 0;
915
+ itmp++;
916
+ } else {
917
+ tau = gsl_vector_alloc(size);
918
+ flagt = 1;
919
+ }
920
+ }
921
+ b = get_vector2(argv[itmp], &flagb);
922
+ if (flagm == 1 && flagt == 1) (*fdecomp)(m, tau);
923
+ (*fsvx)(m, tau, b);
924
+ if (flagm == 1) gsl_matrix_free(m);
925
+ if (flagt == 1) gsl_vector_free(tau);
926
+ return argv[itmp];
927
+ }
928
+
929
+ static VALUE rb_gsl_linalg_QR_LQ_lssolve(int argc, VALUE *argv, VALUE obj, int flag)
930
+ {
931
+ gsl_matrix *m = NULL;
932
+ gsl_vector *b = NULL, *x = NULL, *tau = NULL, *r = NULL;
933
+ VALUE omatrix;
934
+ int flagm = 0, flagt = 0, flagb = 0, flagx = 0, flagr = 0, itmp, status;
935
+ size_t size;
936
+ int (*fdecomp)(gsl_matrix*, gsl_vector*);
937
+ int (*flssolve)(const gsl_matrix*, const gsl_vector*, const gsl_vector*, gsl_vector*,
938
+ gsl_vector*);
939
+
940
+ switch (TYPE(obj)) {
941
+ case T_MODULE: case T_CLASS: case T_OBJECT:
942
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
943
+ omatrix = argv[0];
944
+ itmp = 1;
945
+ break;
946
+ default:
947
+ omatrix = obj;
948
+ itmp = 0;
949
+ break;
950
+ }
951
+ if (argc-itmp < 1 || argc-itmp > 4)
952
+ rb_raise(rb_eArgError, "wrong number of arguments");
953
+ CHECK_MATRIX(omatrix);
954
+ switch (flag) {
955
+ case LINALG_QR_SOLVE:
956
+ m = get_matrix(omatrix, cgsl_matrix_QR, &flagm);
957
+ fdecomp = &gsl_linalg_QR_decomp;
958
+ flssolve = &gsl_linalg_QR_lssolve;
959
+ break;
960
+ #ifdef GSL_1_6_LATER
961
+ case LINALG_LQ_SOLVE:
962
+ m = get_matrix(omatrix, cgsl_matrix_LQ, &flagm);
963
+ fdecomp = &gsl_linalg_LQ_decomp;
964
+ flssolve = &gsl_linalg_LQ_lssolve_T;
965
+ break;
966
+ #endif
967
+ default:
968
+ rb_raise(rb_eRuntimeError, "unknown operatioin");
969
+ break;
970
+ }
971
+ size = m->size1;
972
+ if (flagm == 0) { /* the matrix given is already decomped */
973
+ if (CLASS_OF(argv[itmp]) != cgsl_vector_tau)
974
+ rb_raise(rb_eArgError, "tau vector must be given");
975
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
976
+ flagt = 0;
977
+ itmp++;
978
+ } else {
979
+ if (CLASS_OF(argv[itmp]) == cgsl_vector_tau) {
980
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
981
+ flagt = 0;
982
+ itmp++;
983
+ } else {
984
+ tau = gsl_vector_alloc(size);
985
+ flagt = 1;
986
+ }
987
+ }
988
+ b = get_vector2(argv[itmp], &flagb);
989
+ itmp++;
990
+ switch (argc - itmp) {
991
+ case 2:
992
+ CHECK_VECTOR(argv[argc-2]);
993
+ Data_Get_Struct(argv[argc-2], gsl_vector, x);
994
+ flagx = 0;
995
+ CHECK_VECTOR(argv[argc-1]);
996
+ Data_Get_Struct(argv[argc-1], gsl_vector, r);
997
+ flagr = 0;
998
+ break;
999
+ case 1:
1000
+ CHECK_VECTOR(argv[argc-1]);
1001
+ Data_Get_Struct(argv[argc-1], gsl_vector, x);
1002
+ flagx = 0;
1003
+ r = gsl_vector_alloc(x->size);
1004
+ flagr = 1;
1005
+ break;
1006
+ case 0:
1007
+ x = gsl_vector_alloc(m->size1);
1008
+ r = gsl_vector_alloc(m->size1);
1009
+ flagx = 1; flagr = 1;
1010
+ break;
1011
+ default:
1012
+ rb_raise(rb_eArgError, "wrong number of arguments");
1013
+ break;
1014
+ }
1015
+ if (flagm == 1) (*fdecomp)(m, tau);
1016
+ status = (*flssolve)(m, tau, b, x, r);
1017
+ if (flagm == 1) gsl_matrix_free(m);
1018
+ if (flagt == 1) gsl_vector_free(tau);
1019
+ if (flagb == 1) gsl_vector_free(b);
1020
+
1021
+ switch (argc - itmp) {
1022
+ case 2:
1023
+ return INT2FIX(status);
1024
+ break;
1025
+ case 1:
1026
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, r);
1027
+ break;
1028
+ default:
1029
+ return rb_ary_new3(2, Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x),
1030
+ Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, r));
1031
+ }
1032
+ return Qnil;
1033
+ }
1034
+
1035
+ #ifdef HAVE_NARRAY_H
1036
+ static VALUE rb_gsl_linalg_QR_solve_narray(int argc, VALUE *argv, VALUE obj);
1037
+ static VALUE rb_gsl_linalg_QR_svx_narray(int argc, VALUE *argv, VALUE obj);
1038
+ #endif
1039
+
1040
+ static VALUE rb_gsl_linalg_QR_solve(int argc, VALUE *argv, VALUE obj)
1041
+ {
1042
+ #ifdef HAVE_NARRAY_H
1043
+ if (argc == 3 && NA_IsNArray(argv[0]))
1044
+ return rb_gsl_linalg_QR_solve_narray(argc, argv, obj);
1045
+ #endif
1046
+ return rb_gsl_linalg_QR_LQ_solve(argc, argv, obj, LINALG_QR_SOLVE);
1047
+ }
1048
+
1049
+ static VALUE rb_gsl_linalg_QR_svx(int argc, VALUE *argv, VALUE obj)
1050
+ {
1051
+ #ifdef HAVE_NARRAY_H
1052
+ if (argc == 2 && NA_IsNArray(argv[0]))
1053
+ return rb_gsl_linalg_QR_svx_narray(argc, argv, obj);
1054
+ #endif
1055
+ return rb_gsl_linalg_QR_LQ_svx(argc, argv, obj, LINALG_QR_SOLVE);
1056
+ }
1057
+
1058
+ static VALUE rb_gsl_linalg_QR_lssolve(int argc, VALUE *argv, VALUE obj)
1059
+ {
1060
+ return rb_gsl_linalg_QR_LQ_lssolve(argc, argv, obj, LINALG_QR_SOLVE);
1061
+ }
1062
+
1063
+ #ifdef GSL_1_6_LATER
1064
+ static VALUE rb_gsl_linalg_LQ_solve(int argc, VALUE *argv, VALUE obj)
1065
+ {
1066
+ return rb_gsl_linalg_QR_LQ_solve(argc, argv, obj, LINALG_LQ_SOLVE);
1067
+ }
1068
+
1069
+ static VALUE rb_gsl_linalg_LQ_svx(int argc, VALUE *argv, VALUE obj)
1070
+ {
1071
+ return rb_gsl_linalg_QR_LQ_svx(argc, argv, obj, LINALG_LQ_SOLVE);
1072
+ }
1073
+
1074
+ static VALUE rb_gsl_linalg_LQ_lssolve(int argc, VALUE *argv, VALUE obj)
1075
+ {
1076
+ return rb_gsl_linalg_QR_LQ_lssolve(argc, argv, obj, LINALG_LQ_SOLVE);
1077
+ }
1078
+ #endif
1079
+
1080
+ static VALUE rb_gsl_linalg_QRLQ_QTvec(int argc, VALUE *argv, VALUE obj,
1081
+ int flag)
1082
+ {
1083
+ gsl_matrix *QR = NULL;
1084
+ gsl_vector *tau = NULL, *v = NULL;
1085
+ VALUE ret;
1086
+ switch (TYPE(obj)) {
1087
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1088
+ if (argc != 3) rb_raise(rb_eArgError,
1089
+ "wrong number of arguments (%d for 3)", argc);
1090
+ CHECK_MATRIX(argv[0]); CHECK_VECTOR(argv[1]); CHECK_VECTOR(argv[2]);
1091
+ Data_Get_Struct(argv[0], gsl_matrix, QR);
1092
+ Data_Get_Struct(argv[1], gsl_vector, tau);
1093
+ Data_Get_Struct(argv[2], gsl_vector, v);
1094
+ ret = argv[2];
1095
+ break;
1096
+ default:
1097
+ if (argc != 2) rb_raise(rb_eArgError,
1098
+ "wrong number of arguments (%d for 2)", argc);
1099
+ CHECK_VECTOR(argv[2]); CHECK_VECTOR(argv[1]);
1100
+ Data_Get_Struct(obj, gsl_matrix, QR);
1101
+ Data_Get_Struct(argv[0], gsl_vector, tau);
1102
+ Data_Get_Struct(argv[1], gsl_vector, v);
1103
+ ret = argv[1];
1104
+ break;
1105
+ }
1106
+ switch (flag) {
1107
+ case LINALG_QR_QTvec:
1108
+ gsl_linalg_QR_QTvec(QR, tau, v);
1109
+ break;
1110
+ case LINALG_QR_Qvec:
1111
+ gsl_linalg_QR_Qvec(QR, tau, v);
1112
+ break;
1113
+ #ifdef GSL_1_6_LATER
1114
+ case LINALG_LQ_vecQ:
1115
+ gsl_linalg_LQ_vecQ(QR, tau, v);
1116
+ break;
1117
+ case LINALG_LQ_vecQT:
1118
+ gsl_linalg_LQ_vecQT(QR, tau, v);
1119
+ break;
1120
+ #endif
1121
+ default:
1122
+ break;
1123
+ }
1124
+ return ret;
1125
+ }
1126
+
1127
+ static VALUE rb_gsl_linalg_QR_QTvec(int argc, VALUE *argv, VALUE obj)
1128
+ {
1129
+ return rb_gsl_linalg_QRLQ_QTvec(argc, argv, obj, LINALG_QR_QTvec);
1130
+ }
1131
+
1132
+ static VALUE rb_gsl_linalg_QR_Qvec(int argc, VALUE *argv, VALUE obj)
1133
+ {
1134
+ return rb_gsl_linalg_QRLQ_QTvec(argc, argv, obj, LINALG_QR_Qvec);
1135
+ }
1136
+
1137
+ #ifdef GSL_1_6_LATER
1138
+ static VALUE rb_gsl_linalg_LQ_vecQT(int argc, VALUE *argv, VALUE obj)
1139
+ {
1140
+ return rb_gsl_linalg_QRLQ_QTvec(argc, argv, obj, LINALG_LQ_vecQT);
1141
+ }
1142
+
1143
+ static VALUE rb_gsl_linalg_LQ_vecQ(int argc, VALUE *argv, VALUE obj)
1144
+ {
1145
+ return rb_gsl_linalg_QRLQ_QTvec(argc, argv, obj, LINALG_LQ_vecQ);
1146
+ }
1147
+ #endif
1148
+
1149
+ static VALUE rb_gsl_linalg_QRLQ_unpack(int argc, VALUE *argv, VALUE obj,
1150
+ int flag)
1151
+ {
1152
+ gsl_matrix *QR = NULL, *Q = NULL, *R = NULL;
1153
+ gsl_vector *tau = NULL;
1154
+ int itmp;
1155
+ VALUE vtmp, vQ, vR, klass;
1156
+ switch (flag) {
1157
+ case LINALG_QR_UNPACK:
1158
+ klass = cgsl_matrix_QR;
1159
+ break;
1160
+ case LINALG_LQ_UNPACK:
1161
+ klass = cgsl_matrix_LQ;
1162
+ break;
1163
+ default:
1164
+ rb_raise(rb_eRuntimeError, "unknown operation");
1165
+ break;
1166
+ }
1167
+ switch (TYPE(obj)) {
1168
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1169
+ if (argc != 2) rb_raise(rb_eArgError,
1170
+ "wrong number of arguments (%d for 2)", argc);
1171
+ vtmp = argv[0];
1172
+ itmp = 1;
1173
+ break;
1174
+ default:
1175
+ if (argc != 1) rb_raise(rb_eArgError,
1176
+ "wrong number of arguments (%d for 1)", argc);
1177
+ vtmp = obj;
1178
+ itmp = 0;
1179
+ break;
1180
+ }
1181
+ CHECK_MATRIX(vtmp);
1182
+ if (CLASS_OF(vtmp) != klass) {
1183
+ rb_raise(rb_eTypeError, "not a QR matrix");
1184
+ }
1185
+ Data_Get_Struct(vtmp, gsl_matrix, QR);
1186
+ if (CLASS_OF(argv[itmp]) != cgsl_vector_tau)
1187
+ rb_raise(rb_eTypeError, "tau vector must be given.");
1188
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
1189
+ Q = gsl_matrix_alloc(QR->size1, QR->size1);
1190
+ R = gsl_matrix_alloc(QR->size1, QR->size2);
1191
+ switch (flag) {
1192
+ case LINALG_QR_UNPACK:
1193
+ gsl_linalg_QR_unpack(QR, tau, Q, R);
1194
+ vQ = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, Q);
1195
+ vR = Data_Wrap_Struct(cgsl_matrix_R, 0, gsl_matrix_free, R);
1196
+ break;
1197
+ #ifdef GSL_1_6_LATER
1198
+ case LINALG_LQ_UNPACK:
1199
+ gsl_linalg_LQ_unpack(QR, tau, Q, R);
1200
+ vQ = Data_Wrap_Struct(cgsl_matrix_L, 0, gsl_matrix_free, Q);
1201
+ vR = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, R);
1202
+ break;
1203
+ #endif
1204
+ default:
1205
+ rb_raise(rb_eRuntimeError, "unknown operation");
1206
+ break;
1207
+ }
1208
+ return rb_ary_new3(2, vQ, vR);
1209
+ }
1210
+
1211
+ #ifdef HAVE_NARRAY_H
1212
+ static VALUE rb_gsl_linalg_QR_unpack_narray(int argc, VALUE *argv, VALUE obj);
1213
+ #endif
1214
+
1215
+ static VALUE rb_gsl_linalg_QR_unpack(int argc, VALUE *argv, VALUE obj)
1216
+ {
1217
+ #ifdef HAVE_NARRAY_H
1218
+ if (argc == 2 && NA_IsNArray(argv[0]))
1219
+ return rb_gsl_linalg_QR_unpack_narray(argc, argv, obj);
1220
+ #endif
1221
+ return rb_gsl_linalg_QRLQ_unpack(argc, argv, obj, LINALG_QR_UNPACK);
1222
+ }
1223
+
1224
+ #ifdef GSL_1_6_LATER
1225
+ static VALUE rb_gsl_linalg_LQ_unpack(int argc, VALUE *argv, VALUE obj)
1226
+ {
1227
+ return rb_gsl_linalg_QRLQ_unpack(argc, argv, obj, LINALG_LQ_UNPACK);
1228
+ }
1229
+ #endif
1230
+
1231
+ /* singleton */
1232
+ static VALUE rb_gsl_linalg_QRLQ_QRLQsolve(int argc, VALUE *argv, VALUE obj,
1233
+ int flag)
1234
+ {
1235
+ gsl_matrix *Q = NULL, *R = NULL;
1236
+ gsl_vector *b = NULL, *x = NULL;
1237
+ int (*fsolve)(gsl_matrix*, gsl_matrix *, const gsl_vector*, gsl_vector *);
1238
+ int flagb = 0;
1239
+ VALUE retval;
1240
+ switch (argc) {
1241
+ case 3:
1242
+ CHECK_MATRIX(argv[0]); CHECK_MATRIX(argv[1]);
1243
+ Data_Get_Struct(argv[0], gsl_matrix, Q);
1244
+ Data_Get_Struct(argv[1], gsl_matrix, R);
1245
+ x = gsl_vector_alloc(Q->size1);
1246
+ retval = Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
1247
+ break;
1248
+ case 4:
1249
+ CHECK_MATRIX(argv[0]); CHECK_MATRIX(argv[1]);
1250
+ CHECK_VECTOR(argv[3]);
1251
+ Data_Get_Struct(argv[0], gsl_matrix, Q);
1252
+ Data_Get_Struct(argv[1], gsl_matrix, R);
1253
+ Data_Get_Struct(argv[3], gsl_vector, x);
1254
+ retval = argv[3];
1255
+ break;
1256
+ default:
1257
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 3 or 4)", argc);
1258
+ break;
1259
+ }
1260
+ switch (flag) {
1261
+ case LINALG_QR_DECOMP:
1262
+ if (CLASS_OF(argv[0]) != cgsl_matrix_Q)
1263
+ rb_raise(rb_eTypeError, "not a Q matrix");
1264
+ if (CLASS_OF(argv[1]) != cgsl_matrix_R)
1265
+ rb_raise(rb_eTypeError, "not a R matrix");
1266
+ fsolve = &gsl_linalg_QR_QRsolve;
1267
+ break;
1268
+ #ifdef GSL_1_6_LATER
1269
+ case LINALG_LQ_DECOMP:
1270
+ /* if (CLASS_OF(argv[0]) != cgsl_matrix_L)
1271
+ rb_raise(rb_eTypeError, "not a L matrix");
1272
+ if (CLASS_OF(argv[1]) != cgsl_matrix_Q)
1273
+ rb_raise(rb_eTypeError, "not a Q matrix");*/
1274
+ fsolve = &gsl_linalg_LQ_LQsolve;
1275
+ break;
1276
+ #endif
1277
+ default:
1278
+ rb_raise(rb_eRuntimeError, "unknown operation");
1279
+ break;
1280
+ }
1281
+ if (TYPE(argv[2]) == T_ARRAY) {
1282
+ b = make_cvector_from_rarray(argv[2]);
1283
+ flagb = 1;
1284
+ } else {
1285
+ CHECK_VECTOR(argv[2]);
1286
+ Data_Get_Struct(argv[2], gsl_vector, b);
1287
+ }
1288
+ (*fsolve)(Q, R, b, x);
1289
+ if (flagb == 1) gsl_vector_free(b);
1290
+ return retval;
1291
+ }
1292
+
1293
+ /*****/
1294
+ static VALUE rb_gsl_linalg_QRLQ_RLsolve(int argc, VALUE *argv, VALUE obj,
1295
+ int flag)
1296
+ {
1297
+ gsl_matrix *QR = NULL, *mtmp;
1298
+ gsl_vector *b = NULL, *x = NULL, *tau = NULL;
1299
+ size_t istart;
1300
+ int (*fsolve)(const gsl_matrix*, const gsl_vector*, gsl_vector *);
1301
+ int flagb = 0, flagq = 0;
1302
+ VALUE omatrix,retval;
1303
+ switch (TYPE(obj)) {
1304
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1305
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
1306
+ omatrix = argv[0];
1307
+ istart = 1;
1308
+ break;
1309
+ default:
1310
+ omatrix = obj;
1311
+ istart = 0;
1312
+ break;
1313
+ }
1314
+ CHECK_MATRIX(omatrix);
1315
+ Data_Get_Struct(omatrix, gsl_matrix, mtmp);
1316
+ switch (argc - istart) {
1317
+ case 1:
1318
+ x = gsl_vector_alloc(mtmp->size1);
1319
+ retval = Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
1320
+ break;
1321
+ case 2:
1322
+ Data_Get_Struct(argv[istart+1], gsl_vector, x);
1323
+ retval = argv[istart+1];
1324
+ break;
1325
+ default:
1326
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 3 or 4)", argc);
1327
+ break;
1328
+ }
1329
+ QR = mtmp; flagq = 0;
1330
+ switch (flag) {
1331
+ case LINALG_QR_RSOLVE:
1332
+ if (CLASS_OF(omatrix) != cgsl_matrix_QR) {
1333
+ QR = make_matrix_clone(mtmp);
1334
+ tau = gsl_vector_alloc(QR->size1);
1335
+ gsl_linalg_QR_decomp(QR, tau);
1336
+ flagq = 1;
1337
+ }
1338
+ fsolve = &gsl_linalg_QR_Rsolve;
1339
+ break;
1340
+ case LINALG_R_SOLVE:
1341
+ if (CLASS_OF(omatrix) != cgsl_matrix_QR) {
1342
+ QR = make_matrix_clone(mtmp);
1343
+ tau = gsl_vector_alloc(QR->size1);
1344
+ gsl_linalg_QR_decomp(QR, tau);
1345
+ flagq = 1;
1346
+ }
1347
+ fsolve = &gsl_linalg_R_solve;
1348
+ break;
1349
+ #ifdef GSL_1_6_LATER
1350
+ case LINALG_LQ_LSOLVE:
1351
+ if (CLASS_OF(omatrix) != cgsl_matrix_LQ) {
1352
+ QR = make_matrix_clone(mtmp);
1353
+ tau = gsl_vector_alloc(QR->size1);
1354
+ gsl_linalg_LQ_decomp(QR, tau);
1355
+ flagq = 1;
1356
+ }
1357
+ fsolve = &gsl_linalg_LQ_Lsolve_T;
1358
+ break;
1359
+ case LINALG_L_SOLVE:
1360
+ if (CLASS_OF(omatrix) != cgsl_matrix_LQ) {
1361
+ QR = make_matrix_clone(mtmp);
1362
+ tau = gsl_vector_alloc(QR->size1);
1363
+ gsl_linalg_LQ_decomp(QR, tau);
1364
+ flagq = 1;
1365
+ }
1366
+ fsolve = &gsl_linalg_L_solve_T;
1367
+ break;
1368
+ #endif
1369
+ default:
1370
+ rb_raise(rb_eRuntimeError, "unknown operation");
1371
+ break;
1372
+ }
1373
+ if (TYPE(argv[istart]) == T_ARRAY) {
1374
+ b = make_cvector_from_rarray(argv[istart]);
1375
+ flagb = 1;
1376
+ } else {
1377
+ CHECK_VECTOR(argv[istart]);
1378
+ Data_Get_Struct(argv[istart], gsl_vector, b);
1379
+ }
1380
+ (*fsolve)(QR, b, x);
1381
+ if (flagb == 1) gsl_vector_free(b);
1382
+ if (flagq == 1) {
1383
+ gsl_matrix_free(QR);
1384
+ gsl_vector_free(tau);
1385
+ }
1386
+ return retval;
1387
+ }
1388
+
1389
+ static VALUE rb_gsl_linalg_QRLQ_RLsvx(int argc, VALUE *argv, VALUE obj,
1390
+ int flag)
1391
+ {
1392
+ gsl_matrix *QR = NULL, *mtmp;
1393
+ gsl_vector *x = NULL, *tau = NULL;
1394
+ size_t istart;
1395
+ int (*fsolve)(const gsl_matrix*, gsl_vector *);
1396
+ int flagq = 0;
1397
+ VALUE omatrix,retval;
1398
+ switch (TYPE(obj)) {
1399
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1400
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
1401
+ omatrix = argv[0];
1402
+ istart = 1;
1403
+ break;
1404
+ default:
1405
+ omatrix = obj;
1406
+ istart = 0;
1407
+ break;
1408
+ }
1409
+ CHECK_MATRIX(omatrix);
1410
+ Data_Get_Struct(omatrix, gsl_matrix, mtmp);
1411
+ switch (argc - istart) {
1412
+ case 0:
1413
+ x = gsl_vector_alloc(mtmp->size1);
1414
+ retval = Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
1415
+ break;
1416
+ case 1:
1417
+ Data_Get_Struct(argv[istart+1], gsl_vector, x);
1418
+ retval = argv[istart+1];
1419
+ break;
1420
+ default:
1421
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 3 or 4)", argc);
1422
+ break;
1423
+ }
1424
+ QR = mtmp; flagq = 0;
1425
+ switch (flag) {
1426
+ case LINALG_QR_RSVX:
1427
+ if (CLASS_OF(omatrix) != cgsl_matrix_QR) {
1428
+ QR = make_matrix_clone(mtmp);
1429
+ tau = gsl_vector_alloc(QR->size1);
1430
+ gsl_linalg_QR_decomp(QR, tau);
1431
+ flagq = 1;
1432
+ }
1433
+ fsolve = &gsl_linalg_QR_Rsvx;
1434
+ break;
1435
+ /*
1436
+ case LINALG_R_SVX:
1437
+ if (CLASS_OF(omatrix) != cgsl_matrix_QR) {
1438
+ QR = make_matrix_clone(mtmp);
1439
+ tau = gsl_vector_alloc(QR->size1);
1440
+ gsl_linalg_QR_decomp(QR, tau);
1441
+ flagq = 1;
1442
+ }
1443
+ fsolve = &gsl_linalg_R_svx;
1444
+ break;
1445
+ */
1446
+ #ifdef GSL_1_6_LATER
1447
+ case LINALG_LQ_LSVX:
1448
+ if (CLASS_OF(omatrix) != cgsl_matrix_LQ) {
1449
+ QR = make_matrix_clone(mtmp);
1450
+ tau = gsl_vector_alloc(QR->size1);
1451
+ gsl_linalg_LQ_decomp(QR, tau);
1452
+ flagq = 1;
1453
+ }
1454
+ fsolve = &gsl_linalg_LQ_Lsvx_T;
1455
+ break;
1456
+ #endif
1457
+ default:
1458
+ rb_raise(rb_eRuntimeError, "unknown operation");
1459
+ break;
1460
+ }
1461
+ (*fsolve)(QR, x);
1462
+ if (flagq == 1) {
1463
+ gsl_matrix_free(QR);
1464
+ gsl_vector_free(tau);
1465
+ }
1466
+ return retval;
1467
+ }
1468
+
1469
+ static VALUE rb_gsl_linalg_QR_Rsolve(int argc, VALUE *argv, VALUE obj)
1470
+ {
1471
+ return rb_gsl_linalg_QRLQ_RLsolve(argc, argv, obj, LINALG_QR_RSOLVE);
1472
+ }
1473
+
1474
+ static VALUE rb_gsl_linalg_QR_Rsvx(int argc, VALUE *argv, VALUE obj)
1475
+ {
1476
+ return rb_gsl_linalg_QRLQ_RLsvx(argc, argv, obj, LINALG_QR_RSVX);
1477
+ }
1478
+
1479
+ static VALUE rb_gsl_linalg_R_solve(int argc, VALUE *argv, VALUE obj)
1480
+ {
1481
+ return rb_gsl_linalg_QRLQ_RLsolve(argc, argv, obj, LINALG_R_SOLVE);
1482
+ }
1483
+
1484
+ /* singleton */
1485
+ static VALUE rb_gsl_linalg_QR_QRsolve(int argc, VALUE *argv, VALUE obj,
1486
+ int flag)
1487
+ {
1488
+ return rb_gsl_linalg_QRLQ_QRLQsolve(argc, argv, obj, LINALG_QR_DECOMP);
1489
+ }
1490
+
1491
+ #ifdef GSL_1_6_LATER
1492
+ static VALUE rb_gsl_linalg_LQ_Lsolve(int argc, VALUE *argv, VALUE obj)
1493
+ {
1494
+ return rb_gsl_linalg_QRLQ_RLsolve(argc, argv, obj, LINALG_LQ_LSOLVE);
1495
+ }
1496
+
1497
+ static VALUE rb_gsl_linalg_LQ_Lsvx(int argc, VALUE *argv, VALUE obj)
1498
+ {
1499
+ return rb_gsl_linalg_QRLQ_RLsvx(argc, argv, obj, LINALG_LQ_LSVX);
1500
+ }
1501
+
1502
+ static VALUE rb_gsl_linalg_L_solve(int argc, VALUE *argv, VALUE obj)
1503
+ {
1504
+ return rb_gsl_linalg_QRLQ_RLsolve(argc, argv, obj, LINALG_L_SOLVE);
1505
+ }
1506
+
1507
+ /* singleton */
1508
+ static VALUE rb_gsl_linalg_LQ_LQsolve(int argc, VALUE *argv, VALUE obj,
1509
+ int flag)
1510
+ {
1511
+ return rb_gsl_linalg_QRLQ_QRLQsolve(argc, argv, obj, LINALG_LQ_DECOMP);
1512
+ }
1513
+ #endif
1514
+
1515
+ static VALUE rb_gsl_linalg_QRLQ_update(VALUE obj, VALUE qq, VALUE rr, VALUE ww,
1516
+ VALUE vv, int flag)
1517
+ {
1518
+ gsl_matrix *Q = NULL, *R = NULL;
1519
+ gsl_vector *w = NULL, *v = NULL;
1520
+ int status;
1521
+ CHECK_MATRIX(qq); CHECK_MATRIX(rr);
1522
+ CHECK_VECTOR(ww); CHECK_VECTOR(vv);
1523
+ Data_Get_Struct(qq, gsl_matrix, Q);
1524
+ Data_Get_Struct(rr, gsl_matrix, R);
1525
+ Data_Get_Struct(ww, gsl_vector, w);
1526
+ Data_Get_Struct(vv, gsl_vector, v);
1527
+ switch (flag) {
1528
+ case LINALG_QR_DECOMP:
1529
+ status = gsl_linalg_QR_update(Q, R, w, v);
1530
+ break;
1531
+ #ifdef GSL_1_6_LATER
1532
+ case LINALG_LQ_DECOMP:
1533
+ status = gsl_linalg_LQ_update(Q, R, w, v);
1534
+ break;
1535
+ #endif
1536
+ default:
1537
+ rb_raise(rb_eRuntimeError, "unknown operation");
1538
+ break;
1539
+ }
1540
+ return INT2FIX(status);
1541
+ }
1542
+
1543
+ /* singleton */
1544
+ static VALUE rb_gsl_linalg_QR_update(VALUE obj, VALUE qq, VALUE rr, VALUE ww,
1545
+ VALUE vv)
1546
+ {
1547
+ return rb_gsl_linalg_QRLQ_update(obj, qq, rr, ww, vv, LINALG_QR_DECOMP);
1548
+ }
1549
+
1550
+ #ifdef GSL_1_6_LATER
1551
+ static VALUE rb_gsl_linalg_LQ_update(VALUE obj, VALUE qq, VALUE rr, VALUE ww,
1552
+ VALUE vv)
1553
+ {
1554
+ return rb_gsl_linalg_QRLQ_update(obj, qq, rr, ww, vv, LINALG_LQ_DECOMP);
1555
+ }
1556
+ #endif
1557
+
1558
+ /******/
1559
+ enum {
1560
+ LINALG_QRPT,
1561
+ LINALG_PTLQ,
1562
+ };
1563
+
1564
+ static VALUE rb_gsl_linalg_QRLQPT_decomp(int argc, VALUE *argv, VALUE obj, int flag)
1565
+ {
1566
+ gsl_matrix *A = NULL, *QR = NULL;
1567
+ gsl_vector *tau = NULL, *norm = NULL;
1568
+ gsl_permutation *p = NULL;
1569
+ int signum;
1570
+ size_t size0;
1571
+ VALUE vtau, vp, vA, vQR;
1572
+ switch (TYPE(obj)) {
1573
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1574
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
1575
+ argc);
1576
+ vA = argv[0];
1577
+ break;
1578
+ default:
1579
+ vA = obj;
1580
+ break;
1581
+ }
1582
+ CHECK_MATRIX(vA);
1583
+ Data_Get_Struct(vA, gsl_matrix, A);
1584
+ QR = make_matrix_clone(A);
1585
+ size0 = GSL_MIN(A->size1, A->size2);
1586
+ tau = gsl_vector_alloc(size0);
1587
+ p = gsl_permutation_alloc(size0);
1588
+ norm = gsl_vector_alloc(size0);
1589
+ switch (flag) {
1590
+ case LINALG_QRPT:
1591
+ vQR = Data_Wrap_Struct(cgsl_matrix_QRPT, 0, gsl_matrix_free, QR);
1592
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
1593
+ vp = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
1594
+ gsl_linalg_QRPT_decomp(QR, tau, p, &signum, norm);
1595
+ break;
1596
+ #ifdef GSL_1_6_LATER
1597
+ case LINALG_PTLQ:
1598
+ vQR = Data_Wrap_Struct(cgsl_matrix_PTLQ, 0, gsl_matrix_free, QR);
1599
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
1600
+ vp = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
1601
+ gsl_linalg_PTLQ_decomp(QR, tau, p, &signum, norm);
1602
+ break;
1603
+ #endif
1604
+ default:
1605
+ rb_raise(rb_eRuntimeError, "unknown operation");
1606
+ break;
1607
+ }
1608
+ gsl_vector_free(norm);
1609
+ return rb_ary_new3(4, vQR, vtau, vp, INT2FIX(signum));
1610
+ }
1611
+
1612
+ static VALUE rb_gsl_linalg_QRLQPT_decomp_bang(int argc, VALUE *argv, VALUE obj, int flag)
1613
+ {
1614
+ gsl_matrix *A = NULL;
1615
+ gsl_vector *tau = NULL, *norm = NULL;
1616
+ gsl_permutation *p = NULL;
1617
+ int signum;
1618
+ size_t size0;
1619
+ VALUE vtau, vp, vA;
1620
+ switch (TYPE(obj)) {
1621
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1622
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
1623
+ argc);
1624
+ vA = argv[0];
1625
+ break;
1626
+ default:
1627
+ vA = obj;
1628
+ break;
1629
+ }
1630
+ CHECK_MATRIX(vA);
1631
+ Data_Get_Struct(vA, gsl_matrix, A);
1632
+ size0 = GSL_MIN(A->size1, A->size2);
1633
+ tau = gsl_vector_alloc(size0);
1634
+ p = gsl_permutation_alloc(size0);
1635
+ norm = gsl_vector_alloc(size0);
1636
+ switch (flag) {
1637
+ case LINALG_QRPT:
1638
+ RBASIC(vA)->klass = cgsl_matrix_QRPT;
1639
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
1640
+ vp = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
1641
+ gsl_linalg_QRPT_decomp(A, tau, p, &signum, norm);
1642
+ break;
1643
+ #ifdef GSL_1_6_LATER
1644
+ case LINALG_PTLQ:
1645
+ RBASIC(vA)->klass = cgsl_matrix_PTLQ;
1646
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
1647
+ vp = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
1648
+ gsl_linalg_PTLQ_decomp(A, tau, p, &signum, norm);
1649
+ break;
1650
+ #endif
1651
+ default:
1652
+ rb_raise(rb_eRuntimeError, "unknown operation");
1653
+ break;
1654
+ }
1655
+ gsl_vector_free(norm);
1656
+ return rb_ary_new3(3, vtau, vp, INT2FIX(signum));
1657
+ }
1658
+
1659
+ static VALUE rb_gsl_linalg_QRPT_decomp(int argc, VALUE *argv, VALUE obj)
1660
+ {
1661
+ return rb_gsl_linalg_QRLQPT_decomp(argc, argv, obj, LINALG_QRPT);
1662
+ }
1663
+
1664
+ static VALUE rb_gsl_linalg_QRPT_decomp_bang(int argc, VALUE *argv, VALUE obj)
1665
+ {
1666
+ return rb_gsl_linalg_QRLQPT_decomp_bang(argc, argv, obj, LINALG_QRPT);
1667
+ }
1668
+
1669
+ #ifdef GSL_1_6_LATER
1670
+ static VALUE rb_gsl_linalg_PTLQ_decomp(int argc, VALUE *argv, VALUE obj)
1671
+ {
1672
+ return rb_gsl_linalg_QRLQPT_decomp(argc, argv, obj, LINALG_PTLQ);
1673
+ }
1674
+
1675
+ static VALUE rb_gsl_linalg_PTLQ_decomp_bang(int argc, VALUE *argv, VALUE obj)
1676
+ {
1677
+ return rb_gsl_linalg_QRLQPT_decomp_bang(argc, argv, obj, LINALG_PTLQ);
1678
+ }
1679
+ #endif
1680
+
1681
+ static VALUE rb_gsl_linalg_QRLQPT_decomp2(int argc, VALUE *argv, VALUE obj,int flag)
1682
+ {
1683
+ gsl_matrix *A = NULL, *Q = NULL, *R = NULL;
1684
+ gsl_vector *tau = NULL, *norm = NULL;
1685
+ gsl_permutation *p = NULL;
1686
+ int signum;
1687
+ size_t size0;
1688
+ VALUE vtau, vp, vA, vQ, vR;
1689
+ switch (TYPE(obj)) {
1690
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1691
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments");
1692
+ vA = argv[0];
1693
+ break;
1694
+ default:
1695
+ if (argc != 0) rb_raise(rb_eArgError, "wrong number of arguments");
1696
+ vA = obj;
1697
+ break;
1698
+ }
1699
+ CHECK_MATRIX(vA);
1700
+ Data_Get_Struct(vA, gsl_matrix, A);
1701
+ Q = gsl_matrix_alloc(A->size1, A->size2);
1702
+ R = gsl_matrix_alloc(A->size1, A->size2);
1703
+ size0 = GSL_MIN(A->size1, A->size2);
1704
+ tau = gsl_vector_alloc(size0);
1705
+ p = gsl_permutation_alloc(size0);
1706
+ norm = gsl_vector_alloc(size0);
1707
+ /* vQ = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, Q);
1708
+ vR = Data_Wrap_Struct(cgsl_matrix_R, 0, gsl_matrix_free, R);*/
1709
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
1710
+ vp = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
1711
+ switch (flag) {
1712
+ case LINALG_QRPT:
1713
+ vQ = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, Q);
1714
+ vR = Data_Wrap_Struct(cgsl_matrix_R, 0, gsl_matrix_free, R);
1715
+ gsl_linalg_QRPT_decomp2(A, Q, R, tau, p, &signum, norm);
1716
+ break;
1717
+ #ifdef GSL_1_6_LATER
1718
+ case LINALG_PTLQ:
1719
+ vR = Data_Wrap_Struct(cgsl_matrix_L, 0, gsl_matrix_free, R);
1720
+ vQ = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, Q);
1721
+ gsl_linalg_PTLQ_decomp2(A, Q, R, tau, p, &signum, norm);
1722
+ break;
1723
+ #endif
1724
+ default:
1725
+ rb_raise(rb_eRuntimeError, "unknown operation");
1726
+ }
1727
+ gsl_vector_free(norm);
1728
+ return rb_ary_new3(5, vQ, vR, vtau, vp, INT2FIX(signum));
1729
+ }
1730
+
1731
+ static VALUE rb_gsl_linalg_QRPT_decomp2(int argc, VALUE *argv, VALUE obj)
1732
+ {
1733
+ return rb_gsl_linalg_QRLQPT_decomp2(argc, argv, obj, LINALG_QRPT);
1734
+ }
1735
+
1736
+ #ifdef GSL_1_6_LATER
1737
+ static VALUE rb_gsl_linalg_PTLQ_decomp2(int argc, VALUE *argv, VALUE obj)
1738
+ {
1739
+ return rb_gsl_linalg_QRLQPT_decomp2(argc, argv, obj, LINALG_PTLQ);
1740
+ }
1741
+ #endif
1742
+
1743
+ #ifdef GSL_1_6_LATER
1744
+ int gsl_linalg_PTLQ_solve_T(const gsl_matrix * QR, const gsl_vector * tau,
1745
+ const gsl_permutation * p, const gsl_vector * b,
1746
+ gsl_vector * x);
1747
+ int gsl_linalg_PTLQ_svx_T(const gsl_matrix * LQ,
1748
+ const gsl_vector * tau,
1749
+ const gsl_permutation * p,
1750
+ gsl_vector * x);
1751
+ int gsl_linalg_PTLQ_LQsolve_T (const gsl_matrix * Q, const gsl_matrix * L,
1752
+ const gsl_permutation * p,
1753
+ const gsl_vector * b,
1754
+ gsl_vector * x);
1755
+ int gsl_linalg_PTLQ_Lsolve_T (const gsl_matrix * LQ,
1756
+ const gsl_permutation * p,
1757
+ const gsl_vector * b,
1758
+ gsl_vector * x);
1759
+ int gsl_linalg_PTLQ_Lsvx_T (const gsl_matrix * LQ,
1760
+ const gsl_permutation * p,
1761
+ gsl_vector * x);
1762
+ #endif
1763
+
1764
+ static VALUE rb_gsl_linalg_QRLQPT_solve(int argc, VALUE *argv, VALUE obj, int flag)
1765
+ {
1766
+ gsl_matrix *QR = NULL, *A = NULL;
1767
+ gsl_vector *tau = NULL, *b = NULL, *x = NULL, *norm = NULL;
1768
+ gsl_permutation *p = NULL;
1769
+ int signum, itmp, flagb = 0, flagq = 0;
1770
+ VALUE vtmp, klass;
1771
+ size_t size0;
1772
+ int (*fdecomp)(gsl_matrix*, gsl_vector*, gsl_permutation*, int *, gsl_vector*);
1773
+ int (*fsolve)(const gsl_matrix*, const gsl_vector*, const gsl_permutation*,
1774
+ const gsl_vector*, gsl_vector *);
1775
+ switch (flag) {
1776
+ case LINALG_QRPT:
1777
+ klass = cgsl_matrix_QRPT;
1778
+ fdecomp = &gsl_linalg_QRPT_decomp;
1779
+ fsolve = &gsl_linalg_QRPT_solve;
1780
+ break;
1781
+ #ifdef GSL_1_6_LATER
1782
+ case LINALG_PTLQ:
1783
+ klass = cgsl_matrix_PTLQ;
1784
+ fdecomp = &gsl_linalg_PTLQ_decomp;
1785
+ fsolve = &gsl_linalg_PTLQ_solve_T;
1786
+ break;
1787
+ #endif
1788
+ default:
1789
+ rb_raise(rb_eRuntimeError, "unknown operation");
1790
+ break;
1791
+ }
1792
+ switch (TYPE(obj)) {
1793
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1794
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
1795
+ vtmp = argv[0];
1796
+ itmp = 1;
1797
+ break;
1798
+ default:
1799
+ vtmp = obj;
1800
+ itmp = 0;
1801
+ break;
1802
+ }
1803
+ CHECK_MATRIX(vtmp);
1804
+ if (CLASS_OF(vtmp) == klass) {
1805
+ if (argc-itmp != 3) rb_raise(rb_eArgError,
1806
+ "wrong number of arguments (%d for %d)",
1807
+ argc, 4-itmp);
1808
+ CHECK_VECTOR(argv[itmp]);
1809
+ if (CLASS_OF(argv[itmp]) != cgsl_vector_tau)
1810
+ rb_raise(rb_eTypeError, "not a tau vector");
1811
+ CHECK_PERMUTATION(argv[itmp+1]);
1812
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
1813
+ Data_Get_Struct(argv[itmp+1], gsl_permutation, p);
1814
+ Data_Get_Struct(vtmp, gsl_matrix, QR);
1815
+ size0 = GSL_MIN(QR->size1, QR->size2);
1816
+ itmp += 2;
1817
+ } else {
1818
+ if (argc-itmp != 1) rb_raise(rb_eArgError,
1819
+ "wrong number of arguments (%d for %d)", argc, 2-itmp);
1820
+ Data_Get_Struct(vtmp, gsl_matrix, A);
1821
+ QR = make_matrix_clone(A);
1822
+ size0 = GSL_MIN(QR->size1, QR->size2);
1823
+ flagq = 1;
1824
+ p = gsl_permutation_alloc(size0);
1825
+ tau = gsl_vector_alloc(size0);
1826
+ }
1827
+ norm = gsl_vector_alloc(size0);
1828
+ if (TYPE(argv[itmp]) == T_ARRAY) {
1829
+ b = make_cvector_from_rarray(argv[itmp]);
1830
+ flagb = 1;
1831
+ } else {
1832
+ CHECK_VECTOR(argv[itmp]);
1833
+ Data_Get_Struct(argv[itmp], gsl_vector, b);
1834
+ }
1835
+ x = gsl_vector_alloc(b->size);
1836
+ if (flagq == 1) (*fdecomp)(QR, tau, p, &signum, norm);
1837
+ (*fsolve)(QR, tau, p, b, x);
1838
+ if (flagb == 1) gsl_vector_free(b);
1839
+ if (flagq == 1) {
1840
+ gsl_matrix_free(QR);
1841
+ gsl_permutation_free(p);
1842
+ gsl_vector_free(tau);
1843
+ gsl_vector_free(norm);
1844
+ }
1845
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
1846
+ }
1847
+
1848
+ static VALUE rb_gsl_linalg_QRPT_solve(int argc, VALUE *argv, VALUE obj)
1849
+ {
1850
+ return rb_gsl_linalg_QRLQPT_solve(argc, argv, obj, LINALG_QRPT);
1851
+ }
1852
+
1853
+ #ifdef GSL_1_6_LATER
1854
+ static VALUE rb_gsl_linalg_PTLQ_solve(int argc, VALUE *argv, VALUE obj)
1855
+ {
1856
+ return rb_gsl_linalg_QRLQPT_solve(argc, argv, obj, LINALG_PTLQ);
1857
+ }
1858
+ #endif
1859
+
1860
+ static VALUE rb_gsl_linalg_QRLQPT_svx(int argc, VALUE *argv, VALUE obj, int flag)
1861
+ {
1862
+ gsl_matrix *QR = NULL, *A = NULL;
1863
+ gsl_vector *tau = NULL, *b = NULL, *norm = NULL;
1864
+ gsl_permutation *p = NULL;
1865
+ int signum, itmp, flagq = 0;
1866
+ VALUE vtmp, klass;
1867
+ size_t size0;
1868
+ int (*fdecomp)(gsl_matrix*, gsl_vector*, gsl_permutation*, int *, gsl_vector*);
1869
+ int (*fsvx)(const gsl_matrix*, const gsl_vector*, const gsl_permutation*,
1870
+ gsl_vector *);
1871
+ switch (flag) {
1872
+ case LINALG_QRPT:
1873
+ klass = cgsl_matrix_QRPT;
1874
+ fdecomp = &gsl_linalg_QRPT_decomp;
1875
+ fsvx = &gsl_linalg_QRPT_svx;
1876
+ break;
1877
+ #ifdef GSL_1_6_LATER
1878
+ case LINALG_PTLQ:
1879
+ klass = cgsl_matrix_PTLQ;
1880
+ fdecomp = &gsl_linalg_PTLQ_decomp;
1881
+ fsvx = &gsl_linalg_PTLQ_svx_T;
1882
+ break;
1883
+ #endif
1884
+ default:
1885
+ rb_raise(rb_eRuntimeError, "unknown operation");
1886
+ break;
1887
+ }
1888
+
1889
+ switch (TYPE(obj)) {
1890
+ case T_MODULE: case T_CLASS: case T_OBJECT:
1891
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
1892
+ argc);
1893
+ vtmp = argv[0];
1894
+ itmp = 1;
1895
+ break;
1896
+ default:
1897
+ vtmp = obj;
1898
+ itmp = 0;
1899
+ break;
1900
+ }
1901
+ CHECK_MATRIX(vtmp);
1902
+ if (CLASS_OF(vtmp) == klass) {
1903
+ if (argc-itmp != 3) rb_raise(rb_eArgError,
1904
+ "wrong number of arguments (%d for %d)",
1905
+ argc, 3+itmp);
1906
+ CHECK_VECTOR(argv[itmp]);
1907
+ if (CLASS_OF(argv[itmp]) != cgsl_vector_tau)
1908
+ rb_raise(rb_eTypeError, "not a tau vector");
1909
+ CHECK_PERMUTATION(argv[itmp+1]);
1910
+ Data_Get_Struct(argv[itmp], gsl_vector, tau);
1911
+ Data_Get_Struct(argv[itmp+1], gsl_permutation, p);
1912
+ Data_Get_Struct(vtmp, gsl_matrix, QR);
1913
+ size0 = GSL_MIN(QR->size1, QR->size2);
1914
+ itmp += 2;
1915
+ } else {
1916
+ if (argc-itmp != 1) rb_raise(rb_eArgError,
1917
+ "wrong number of arguments (%d for %d)", argc, 2+itmp);
1918
+ Data_Get_Struct(vtmp, gsl_matrix, A);
1919
+ QR = make_matrix_clone(A);
1920
+ size0 = GSL_MIN(QR->size1, QR->size2);
1921
+ flagq = 1;
1922
+ p = gsl_permutation_alloc(size0);
1923
+ tau = gsl_vector_alloc(size0);
1924
+ }
1925
+ norm = gsl_vector_alloc(size0);
1926
+ CHECK_VECTOR(argv[itmp]);
1927
+ Data_Get_Struct(argv[itmp], gsl_vector, b);
1928
+ if (flagq == 1) (*fdecomp)(QR, tau, p, &signum, norm);
1929
+ (*fsvx)(QR, tau, p, b);
1930
+ if (flagq == 1) {
1931
+ gsl_matrix_free(QR);
1932
+ gsl_permutation_free(p);
1933
+ gsl_vector_free(tau);
1934
+ gsl_vector_free(norm);
1935
+ }
1936
+ return argv[itmp];
1937
+ }
1938
+
1939
+ static VALUE rb_gsl_linalg_QRPT_svx(int argc, VALUE *argv, VALUE obj)
1940
+ {
1941
+ return rb_gsl_linalg_QRLQPT_svx(argc, argv, obj, LINALG_QRPT);
1942
+ }
1943
+
1944
+ #ifdef GSL_1_6_LATER
1945
+ static VALUE rb_gsl_linalg_PTLQ_svx(int argc, VALUE *argv, VALUE obj)
1946
+ {
1947
+ return rb_gsl_linalg_QRLQPT_svx(argc, argv, obj, LINALG_PTLQ);
1948
+ }
1949
+ #endif
1950
+
1951
+ /* singleton */
1952
+ static VALUE rb_gsl_linalg_QRLQPT_QRLQsolve(VALUE obj, VALUE qq, VALUE rr,
1953
+ VALUE pp, VALUE bb, int flag)
1954
+ {
1955
+ gsl_matrix *Q = NULL, *R = NULL;
1956
+ gsl_vector *b = NULL, *x = NULL;
1957
+ gsl_permutation *p = NULL;
1958
+ int flagb = 0;
1959
+ int (*fsolve)(const gsl_matrix*, const gsl_matrix*, const gsl_permutation*,
1960
+ const gsl_vector*, gsl_vector*);
1961
+ switch (flag) {
1962
+ case LINALG_QRPT:
1963
+ if (CLASS_OF(qq) != cgsl_matrix_Q) rb_raise(rb_eTypeError, "not a Q matrix");
1964
+ if (CLASS_OF(rr) != cgsl_matrix_R) rb_raise(rb_eTypeError, "not a R matrix");
1965
+ fsolve = &gsl_linalg_QRPT_QRsolve;
1966
+ break;
1967
+ #ifdef GSL_1_6_LATER
1968
+ case LINALG_PTLQ:
1969
+ if (CLASS_OF(qq) != cgsl_matrix_Q) rb_raise(rb_eTypeError, "not a Q matrix");
1970
+ if (CLASS_OF(rr) != cgsl_matrix_L) rb_raise(rb_eTypeError, "not a L matrix");
1971
+ fsolve = &gsl_linalg_PTLQ_LQsolve_T;
1972
+ break;
1973
+ #endif
1974
+ default:
1975
+ rb_raise(rb_eRuntimeError, "unknown operation");
1976
+ break;
1977
+ }
1978
+ if (TYPE(bb) == T_ARRAY) {
1979
+ b = make_cvector_from_rarray(bb);
1980
+ flagb = 1;
1981
+ } else {
1982
+ CHECK_VECTOR(bb);
1983
+ Data_Get_Struct(bb, gsl_vector, b);
1984
+ }
1985
+ CHECK_PERMUTATION(pp);
1986
+ Data_Get_Struct(qq, gsl_matrix, Q);
1987
+ Data_Get_Struct(rr, gsl_matrix, R);
1988
+ Data_Get_Struct(pp, gsl_permutation, p);
1989
+ x = gsl_vector_alloc(b->size);
1990
+ (*fsolve)(Q, R, p, b, x);
1991
+ if (flagb == 1) gsl_vector_free(b);
1992
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
1993
+ }
1994
+
1995
+ static VALUE rb_gsl_linalg_QRPT_QRsolve(VALUE obj, VALUE qq, VALUE rr,
1996
+ VALUE pp, VALUE bb)
1997
+ {
1998
+ return rb_gsl_linalg_QRLQPT_QRLQsolve(obj, qq, rr, pp, bb, LINALG_QRPT);
1999
+ }
2000
+
2001
+ #ifdef GSL_1_6_LATER
2002
+ static VALUE rb_gsl_linalg_PTLQ_LQsolve(VALUE obj, VALUE qq, VALUE rr,
2003
+ VALUE pp, VALUE bb)
2004
+ {
2005
+ return rb_gsl_linalg_QRLQPT_QRLQsolve(obj, qq, rr, pp, bb, LINALG_PTLQ);
2006
+ }
2007
+ #endif
2008
+
2009
+ /* singleton */
2010
+ static VALUE rb_gsl_linalg_QRLQPT_update(VALUE obj, VALUE qq, VALUE rr,
2011
+ VALUE pp, VALUE ww, VALUE vv, int flag)
2012
+ {
2013
+ gsl_matrix *Q = NULL, *R = NULL;
2014
+ gsl_vector *w = NULL, *v = NULL;
2015
+ gsl_permutation *p = NULL;
2016
+ switch (flag) {
2017
+ case LINALG_QRPT:
2018
+ if (CLASS_OF(qq) != cgsl_matrix_Q) rb_raise(rb_eTypeError, "not a Q matrix");
2019
+ if (CLASS_OF(rr) != cgsl_matrix_R) rb_raise(rb_eTypeError, "not a R matrix");
2020
+ break;
2021
+ #ifdef GSL_1_6_LATER
2022
+ case LINALG_PTLQ:
2023
+ if (CLASS_OF(qq) != cgsl_matrix_Q) rb_raise(rb_eTypeError, "not a Q matrix");
2024
+ if (CLASS_OF(rr) != cgsl_matrix_L) rb_raise(rb_eTypeError, "not a L matrix");
2025
+ break;
2026
+ #endif
2027
+ }
2028
+ CHECK_PERMUTATION(pp);
2029
+ Data_Get_Struct(qq, gsl_matrix, Q);
2030
+ Data_Get_Struct(rr, gsl_matrix, R);
2031
+ Data_Get_Struct(pp, gsl_permutation, p);
2032
+ Data_Get_Struct(ww, gsl_vector, w);
2033
+ Data_Get_Struct(vv, gsl_vector, v);
2034
+ switch (flag) {
2035
+ case LINALG_QRPT:
2036
+ gsl_linalg_QRPT_update(Q, R, p, w, v);
2037
+ break;
2038
+ #ifdef GSL_1_6_LATER
2039
+ case LINALG_PTLQ:
2040
+ gsl_linalg_PTLQ_update(Q, R, p, w, v);
2041
+ break;
2042
+ #endif
2043
+ }
2044
+ return obj;
2045
+ }
2046
+
2047
+ static VALUE rb_gsl_linalg_QRPT_update(VALUE obj, VALUE qq, VALUE rr,
2048
+ VALUE pp, VALUE ww, VALUE vv)
2049
+ {
2050
+ return rb_gsl_linalg_QRLQPT_update(obj, qq, rr, pp, ww, vv, LINALG_QRPT);
2051
+ }
2052
+
2053
+ #ifdef GSL_1_6_LATER
2054
+ static VALUE rb_gsl_linalg_PTLQ_update(VALUE obj, VALUE qq, VALUE rr,
2055
+ VALUE pp, VALUE ww, VALUE vv)
2056
+ {
2057
+ return rb_gsl_linalg_QRLQPT_update(obj, qq, rr, pp, ww, vv, LINALG_PTLQ);
2058
+ }
2059
+ #endif
2060
+
2061
+ static VALUE rb_gsl_linalg_QRLQPT_RLsolve(int argc, VALUE *argv, VALUE obj, int flag)
2062
+ {
2063
+ gsl_matrix *QR = NULL;
2064
+ gsl_vector *b = NULL, *x = NULL;
2065
+ gsl_permutation *p = NULL;
2066
+ int itmp, flagb = 0;
2067
+ VALUE vtmp, klass;
2068
+ int (*fsolve)(const gsl_matrix*, const gsl_permutation*, const gsl_vector*,
2069
+ gsl_vector*);
2070
+ switch (flag) {
2071
+ case LINALG_QRPT:
2072
+ klass = cgsl_matrix_QRPT;
2073
+ fsolve = &gsl_linalg_QRPT_Rsolve;
2074
+ break;
2075
+ #ifdef GSL_1_6_LATER
2076
+ case LINALG_PTLQ:
2077
+ klass = cgsl_matrix_PTLQ;
2078
+ fsolve = &gsl_linalg_PTLQ_Lsolve_T;
2079
+ break;
2080
+ #endif
2081
+ default:
2082
+ rb_raise(rb_eRuntimeError, "unknown operation");
2083
+ break;
2084
+ }
2085
+ switch (TYPE(obj)) {
2086
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2087
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
2088
+ argc);
2089
+ vtmp = argv[0];
2090
+ itmp = 1;
2091
+ break;
2092
+ default:
2093
+ vtmp = obj;
2094
+ itmp = 0;
2095
+ break;
2096
+ }
2097
+ if (argc-itmp != 2)
2098
+ rb_raise(rb_eArgError, "wrong number of argument (%d for %d)", argc, 2+itmp);
2099
+ CHECK_MATRIX(vtmp);
2100
+ if (CLASS_OF(vtmp) != klass) {
2101
+ rb_raise(rb_eArgError, "not a QR matrix");
2102
+ }
2103
+ CHECK_PERMUTATION(argv[itmp]);
2104
+ Data_Get_Struct(argv[itmp], gsl_permutation, p);
2105
+ Data_Get_Struct(vtmp, gsl_matrix, QR);
2106
+ itmp++;
2107
+ if (TYPE(argv[itmp]) == T_ARRAY) {
2108
+ b = make_cvector_from_rarray(argv[itmp]);
2109
+ flagb = 1;
2110
+ } else {
2111
+ CHECK_VECTOR(argv[itmp]);
2112
+ Data_Get_Struct(argv[itmp], gsl_vector, b);
2113
+ }
2114
+ x = gsl_vector_alloc(b->size);
2115
+ (*fsolve)(QR, p, b, x);
2116
+ if (flagb == 1) gsl_vector_free(b);
2117
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
2118
+ }
2119
+
2120
+ static VALUE rb_gsl_linalg_QRPT_Rsolve(int argc, VALUE *argv, VALUE obj)
2121
+ {
2122
+ return rb_gsl_linalg_QRLQPT_RLsolve(argc, argv, obj, LINALG_QRPT);
2123
+ }
2124
+ #ifdef GSL_1_6_LATER
2125
+ static VALUE rb_gsl_linalg_PTLQ_Lsolve(int argc, VALUE *argv, VALUE obj)
2126
+ {
2127
+ return rb_gsl_linalg_QRLQPT_RLsolve(argc, argv, obj, LINALG_PTLQ);
2128
+ }
2129
+ #endif
2130
+
2131
+ static VALUE rb_gsl_linalg_QRLQPT_RLsvx(int argc, VALUE *argv, VALUE obj, int flag)
2132
+ {
2133
+ gsl_matrix *QR = NULL;
2134
+ gsl_vector *b = NULL;
2135
+ gsl_permutation *p = NULL;
2136
+ int itmp, flagb = 0;
2137
+ VALUE vtmp, klass;
2138
+ int (*fsvx)(const gsl_matrix*, const gsl_permutation*, gsl_vector*);
2139
+ switch (flag) {
2140
+ case LINALG_QRPT:
2141
+ klass = cgsl_matrix_QRPT;
2142
+ fsvx = &gsl_linalg_QRPT_Rsvx;
2143
+ break;
2144
+ #ifdef GSL_1_6_LATER
2145
+ case LINALG_PTLQ:
2146
+ klass = cgsl_matrix_PTLQ;
2147
+ fsvx = &gsl_linalg_PTLQ_Lsvx_T;
2148
+ #endif
2149
+ default:
2150
+ rb_raise(rb_eRuntimeError, "unknown operation");
2151
+ break;
2152
+ }
2153
+ switch (TYPE(obj)) {
2154
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2155
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
2156
+ argc);
2157
+ vtmp = argv[0];
2158
+ itmp = 1;
2159
+ break;
2160
+ default:
2161
+ vtmp = obj;
2162
+ itmp = 0;
2163
+ break;
2164
+ }
2165
+ if (argc-itmp != 2)
2166
+ rb_raise(rb_eArgError, "wrong number of argument (%d for %d)", argc, 2+itmp);
2167
+ CHECK_MATRIX(vtmp);
2168
+ if (CLASS_OF(vtmp) != klass) {
2169
+ rb_raise(rb_eArgError, "not a QR matrix");
2170
+ }
2171
+ CHECK_PERMUTATION(argv[itmp]);
2172
+ Data_Get_Struct(argv[itmp], gsl_permutation, p);
2173
+ Data_Get_Struct(vtmp, gsl_matrix, QR);
2174
+ itmp++;
2175
+ if (TYPE(argv[itmp]) == T_ARRAY) {
2176
+ b = make_cvector_from_rarray(argv[itmp]);
2177
+ flagb = 1;
2178
+ } else {
2179
+ CHECK_VECTOR(argv[itmp]);
2180
+ Data_Get_Struct(argv[itmp], gsl_vector, b);
2181
+ }
2182
+ (*fsvx)(QR, p, b);
2183
+ return argv[itmp];
2184
+ }
2185
+
2186
+ static VALUE rb_gsl_linalg_QRPT_Rsvx(int argc, VALUE *argv, VALUE obj)
2187
+ {
2188
+ return rb_gsl_linalg_QRLQPT_RLsvx(argc, argv, obj, LINALG_QRPT);
2189
+ }
2190
+ #ifdef GSL_1_6_LATER
2191
+ static VALUE rb_gsl_linalg_PTLQ_Lsvx(int argc, VALUE *argv, VALUE obj)
2192
+ {
2193
+ return rb_gsl_linalg_QRLQPT_RLsvx(argc, argv, obj, LINALG_PTLQ);
2194
+ }
2195
+ #endif
2196
+
2197
+ /*******/
2198
+ #ifdef HAVE_NARRAY_H
2199
+ static VALUE rb_gsl_linalg_SV_decomp_narray(int argc, VALUE *argv, VALUE obj)
2200
+ {
2201
+ struct NARRAY *A;
2202
+ gsl_matrix_view uv, vv;
2203
+ gsl_vector_view sv;
2204
+ gsl_vector *work;
2205
+ VALUE u, s, v;
2206
+ int shape[2];
2207
+ GetNArray(argv[0], A);
2208
+ shape[0] = A->shape[0];
2209
+ shape[1] = A->shape[0];
2210
+ u = na_make_object(NA_DFLOAT, 2, A->shape, CLASS_OF(argv[0]));
2211
+ v = na_make_object(NA_DFLOAT, 2, shape, CLASS_OF(argv[0]));
2212
+ s = na_make_object(NA_DFLOAT, 1, &(shape[0]), cNVector);
2213
+ uv = gsl_matrix_view_array(NA_PTR_TYPE(u,double*), A->shape[1], A->shape[0]);
2214
+ vv = gsl_matrix_view_array(NA_PTR_TYPE(v,double*), shape[1], shape[0]);
2215
+ sv = gsl_vector_view_array(NA_PTR_TYPE(s,double*), shape[0]);
2216
+ work = gsl_vector_alloc(shape[0]);
2217
+ memcpy(NA_PTR_TYPE(u,double*), (double*)A->ptr, sizeof(double)*A->total);
2218
+ gsl_linalg_SV_decomp(&uv.matrix, &vv.matrix, &sv.vector, work);
2219
+ gsl_vector_free(work);
2220
+ return rb_ary_new3(3, u, v, s);
2221
+ }
2222
+
2223
+ static VALUE rb_gsl_linalg_SV_decomp_jacobi_narray(int argc, VALUE *argv, VALUE obj)
2224
+ {
2225
+ struct NARRAY *A;
2226
+ gsl_matrix_view uv, vv;
2227
+ gsl_vector_view sv;
2228
+ VALUE u, s, v;
2229
+ int shape[2];
2230
+ GetNArray(argv[0], A);
2231
+ shape[0] = A->shape[0];
2232
+ shape[1] = A->shape[0];
2233
+ u = na_make_object(NA_DFLOAT, 2, A->shape, CLASS_OF(argv[0]));
2234
+ v = na_make_object(NA_DFLOAT, 2, shape, CLASS_OF(argv[0]));
2235
+ s = na_make_object(NA_DFLOAT, 1, &(shape[0]), cNVector);
2236
+ uv = gsl_matrix_view_array(NA_PTR_TYPE(u,double*), A->shape[1], A->shape[0]);
2237
+ vv = gsl_matrix_view_array(NA_PTR_TYPE(v,double*), shape[1], shape[0]);
2238
+ sv = gsl_vector_view_array(NA_PTR_TYPE(s,double*), shape[0]);
2239
+ memcpy(NA_PTR_TYPE(u,double*), (double*)A->ptr, sizeof(double)*A->total);
2240
+ gsl_linalg_SV_decomp_jacobi(&uv.matrix, &vv.matrix, &sv.vector);
2241
+ return rb_ary_new3(3, u, v, s);
2242
+ }
2243
+
2244
+ static VALUE rb_gsl_linalg_SV_solve_narray(int argc, VALUE *argv, VALUE obj)
2245
+ {
2246
+ struct NARRAY *A;
2247
+ gsl_matrix_view uv, vv;
2248
+ gsl_vector_view sv, bv, xv;
2249
+ VALUE x;
2250
+ if (argc != 4)
2251
+ rb_raise(rb_eArgError, "Usage: SV.solve(u, v, s, b)");
2252
+ GetNArray(argv[0], A);
2253
+ uv = gsl_matrix_view_array(NA_PTR_TYPE(argv[0],double*), A->shape[1], A->shape[0]);
2254
+ vv = gsl_matrix_view_array(NA_PTR_TYPE(argv[1],double*), A->shape[0], A->shape[0]);
2255
+ sv = gsl_vector_view_array(NA_PTR_TYPE(argv[2],double*), A->shape[0]);
2256
+ bv = gsl_vector_view_array(NA_PTR_TYPE(argv[3],double*), A->shape[0]);
2257
+ x = na_make_object(NA_DFLOAT, 1, &(A->shape[0]), CLASS_OF(argv[3]));
2258
+ xv = gsl_vector_view_array(NA_PTR_TYPE(x,double*), A->shape[0]);
2259
+ gsl_linalg_SV_solve(&uv.matrix, &vv.matrix, &sv.vector, &bv.vector, &xv.vector);
2260
+ return x;
2261
+ }
2262
+
2263
+ #endif
2264
+
2265
+ static VALUE rb_gsl_linalg_SV_decomp(int argc, VALUE *argv, VALUE obj)
2266
+ {
2267
+ gsl_matrix *A = NULL, *V = NULL, *U = NULL;
2268
+ gsl_vector *w = NULL, *S = NULL;
2269
+ int flag = 1;
2270
+ VALUE vs, vv, vu;
2271
+ switch (TYPE(obj)) {
2272
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2273
+ switch (argc) {
2274
+ case 2:
2275
+ CHECK_VECTOR(argv[1]);
2276
+ Data_Get_Struct(argv[1], gsl_vector, w);
2277
+ flag = 0;
2278
+ /* no break, do next */
2279
+ case 1:
2280
+ #ifdef HAVE_NARRAY_H
2281
+ if (NA_IsNArray(argv[0]))
2282
+ return rb_gsl_linalg_SV_decomp_narray(argc, argv, obj);
2283
+ #endif
2284
+ CHECK_MATRIX(argv[0]);
2285
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2286
+ break;
2287
+ default:
2288
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
2289
+ break;
2290
+ }
2291
+ break;
2292
+ default:
2293
+ switch (argc) {
2294
+ case 0:
2295
+ /* do nothing */
2296
+ break;
2297
+ case 1:
2298
+ CHECK_VECTOR(argv[0]);
2299
+ Data_Get_Struct(argv[0], gsl_vector, w);
2300
+ flag = 0;
2301
+ break;
2302
+ default:
2303
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
2304
+ break;
2305
+ }
2306
+ Data_Get_Struct(obj, gsl_matrix, A);
2307
+ break;
2308
+ }
2309
+ U = make_matrix_clone(A);
2310
+ S = gsl_vector_alloc(A->size2); /* see manual p 123 */
2311
+ V = gsl_matrix_alloc(A->size2, A->size2);
2312
+ if (flag == 1) w = gsl_vector_alloc(A->size2);
2313
+ gsl_linalg_SV_decomp(U, V, S, w);
2314
+ if (flag == 1) gsl_vector_free(w);
2315
+ vu = Data_Wrap_Struct(cgsl_matrix_U, 0, gsl_matrix_free, U);
2316
+ vv = Data_Wrap_Struct(cgsl_matrix_V, 0, gsl_matrix_free, V);
2317
+ vs = Data_Wrap_Struct(cgsl_vector_S, 0, gsl_vector_free, S);
2318
+ return rb_ary_new3(3, vu, vv, vs);
2319
+ }
2320
+
2321
+ static VALUE rb_gsl_linalg_SV_decomp_mod(int argc, VALUE *argv, VALUE obj)
2322
+ {
2323
+ gsl_matrix *A = NULL, *V = NULL, *U = NULL, *X = NULL;
2324
+ gsl_vector *w = NULL, *S = NULL;
2325
+ VALUE vs, vv, vu;
2326
+ switch (TYPE(obj)) {
2327
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2328
+ if (argc != 1) rb_raise(rb_eArgError,
2329
+ "wrong number of argument (%d for 1)", argc);
2330
+ CHECK_MATRIX(argv[0]);
2331
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2332
+ break;
2333
+ default:
2334
+ Data_Get_Struct(obj, gsl_matrix, A);
2335
+ break;
2336
+ }
2337
+ U = make_matrix_clone(A);
2338
+ S = gsl_vector_alloc(A->size2); /* see manual p 123 */
2339
+ V = gsl_matrix_alloc(A->size2, A->size2);
2340
+ X = gsl_matrix_alloc(A->size2, A->size2);
2341
+ w = gsl_vector_alloc(A->size2);
2342
+ gsl_linalg_SV_decomp_mod(U, X, V, S, w);
2343
+ gsl_vector_free(w);
2344
+ gsl_matrix_free(X);
2345
+ vu = Data_Wrap_Struct(cgsl_matrix_U, 0, gsl_matrix_free, U);
2346
+ vv = Data_Wrap_Struct(cgsl_matrix_V, 0, gsl_matrix_free, V);
2347
+ vs = Data_Wrap_Struct(cgsl_vector_S, 0, gsl_vector_free, S);
2348
+ return rb_ary_new3(3, vu, vv, vs);
2349
+ }
2350
+
2351
+ static VALUE rb_gsl_linalg_SV_decomp_jacobi(int argc, VALUE *argv, VALUE obj)
2352
+ {
2353
+ gsl_matrix *A = NULL, *V = NULL, *U = NULL;
2354
+ gsl_vector *S = NULL;
2355
+ VALUE vs, vv, vu;
2356
+ switch (TYPE(obj)) {
2357
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2358
+ if (argc != 1) rb_raise(rb_eArgError,
2359
+ "wrong number of argument (%d for 1)", argc);
2360
+ #ifdef HAVE_NARRAY_H
2361
+ if (NA_IsNArray(argv[0]))
2362
+ return rb_gsl_linalg_SV_decomp_jacobi_narray(argc, argv, obj);
2363
+ #endif
2364
+ CHECK_MATRIX(argv[0]);
2365
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2366
+ break;
2367
+ default:
2368
+ Data_Get_Struct(obj, gsl_matrix, A);
2369
+ break;
2370
+ }
2371
+ U = make_matrix_clone(A);
2372
+ S = gsl_vector_alloc(A->size2); /* see manual p 123 */
2373
+ V = gsl_matrix_alloc(A->size2, A->size2);
2374
+ gsl_linalg_SV_decomp_jacobi(U, V, S);
2375
+ vu = Data_Wrap_Struct(cgsl_matrix_U, 0, gsl_matrix_free, U);
2376
+ vv = Data_Wrap_Struct(cgsl_matrix_V, 0, gsl_matrix_free, V);
2377
+ vs = Data_Wrap_Struct(cgsl_vector_S, 0, gsl_vector_free, S);
2378
+ return rb_ary_new3(3, vu, vv, vs);
2379
+ }
2380
+
2381
+ static VALUE rb_gsl_linalg_SV_solve(int argc, VALUE *argv, VALUE obj)
2382
+ {
2383
+ gsl_matrix *A = NULL, *U = NULL, *V = NULL;
2384
+ gsl_vector *S = NULL, *b = NULL, *x = NULL;
2385
+ int flagb = 0, flagv = 0;
2386
+
2387
+ switch (TYPE(obj)) {
2388
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2389
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
2390
+ #ifdef HAVE_NARRAY_H
2391
+ if (NA_IsNArray(argv[0]))
2392
+ return rb_gsl_linalg_SV_solve_narray(argc, argv, obj);
2393
+ #endif
2394
+
2395
+ CHECK_MATRIX(argv[0]);
2396
+ if (CLASS_OF(argv[0]) == cgsl_matrix_U) {
2397
+ if (argc != 4) rb_raise(rb_eArgError,
2398
+ "wrong number of arguments (%d for 4)", argc);
2399
+ Data_Get_Struct(argv[0], gsl_matrix, U);
2400
+ CHECK_MATRIX(argv[1]);
2401
+ if (CLASS_OF(argv[1]) != cgsl_matrix_V)
2402
+ rb_raise(rb_eTypeError, "not a V matrix");
2403
+ Data_Get_Struct(argv[1], gsl_matrix, V);
2404
+ CHECK_VECTOR(argv[2]);
2405
+ if (CLASS_OF(argv[2]) != cgsl_vector_S)
2406
+ rb_raise(rb_eTypeError, "not a S vector");
2407
+ Data_Get_Struct(argv[2], gsl_vector, S);
2408
+ if (TYPE(argv[3]) == T_ARRAY) {
2409
+ b = make_cvector_from_rarray(argv[3]);
2410
+ flagb = 1;
2411
+ } else {
2412
+ CHECK_VECTOR(argv[3]);
2413
+ Data_Get_Struct(argv[3], gsl_vector, b);
2414
+ }
2415
+ } else {
2416
+ if (argc != 2) rb_raise(rb_eArgError,
2417
+ "wrong number of arguments (%d for 2)", argc);
2418
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2419
+ U = make_matrix_clone(A);
2420
+ if (TYPE(argv[1]) == T_ARRAY) {
2421
+ b = make_cvector_from_rarray(argv[1]);
2422
+ flagb = 1;
2423
+ } else {
2424
+ CHECK_VECTOR(argv[1]);
2425
+ Data_Get_Struct(argv[1], gsl_vector, b);
2426
+ }
2427
+ S = gsl_vector_alloc(A->size2); /* see manual p 123 */
2428
+ V = gsl_matrix_alloc(A->size2, A->size2);
2429
+ gsl_linalg_SV_decomp_jacobi(U, V, S);
2430
+ flagv = 1;
2431
+ }
2432
+ break;
2433
+ default:
2434
+ if (argc != 1) rb_raise(rb_eArgError,
2435
+ "wrong number of arguments (%d for 1)", argc);
2436
+ Data_Get_Struct(obj, gsl_matrix, A);
2437
+ U = make_matrix_clone(A);
2438
+ if (TYPE(argv[0]) == T_ARRAY) {
2439
+ b = make_cvector_from_rarray(argv[0]);
2440
+ flagb = 1;
2441
+ } else {
2442
+ CHECK_VECTOR(argv[0]);
2443
+ Data_Get_Struct(argv[0], gsl_vector, b);
2444
+ }
2445
+ S = gsl_vector_alloc(A->size2); /* see manual p 123 */
2446
+ V = gsl_matrix_alloc(A->size2, A->size2);
2447
+ gsl_linalg_SV_decomp_jacobi(U, V, S);
2448
+ flagv = 1;
2449
+ break;
2450
+ }
2451
+ // x = gsl_vector_alloc(b->size);
2452
+ // Bug report #25842
2453
+ x = gsl_vector_alloc(S->size);
2454
+ gsl_linalg_SV_solve(U, V, S, b, x);
2455
+ if (flagv == 1) {
2456
+ gsl_matrix_free(U);
2457
+ gsl_matrix_free(V);
2458
+ gsl_vector_free(S);
2459
+ }
2460
+ if (flagb == 1) gsl_vector_free(b);
2461
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
2462
+ }
2463
+
2464
+ /*****/
2465
+
2466
+ #ifdef HAVE_NARRAY_H
2467
+ static VALUE rb_gsl_linalg_cholesky_decomp_narray(int argc, VALUE *argv, VALUE obj)
2468
+ {
2469
+ struct NARRAY *na;
2470
+ VALUE chol;
2471
+ gsl_matrix_view mv;
2472
+ GetNArray(argv[0], na);
2473
+ chol = na_make_object(NA_DFLOAT, 2, na->shape, CLASS_OF(argv[0]));
2474
+ memcpy(NA_PTR_TYPE(chol,double*), (double*)na->ptr, sizeof(double)*na->total);
2475
+ mv = gsl_matrix_view_array(NA_PTR_TYPE(chol,double*), na->shape[1], na->shape[0]);
2476
+ gsl_linalg_cholesky_decomp(&mv.matrix);
2477
+ return chol;
2478
+ }
2479
+
2480
+ static VALUE rb_gsl_linalg_cholesky_solve_narray(int argc, VALUE *argv, VALUE obj)
2481
+ {
2482
+ struct NARRAY *nm, *nb;
2483
+ VALUE x;
2484
+ gsl_matrix_view mv;
2485
+ gsl_vector_view bv, xv;
2486
+ switch (argc) {
2487
+ case 2:
2488
+ GetNArray(argv[0], nm);
2489
+ GetNArray(argv[1], nb);
2490
+ x = na_make_object(NA_DFLOAT, 1, nb->shape, CLASS_OF(argv[1]));
2491
+ break;
2492
+ case 3:
2493
+ GetNArray(argv[0], nm);
2494
+ GetNArray(argv[1], nb);
2495
+ x = argv[2];
2496
+ break;
2497
+ default:
2498
+ rb_raise(rb_eArgError,
2499
+ "Usage: Cholesky.solve(chol, b) or Cholesky.solve(chol, b, x)");
2500
+ break;
2501
+ }
2502
+ mv = gsl_matrix_view_array((double*)nm->ptr, nm->shape[1], nm->shape[0]);
2503
+ bv = gsl_vector_view_array((double*)nb->ptr, nb->shape[0]);
2504
+ xv = gsl_vector_view_array(NA_PTR_TYPE(x,double*), nb->shape[0]);
2505
+ gsl_linalg_cholesky_solve(&mv.matrix, &bv.vector, &xv.vector);
2506
+ return x;
2507
+ }
2508
+
2509
+ static VALUE rb_gsl_linalg_cholesky_svx_narray(int argc, VALUE *argv, VALUE obj)
2510
+ {
2511
+ struct NARRAY *nm, *nb;
2512
+ gsl_matrix_view mv;
2513
+ gsl_vector_view bv;
2514
+ GetNArray(argv[0], nm); GetNArray(argv[1], nb);
2515
+ mv = gsl_matrix_view_array((double*)nm->ptr, nm->shape[1], nm->shape[0]);
2516
+ bv = gsl_vector_view_array((double*)nb->ptr, nb->shape[0]);
2517
+ gsl_linalg_cholesky_svx(&mv.matrix, &bv.vector);
2518
+ return argv[1];
2519
+ }
2520
+
2521
+ #endif
2522
+
2523
+ static VALUE rb_gsl_linalg_cholesky_decomp(int argc, VALUE *argv, VALUE obj)
2524
+ {
2525
+ gsl_matrix *A = NULL, *Atmp = NULL;
2526
+ switch(TYPE(obj)) {
2527
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2528
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2529
+ argc);
2530
+ #ifdef HAVE_NARRAY_H
2531
+ if (NA_IsNArray(argv[0]))
2532
+ return rb_gsl_linalg_cholesky_decomp_narray(argc, argv, obj);
2533
+ #endif
2534
+ CHECK_MATRIX(argv[0]);
2535
+ Data_Get_Struct(argv[0], gsl_matrix, Atmp);
2536
+ break;
2537
+ default:
2538
+ CHECK_MATRIX(obj);
2539
+ Data_Get_Struct(obj, gsl_matrix, Atmp);
2540
+ break;
2541
+ }
2542
+ A = make_matrix_clone(Atmp);
2543
+ gsl_linalg_cholesky_decomp(A);
2544
+ return Data_Wrap_Struct(cgsl_matrix_C, 0, gsl_matrix_free, A);
2545
+ }
2546
+
2547
+ static VALUE rb_gsl_linalg_cholesky_solve(int argc, VALUE *argv, VALUE obj)
2548
+ {
2549
+ gsl_matrix *A = NULL, *Atmp = NULL;
2550
+ gsl_vector *b = NULL, *x = NULL;
2551
+ int flagb = 0, flaga = 0;
2552
+ VALUE vA, vb;
2553
+ switch(TYPE(obj)) {
2554
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2555
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
2556
+ argc);
2557
+ #ifdef HAVE_NARRAY_H
2558
+ if (NA_IsNArray(argv[0]))
2559
+ return rb_gsl_linalg_cholesky_solve_narray(argc, argv, obj);
2560
+ #endif
2561
+ vA = argv[0];
2562
+ vb = argv[1];
2563
+ break;
2564
+ default:
2565
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2566
+ argc);
2567
+ vA = obj;
2568
+ vb = argv[0];
2569
+ break;
2570
+ }
2571
+ CHECK_MATRIX(vA);
2572
+ Data_Get_Struct(vA, gsl_matrix, Atmp);
2573
+ if (TYPE(vb) == T_ARRAY) {
2574
+ b = make_cvector_from_rarray(vb);
2575
+ flagb = 1;
2576
+ } else {
2577
+ CHECK_VECTOR(vb);
2578
+ Data_Get_Struct(vb, gsl_vector, b);
2579
+ }
2580
+ if (CLASS_OF(vA) == cgsl_matrix_C) {
2581
+ A = Atmp;
2582
+ } else {
2583
+ A = make_matrix_clone(Atmp);
2584
+ flaga = 1;
2585
+ gsl_linalg_cholesky_decomp(A);
2586
+ }
2587
+ x = gsl_vector_alloc(b->size);
2588
+ gsl_linalg_cholesky_solve(A, b, x);
2589
+ if (flaga == 1) gsl_matrix_free(A);
2590
+ if (flagb == 1) gsl_vector_free(b);
2591
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
2592
+ }
2593
+
2594
+
2595
+ static VALUE rb_gsl_linalg_cholesky_svx(int argc, VALUE *argv, VALUE obj)
2596
+ {
2597
+ gsl_matrix *A = NULL, *Atmp = NULL;
2598
+ gsl_vector *b = NULL;
2599
+ int flaga = 0;
2600
+ VALUE vA, vb;
2601
+ switch(TYPE(obj)) {
2602
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2603
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
2604
+ argc);
2605
+ #ifdef HAVE_NARRAY_H
2606
+ if (NA_IsNArray(argv[0]))
2607
+ return rb_gsl_linalg_cholesky_svx_narray(argc, argv, obj);
2608
+ #endif
2609
+ vA = argv[0];
2610
+ vb = argv[1];
2611
+ break;
2612
+ default:
2613
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2614
+ argc);
2615
+ vA = obj;
2616
+ vb = argv[0];
2617
+ break;
2618
+ }
2619
+ CHECK_MATRIX(vA);
2620
+ Data_Get_Struct(vA, gsl_matrix, Atmp);
2621
+ CHECK_VECTOR(vb);
2622
+ Data_Get_Struct(vb, gsl_vector, b);
2623
+ if (CLASS_OF(vA) == cgsl_matrix_C) {
2624
+ A = Atmp;
2625
+ } else {
2626
+ A = make_matrix_clone(Atmp);
2627
+ flaga = 1;
2628
+ gsl_linalg_cholesky_decomp(A);
2629
+ }
2630
+ gsl_linalg_cholesky_svx(A, b);
2631
+ if (flaga == 1) gsl_matrix_free(A);
2632
+ return vb;
2633
+ }
2634
+
2635
+ static VALUE rb_gsl_linalg_symmtd_decomp(int argc, VALUE *argv, VALUE obj)
2636
+ {
2637
+ gsl_matrix *A = NULL, *Atmp = NULL;
2638
+ gsl_vector *tau = NULL;
2639
+ VALUE vQ, vtau;
2640
+ switch (TYPE(obj)) {
2641
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2642
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2643
+ argc);
2644
+ CHECK_MATRIX(argv[0]);
2645
+ Data_Get_Struct(argv[0], gsl_matrix, Atmp);
2646
+ break;
2647
+ default:
2648
+ CHECK_MATRIX(obj);
2649
+ Data_Get_Struct(obj, gsl_matrix, Atmp);
2650
+ break;
2651
+ }
2652
+ A = make_matrix_clone(Atmp);
2653
+ tau = gsl_vector_alloc(A->size1);
2654
+ gsl_linalg_symmtd_decomp(A, tau);
2655
+ vQ = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, A);
2656
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
2657
+ return rb_ary_new3(2, vQ, vtau);
2658
+ }
2659
+
2660
+
2661
+ static VALUE rb_gsl_linalg_symmtd_decomp2(int argc, VALUE *argv, VALUE obj)
2662
+ {
2663
+ gsl_matrix *A = NULL;
2664
+ gsl_vector *tau = NULL;
2665
+ switch (TYPE(obj)) {
2666
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2667
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2668
+ argc);
2669
+ CHECK_MATRIX(argv[0]);
2670
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2671
+ break;
2672
+ default:
2673
+ CHECK_MATRIX(obj);
2674
+ Data_Get_Struct(obj, gsl_matrix, A);
2675
+ break;
2676
+ }
2677
+ tau = gsl_vector_alloc(A->size1);
2678
+ gsl_linalg_symmtd_decomp(A, tau);
2679
+ return Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
2680
+ }
2681
+
2682
+ static VALUE rb_gsl_linalg_symmtd_unpack(int argc, VALUE *argv, VALUE obj)
2683
+ {
2684
+ gsl_matrix *A = NULL, *Q = NULL;
2685
+ gsl_vector *tau = NULL, *d = NULL, *sd = NULL;
2686
+ VALUE vq, vd, vsd;
2687
+ switch (TYPE(obj)) {
2688
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2689
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
2690
+ argc);
2691
+ CHECK_MATRIX(argv[0]);
2692
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2693
+ Data_Get_Struct(argv[1], gsl_vector, tau);
2694
+ break;
2695
+ default:
2696
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2697
+ argc);
2698
+ CHECK_MATRIX(obj);
2699
+ Data_Get_Struct(obj, gsl_matrix, A);
2700
+ Data_Get_Struct(argv[0], gsl_vector, tau);
2701
+ break;
2702
+ }
2703
+ Q = gsl_matrix_alloc(A->size1, A->size2);
2704
+ d = gsl_vector_alloc(tau->size);
2705
+ sd = gsl_vector_alloc(tau->size);
2706
+ gsl_linalg_symmtd_unpack(A, tau, Q, d, sd);
2707
+
2708
+ vq = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, Q);
2709
+ vd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, d);
2710
+ vsd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, sd);
2711
+
2712
+ return rb_ary_new3(3, vq, vd, vsd);
2713
+ }
2714
+
2715
+ static VALUE rb_gsl_linalg_symmtd_unpack_T(int argc, VALUE *argv, VALUE obj)
2716
+ {
2717
+ gsl_matrix *A = NULL;
2718
+ gsl_vector *d = NULL, *sd = NULL;
2719
+ VALUE vd, vsd;
2720
+ switch (TYPE(obj)) {
2721
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2722
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
2723
+ argc);
2724
+ CHECK_MATRIX(argv[0]);
2725
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2726
+ break;
2727
+ default:
2728
+ Data_Get_Struct(obj, gsl_matrix, A);
2729
+ break;
2730
+ }
2731
+ d = gsl_vector_alloc(A->size1);
2732
+ sd = gsl_vector_alloc(A->size1);
2733
+ gsl_linalg_symmtd_unpack_T(A, d, sd);
2734
+
2735
+ vd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, d);
2736
+ vsd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, sd);
2737
+
2738
+ return rb_ary_new3(2, vd, vsd);
2739
+ }
2740
+
2741
+ /*****/
2742
+
2743
+ static VALUE rb_gsl_linalg_hermtd_decomp(int argc, VALUE *argv, VALUE obj)
2744
+ {
2745
+ gsl_matrix_complex *A = NULL, *Atmp = NULL;
2746
+ gsl_vector_complex *tau = NULL;
2747
+ VALUE vQ, vtau;
2748
+ switch (TYPE(obj)) {
2749
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2750
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2751
+ argc);
2752
+ CHECK_MATRIX_COMPLEX(argv[0]);
2753
+ Data_Get_Struct(argv[0], gsl_matrix_complex, Atmp);
2754
+ break;
2755
+ default:
2756
+ CHECK_MATRIX_COMPLEX(obj);
2757
+ Data_Get_Struct(obj, gsl_matrix_complex, Atmp);
2758
+ break;
2759
+ }
2760
+ A = make_matrix_complex_clone(Atmp);
2761
+ tau = gsl_vector_complex_alloc(A->size1);
2762
+ gsl_linalg_hermtd_decomp(A, tau);
2763
+ vQ = Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, A);
2764
+ vtau = Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, tau);
2765
+ return rb_ary_new3(2, vQ, vtau);
2766
+ }
2767
+
2768
+ static VALUE rb_gsl_linalg_hermtd_decomp2(int argc, VALUE *argv, VALUE obj)
2769
+ {
2770
+ gsl_matrix_complex *A = NULL;
2771
+ gsl_vector_complex *tau = NULL;
2772
+ switch (TYPE(obj)) {
2773
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2774
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2775
+ argc);
2776
+ CHECK_MATRIX_COMPLEX(argv[0]);
2777
+ Data_Get_Struct(argv[0], gsl_matrix_complex, A);
2778
+ break;
2779
+ default:
2780
+ CHECK_MATRIX_COMPLEX(obj);
2781
+ Data_Get_Struct(obj, gsl_matrix_complex, A);
2782
+ break;
2783
+ }
2784
+ tau = gsl_vector_complex_alloc(A->size1);
2785
+ gsl_linalg_hermtd_decomp(A, tau);
2786
+ return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, tau);
2787
+ }
2788
+
2789
+ static VALUE rb_gsl_linalg_hermtd_unpack(int argc, VALUE *argv, VALUE obj)
2790
+ {
2791
+ gsl_matrix_complex *A = NULL, *Q = NULL;
2792
+ gsl_vector_complex *tau = NULL;
2793
+ gsl_vector *d = NULL, *sd = NULL;
2794
+ VALUE vq, vd, vsd;
2795
+ switch (TYPE(obj)) {
2796
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2797
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2798
+ argc);
2799
+ CHECK_MATRIX_COMPLEX(argv[0]);
2800
+ Data_Get_Struct(argv[0], gsl_matrix_complex, A);
2801
+ Data_Get_Struct(argv[1], gsl_vector_complex, tau);
2802
+ break;
2803
+ default:
2804
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2805
+ argc);
2806
+ CHECK_MATRIX_COMPLEX(obj);
2807
+ Data_Get_Struct(obj, gsl_matrix_complex, A);
2808
+ Data_Get_Struct(argv[0], gsl_vector_complex, tau);
2809
+ break;
2810
+ }
2811
+ Q = gsl_matrix_complex_alloc(A->size1, A->size2);
2812
+ d = gsl_vector_alloc(tau->size);
2813
+ sd = gsl_vector_alloc(tau->size);
2814
+ gsl_linalg_hermtd_unpack(A, tau, Q, d, sd);
2815
+
2816
+ vq = Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Q);
2817
+ vd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, d);
2818
+ vsd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, sd);
2819
+
2820
+ return rb_ary_new3(3, vq, vd, vsd);
2821
+ }
2822
+
2823
+ static VALUE rb_gsl_linalg_hermtd_unpack_T(int argc, VALUE *argv, VALUE obj)
2824
+ {
2825
+ gsl_matrix_complex *A = NULL;
2826
+ gsl_vector *d = NULL, *sd = NULL;
2827
+ VALUE vd, vsd;
2828
+ switch (TYPE(obj)) {
2829
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2830
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
2831
+ argc);
2832
+ CHECK_MATRIX_COMPLEX(argv[0]);
2833
+ Data_Get_Struct(argv[0], gsl_matrix_complex, A);
2834
+ break;
2835
+ default:
2836
+ Data_Get_Struct(obj, gsl_matrix_complex, A);
2837
+ break;
2838
+ }
2839
+ d = gsl_vector_alloc(A->size1);
2840
+ sd = gsl_vector_alloc(A->size1);
2841
+ gsl_linalg_hermtd_unpack_T(A, d, sd);
2842
+
2843
+ vd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, d);
2844
+ vsd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, sd);
2845
+
2846
+ return rb_ary_new3(2, vd, vsd);
2847
+ }
2848
+
2849
+ /******/
2850
+
2851
+ static VALUE rb_gsl_linalg_bidiag_decomp(int argc, VALUE *argv, VALUE obj)
2852
+ {
2853
+ gsl_matrix *A = NULL, *Atmp = NULL;
2854
+ gsl_vector *tau_U = NULL, *tau_V = NULL;
2855
+ size_t size0;
2856
+ int status;
2857
+ VALUE vu, vv, vA;
2858
+
2859
+ switch (TYPE(obj)) {
2860
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2861
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
2862
+ argc);
2863
+ Data_Get_Struct(argv[0], gsl_matrix, Atmp);
2864
+ break;
2865
+ default:
2866
+ Data_Get_Struct(obj, gsl_matrix, Atmp);
2867
+ break;
2868
+ }
2869
+ A = make_matrix_clone(Atmp);
2870
+ size0 = GSL_MIN(A->size1, A->size2);
2871
+ tau_U = gsl_vector_alloc(size0);
2872
+ tau_V = gsl_vector_alloc(size0-1);
2873
+ status = gsl_linalg_bidiag_decomp(A, tau_U, tau_V);
2874
+ vA = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, A);
2875
+ vu = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, tau_U);
2876
+ vv = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, tau_V);
2877
+ return rb_ary_new3(3, vA, vu, vv);
2878
+ }
2879
+
2880
+ static VALUE rb_gsl_linalg_bidiag_decomp2(int argc, VALUE *argv, VALUE obj)
2881
+ {
2882
+ gsl_matrix *A = NULL;
2883
+ gsl_vector *tau_U = NULL, *tau_V = NULL;
2884
+ size_t size0;
2885
+ VALUE vu, vv;
2886
+
2887
+ switch (TYPE(obj)) {
2888
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2889
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
2890
+ argc);
2891
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2892
+ break;
2893
+ default:
2894
+ Data_Get_Struct(obj, gsl_matrix, A);
2895
+ break;
2896
+ }
2897
+ size0 = GSL_MIN(A->size1, A->size2);
2898
+ tau_U = gsl_vector_alloc(size0);
2899
+ tau_V = gsl_vector_alloc(size0-1);
2900
+ gsl_linalg_bidiag_decomp(A, tau_U, tau_V);
2901
+ vu = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, tau_U);
2902
+ vv = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, tau_V);
2903
+ return rb_ary_new3(2, vu, vv);
2904
+ }
2905
+
2906
+ static VALUE rb_gsl_linalg_bidiag_unpack(int argc, VALUE *argv, VALUE obj)
2907
+ {
2908
+ gsl_matrix *A = NULL, *U = NULL, *V = NULL;
2909
+ gsl_vector *tau_U = NULL, *tau_V = NULL, *d = NULL, *s = NULL;
2910
+ size_t size0;
2911
+ VALUE vu, vv, vd, vs;
2912
+
2913
+ switch (TYPE(obj)) {
2914
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2915
+ if (argc != 3) rb_raise(rb_eArgError, "wrong number of arguments (%d for 3)",
2916
+ argc);
2917
+ CHECK_MATRIX(argv[0]);
2918
+ CHECK_VECTOR(argv[1]);
2919
+ CHECK_VECTOR(argv[2]);
2920
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2921
+ Data_Get_Struct(argv[1], gsl_vector, tau_U);
2922
+ Data_Get_Struct(argv[2], gsl_vector, tau_V);
2923
+ break;
2924
+ default:
2925
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
2926
+ argc);
2927
+ CHECK_MATRIX(obj);
2928
+ CHECK_VECTOR(argv[0]);
2929
+ CHECK_VECTOR(argv[1]);
2930
+ Data_Get_Struct(obj, gsl_matrix, A);
2931
+ Data_Get_Struct(argv[0], gsl_vector, tau_U);
2932
+ Data_Get_Struct(argv[1], gsl_vector, tau_V);
2933
+ break;
2934
+ }
2935
+ size0 = GSL_MIN(A->size1, A->size2);
2936
+ U = gsl_matrix_alloc(A->size1, A->size2);
2937
+ V = gsl_matrix_alloc(size0, size0);
2938
+
2939
+ d = gsl_vector_alloc(size0);
2940
+ s = gsl_vector_alloc(size0-1);
2941
+ gsl_linalg_bidiag_unpack(A, tau_U, U, tau_V, V, d, s);
2942
+ vu = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, U);
2943
+ vv = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, V);
2944
+ vd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, d);
2945
+ vs = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, s);
2946
+ return rb_ary_new3(4, vu, vv, vd, vs);
2947
+ }
2948
+
2949
+ static VALUE rb_gsl_linalg_bidiag_unpack2(int argc, VALUE *argv, VALUE obj)
2950
+ {
2951
+ gsl_matrix *A = NULL, *V = NULL;
2952
+ gsl_vector *tau_V = NULL, *tau_U = NULL;
2953
+ VALUE vv;
2954
+
2955
+ switch (TYPE(obj)) {
2956
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2957
+ if (argc != 3) rb_raise(rb_eArgError, "wrong number of arguments (%d for 3)",
2958
+ argc);
2959
+ CHECK_MATRIX(argv[0]);
2960
+ CHECK_VECTOR(argv[1]);
2961
+ CHECK_VECTOR(argv[2]);
2962
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2963
+ Data_Get_Struct(argv[1], gsl_vector, tau_U);
2964
+ Data_Get_Struct(argv[2], gsl_vector, tau_V);
2965
+ break;
2966
+ default:
2967
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
2968
+ argc);
2969
+ CHECK_MATRIX(obj);
2970
+ CHECK_VECTOR(argv[0]);
2971
+ CHECK_VECTOR(argv[1]);
2972
+ Data_Get_Struct(obj, gsl_matrix, A);
2973
+ Data_Get_Struct(argv[0], gsl_vector, tau_U);
2974
+ Data_Get_Struct(argv[1], gsl_vector, tau_V);
2975
+ break;
2976
+ }
2977
+ V = gsl_matrix_alloc(A->size2, A->size2);
2978
+ gsl_linalg_bidiag_unpack2(A, tau_U, tau_V, V);
2979
+ vv = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, V);
2980
+ return vv;
2981
+ }
2982
+
2983
+ static VALUE rb_gsl_linalg_bidiag_unpack_B(int argc, VALUE *argv, VALUE obj)
2984
+ {
2985
+ gsl_matrix *A = NULL;
2986
+ gsl_vector *d = NULL, *s = NULL;
2987
+ size_t size0;
2988
+ VALUE vd, vs;
2989
+
2990
+ switch (TYPE(obj)) {
2991
+ case T_MODULE: case T_CLASS: case T_OBJECT:
2992
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 3)",
2993
+ argc);
2994
+ CHECK_MATRIX(argv[0]);
2995
+ Data_Get_Struct(argv[0], gsl_matrix, A);
2996
+ break;
2997
+ default:
2998
+ CHECK_MATRIX(obj);
2999
+ Data_Get_Struct(obj, gsl_matrix, A);
3000
+ break;
3001
+ }
3002
+ size0 = GSL_MIN(A->size1, A->size2);
3003
+ d = gsl_vector_alloc(size0);
3004
+ s = gsl_vector_alloc(size0);
3005
+ gsl_linalg_bidiag_unpack_B(A, d, s);
3006
+ vd = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, d);
3007
+ vs = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, s);
3008
+ return rb_ary_new3(2, vd, vs);
3009
+ }
3010
+
3011
+ /* Householder Transformations 11.Jul.2004 */
3012
+ static VALUE rb_gsl_linalg_householder_transform(int argc, VALUE *argv, VALUE obj)
3013
+ {
3014
+ gsl_vector *v = NULL;
3015
+ switch (TYPE(obj)) {
3016
+ case T_MODULE: case T_CLASS: case T_OBJECT:
3017
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
3018
+ CHECK_VECTOR(argv[0]);
3019
+ Data_Get_Struct(argv[0], gsl_vector, v);
3020
+ break;
3021
+ default:
3022
+ Data_Get_Struct(obj, gsl_vector, v);
3023
+ break;
3024
+ }
3025
+ return rb_float_new(gsl_linalg_householder_transform(v));
3026
+ }
3027
+
3028
+ /* singleton */
3029
+ static VALUE rb_gsl_linalg_householder_hm(VALUE obj, VALUE t, VALUE vv, VALUE aa)
3030
+ {
3031
+ gsl_vector *v = NULL;
3032
+ double tau;
3033
+ gsl_matrix *A = NULL;
3034
+ CHECK_VECTOR(vv);
3035
+ CHECK_MATRIX(aa);
3036
+ tau = NUM2DBL(t);
3037
+ Data_Get_Struct(vv, gsl_vector, v);
3038
+ Data_Get_Struct(aa, gsl_matrix, A);
3039
+ gsl_linalg_householder_hm(tau, v, A);
3040
+ return aa;
3041
+ }
3042
+
3043
+ static VALUE rb_gsl_linalg_householder_mh(VALUE obj, VALUE t, VALUE vv, VALUE aa)
3044
+ {
3045
+ gsl_vector *v = NULL;
3046
+ double tau;
3047
+ gsl_matrix *A = NULL;
3048
+ CHECK_VECTOR(vv);
3049
+ CHECK_MATRIX(aa);
3050
+ tau = NUM2DBL(t);
3051
+ Data_Get_Struct(vv, gsl_vector, v);
3052
+ Data_Get_Struct(aa, gsl_matrix, A);
3053
+ gsl_linalg_householder_mh(tau, v, A);
3054
+ return aa;
3055
+ }
3056
+
3057
+ static VALUE rb_gsl_linalg_householder_hv(VALUE obj, VALUE t, VALUE vv, VALUE ww)
3058
+ {
3059
+ gsl_vector *v = NULL, *w = NULL;
3060
+ double tau;
3061
+ CHECK_VECTOR(vv);
3062
+ CHECK_VECTOR(ww);
3063
+ tau = NUM2DBL(t);
3064
+ Data_Get_Struct(vv, gsl_vector, v);
3065
+ Data_Get_Struct(ww, gsl_vector, w);
3066
+ gsl_linalg_householder_hv(tau, v, w);
3067
+ return ww;
3068
+ }
3069
+
3070
+ #ifdef HAVE_NARRAY_H
3071
+ static VALUE rb_gsl_linalg_HH_solve_narray(int argc, VALUE *argv, VALUE obj)
3072
+ {
3073
+ struct NARRAY *na;
3074
+ gsl_vector_view bv, xv;
3075
+ VALUE x;
3076
+ gsl_matrix *mtmp;
3077
+ GetNArray(argv[0], na);
3078
+ bv = gsl_vector_view_array(NA_PTR_TYPE(argv[1],double*), na->shape[1]);
3079
+ x = na_make_object(NA_DFLOAT, 1, &na->shape[1], CLASS_OF(argv[1]));
3080
+ xv = gsl_vector_view_array(NA_PTR_TYPE(x,double*), na->shape[1]);
3081
+ mtmp = gsl_matrix_alloc(na->shape[1], na->shape[0]);
3082
+ memcpy(mtmp->data, (double*)na->ptr, sizeof(double)*na->total);
3083
+ gsl_linalg_HH_solve(mtmp, &bv.vector, &xv.vector);
3084
+ gsl_matrix_free(mtmp);
3085
+ return x;
3086
+ }
3087
+ static VALUE rb_gsl_linalg_HH_svx_narray(int argc, VALUE *argv, VALUE obj)
3088
+ {
3089
+ struct NARRAY *na;
3090
+ gsl_matrix *mtmp;
3091
+ gsl_vector_view bv;
3092
+ GetNArray(argv[0], na);
3093
+ bv = gsl_vector_view_array(NA_PTR_TYPE(argv[1],double*), na->shape[1]);
3094
+ mtmp = gsl_matrix_alloc(na->shape[1], na->shape[0]);
3095
+ memcpy(mtmp->data, (double*)na->ptr, sizeof(double)*na->total);
3096
+ gsl_linalg_HH_svx(mtmp, &bv.vector);
3097
+ gsl_matrix_free(mtmp);
3098
+ return argv[1];
3099
+ }
3100
+ #endif
3101
+
3102
+ /* 17.Apr.2004 */
3103
+ static VALUE rb_gsl_linalg_HH_solve(int argc, VALUE *argv, VALUE obj)
3104
+ {
3105
+ gsl_matrix *A = NULL, *Atmp = NULL;
3106
+ gsl_vector *b = NULL, *x = NULL;
3107
+ int flagb = 0;
3108
+ VALUE vA, vb;
3109
+ switch (TYPE(obj)) {
3110
+ case T_MODULE: case T_CLASS: case T_OBJECT:
3111
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
3112
+ argc);
3113
+ #ifdef HAVE_NARRAY_H
3114
+ if (NA_IsNArray(argv[0]))
3115
+ return rb_gsl_linalg_HH_solve_narray(argc, argv, obj);
3116
+ #endif
3117
+ vA = argv[0];
3118
+ vb = argv[1];
3119
+ break;
3120
+ default:
3121
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
3122
+ argc);
3123
+ vA = obj;
3124
+ vb = argv[0];
3125
+ break;
3126
+ }
3127
+ CHECK_MATRIX(vA);
3128
+ Data_Get_Struct(vA, gsl_matrix, Atmp);
3129
+ if (TYPE(vb) == T_ARRAY) {
3130
+ b = make_cvector_from_rarray(vb);
3131
+ flagb = 1;
3132
+ } else {
3133
+ CHECK_VECTOR(vb);
3134
+ Data_Get_Struct(vb, gsl_vector, b);
3135
+ }
3136
+ A = make_matrix_clone(Atmp);
3137
+ x = gsl_vector_alloc(b->size);
3138
+ gsl_linalg_HH_solve(A, b, x);
3139
+ gsl_matrix_free(A);
3140
+ if (flagb == 1) gsl_vector_free(b);
3141
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
3142
+ }
3143
+
3144
+ static VALUE rb_gsl_linalg_HH_solve_bang(int argc, VALUE *argv, VALUE obj)
3145
+ {
3146
+ gsl_matrix *A = NULL;
3147
+ gsl_vector *b = NULL, *x = NULL;
3148
+ int flagb = 0;
3149
+ VALUE vA, vb;
3150
+ switch (TYPE(obj)) {
3151
+ case T_MODULE: case T_CLASS: case T_OBJECT:
3152
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
3153
+ argc);
3154
+ vA = argv[0];
3155
+ vb = argv[1];
3156
+ break;
3157
+ default:
3158
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
3159
+ argc);
3160
+ vA = obj;
3161
+ vb = argv[0];
3162
+ break;
3163
+ }
3164
+ CHECK_MATRIX(vA);
3165
+ Data_Get_Struct(vA, gsl_matrix, A);
3166
+ if (TYPE(vb) == T_ARRAY) {
3167
+ b = make_cvector_from_rarray(vb);
3168
+ flagb = 1;
3169
+ } else {
3170
+ CHECK_VECTOR(vb);
3171
+ Data_Get_Struct(vb, gsl_vector, b);
3172
+ }
3173
+ x = gsl_vector_alloc(b->size);
3174
+ gsl_linalg_HH_solve(A, b, x);
3175
+ if (flagb == 1) gsl_vector_free(b);
3176
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
3177
+ }
3178
+
3179
+ static VALUE rb_gsl_linalg_HH_svx(int argc, VALUE *argv, VALUE obj)
3180
+ {
3181
+ gsl_matrix *A = NULL, *Atmp = NULL;
3182
+ gsl_vector *b = NULL;
3183
+ VALUE vA, vb;
3184
+ switch (TYPE(obj)) {
3185
+ case T_MODULE: case T_CLASS: case T_OBJECT:
3186
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
3187
+ argc);
3188
+ #ifdef HAVE_NARRAY_H
3189
+ if (NA_IsNArray(argv[0]))
3190
+ return rb_gsl_linalg_HH_svx_narray(argc, argv, obj);
3191
+ #endif
3192
+ vA = argv[0];
3193
+ vb = argv[1];
3194
+ break;
3195
+ default:
3196
+ if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
3197
+ argc);
3198
+ vA = obj;
3199
+ vb = argv[0];
3200
+ break;
3201
+ }
3202
+ CHECK_MATRIX(vA);
3203
+ Data_Get_Struct(vA, gsl_matrix, Atmp);
3204
+ CHECK_VECTOR(vb);
3205
+ Data_Get_Struct(vb, gsl_vector, b);
3206
+ A = make_matrix_clone(Atmp);
3207
+ gsl_linalg_HH_svx(A, b);
3208
+ gsl_matrix_free(A);
3209
+ return vb;
3210
+ }
3211
+
3212
+ static VALUE rb_gsl_linalg_solve_symm_tridiag(VALUE obj, VALUE dd, VALUE ee, VALUE bb)
3213
+ {
3214
+ gsl_vector *b = NULL, *x = NULL, *d = NULL, *e = NULL;
3215
+
3216
+ Data_Get_Struct(dd, gsl_vector, d);
3217
+ Data_Get_Struct(ee, gsl_vector, e);
3218
+ Data_Get_Struct(bb, gsl_vector, b);
3219
+ x = gsl_vector_alloc(b->size);
3220
+
3221
+ gsl_linalg_solve_symm_tridiag(d, e, b, x);
3222
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
3223
+ }
3224
+
3225
+ #ifdef GSL_1_2_LATER
3226
+ static VALUE rb_gsl_linalg_solve_tridiag(VALUE obj, VALUE dd, VALUE ee, VALUE ff,
3227
+ VALUE bb)
3228
+ {
3229
+ gsl_vector *b = NULL, *x = NULL, *d = NULL, *e = NULL, *f = NULL;
3230
+
3231
+ Data_Get_Struct(dd, gsl_vector, d);
3232
+ Data_Get_Struct(ee, gsl_vector, e);
3233
+ Data_Get_Struct(ff, gsl_vector, f);
3234
+ Data_Get_Struct(bb, gsl_vector, b);
3235
+ x = gsl_vector_alloc(b->size);
3236
+
3237
+ gsl_linalg_solve_tridiag(d, e, f, b, x);
3238
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
3239
+ }
3240
+
3241
+ static VALUE rb_gsl_linalg_solve_symm_cyc_tridiag(VALUE obj, VALUE dd, VALUE ee, VALUE bb)
3242
+ {
3243
+ gsl_vector *b = NULL, *x = NULL, *d = NULL, *e = NULL;
3244
+
3245
+ Data_Get_Struct(dd, gsl_vector, d);
3246
+ Data_Get_Struct(ee, gsl_vector, e);
3247
+ Data_Get_Struct(bb, gsl_vector, b);
3248
+ x = gsl_vector_alloc(b->size);
3249
+
3250
+ gsl_linalg_solve_symm_cyc_tridiag(d, e, b, x);
3251
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
3252
+ }
3253
+
3254
+ static VALUE rb_gsl_linalg_solve_cyc_tridiag(VALUE obj, VALUE dd, VALUE ee,
3255
+ VALUE ff, VALUE bb)
3256
+ {
3257
+ gsl_vector *b = NULL, *x = NULL, *d = NULL, *e = NULL, *f = NULL;
3258
+ Data_Get_Struct(dd, gsl_vector, d);
3259
+ Data_Get_Struct(ee, gsl_vector, e);
3260
+ Data_Get_Struct(ff, gsl_vector, f);
3261
+ Data_Get_Struct(bb, gsl_vector, b);
3262
+ x = gsl_vector_alloc(b->size);
3263
+ gsl_linalg_solve_cyc_tridiag(d, e, f, b, x);
3264
+ return Data_Wrap_Struct(cgsl_vector_col, 0, gsl_vector_free, x);
3265
+ }
3266
+ #endif
3267
+
3268
+ static void rb_gsl_linalg_balance_columns_init(int argc, VALUE *argv, VALUE obj,
3269
+ VALUE *mat, VALUE *vec,
3270
+ gsl_matrix **M, gsl_vector **V)
3271
+ {
3272
+ gsl_matrix *A = NULL;
3273
+ gsl_vector *D = NULL;
3274
+ switch (TYPE(obj)) {
3275
+ case T_MODULE: case T_CLASS: case T_OBJECT:
3276
+ switch (argc) {
3277
+ case 2:
3278
+ CHECK_MATRIX(argv[0]); CHECK_VECTOR(argv[1]);
3279
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3280
+ Data_Get_Struct(argv[1], gsl_vector, D);
3281
+ *vec = argv[1];
3282
+ break;
3283
+ case 1:
3284
+ CHECK_MATRIX(argv[0]);
3285
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3286
+ D = gsl_vector_alloc(A->size2);
3287
+ *vec = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, D);
3288
+ break;
3289
+ default:
3290
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
3291
+ break;
3292
+ }
3293
+ *mat = argv[0];
3294
+ break;
3295
+ default:
3296
+ Data_Get_Struct(obj, gsl_matrix, A);
3297
+ switch (argc) {
3298
+ case 1:
3299
+ CHECK_VECTOR(argv[0]);
3300
+ Data_Get_Struct(argv[0], gsl_vector, D);
3301
+ *vec = argv[0];
3302
+ break;
3303
+ case 0:
3304
+ D = gsl_vector_alloc(A->size2);
3305
+ *vec = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, D);
3306
+ break;
3307
+ default:
3308
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
3309
+ break;
3310
+ }
3311
+ *mat = obj;
3312
+ break;
3313
+ }
3314
+ *M = A;
3315
+ *V = D;
3316
+ }
3317
+
3318
+ static VALUE rb_gsl_linalg_balance_columns_bang(int argc, VALUE *argv, VALUE obj)
3319
+ {
3320
+ gsl_matrix *A = NULL;
3321
+ gsl_vector *D = NULL;
3322
+ VALUE mat, vec;
3323
+ int status;
3324
+ rb_gsl_linalg_balance_columns_init(argc, argv, obj, &mat, &vec, &A, &D);
3325
+ status = gsl_linalg_balance_columns(A, D);
3326
+ return rb_ary_new3(2, mat, vec);
3327
+ }
3328
+
3329
+ static VALUE rb_gsl_linalg_balance_columns(int argc, VALUE *argv, VALUE obj)
3330
+ {
3331
+ gsl_matrix *A = NULL, *Anew;
3332
+ gsl_vector *D = NULL;
3333
+ VALUE mat, vec;
3334
+ int status;
3335
+ rb_gsl_linalg_balance_columns_init(argc, argv, obj, &mat, &vec, &A, &D);
3336
+ Anew = make_matrix_clone(A);
3337
+ mat = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Anew);
3338
+ status = gsl_linalg_balance_columns(Anew, D);
3339
+ return rb_ary_new3(2, mat, vec);
3340
+ }
3341
+
3342
+ #ifdef HAVE_NARRAY_H
3343
+ static VALUE rb_gsl_linalg_QR_decomp_narray(int argc, VALUE *argv, VALUE obj)
3344
+ {
3345
+ struct NARRAY *na;
3346
+ gsl_matrix_view mv;
3347
+ gsl_vector_view vv;
3348
+ int shapem[2], shapev[1];
3349
+ VALUE qr, tau;
3350
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
3351
+ GetNArray(argv[0], na);
3352
+ shapem[0] = na->shape[1];
3353
+ shapem[1] = na->shape[1];
3354
+ shapev[0] = shapem[0];
3355
+ qr = na_make_object(NA_DFLOAT, 2, shapem, CLASS_OF(argv[0]));
3356
+ tau = na_make_object(NA_DFLOAT, 1, shapev, cNVector);
3357
+ memcpy(NA_PTR_TYPE(qr,double*),na->ptr,sizeof(double)*shapem[0]*shapem[1]);
3358
+ mv = gsl_matrix_view_array(NA_PTR_TYPE(qr,double*), shapem[0], shapem[1]);
3359
+ vv = gsl_vector_view_array(NA_PTR_TYPE(tau,double*), shapev[0]);
3360
+ gsl_linalg_QR_decomp(&mv.matrix, &vv.vector);
3361
+ return rb_ary_new3(2, qr, tau);
3362
+ }
3363
+
3364
+ static VALUE rb_gsl_linalg_QR_unpack_narray(int argc, VALUE *argv, VALUE obj)
3365
+ {
3366
+ struct NARRAY *m, *tau;
3367
+ gsl_matrix_view mv, mq, mr;
3368
+ gsl_vector_view vv;
3369
+ int shape[2];
3370
+ VALUE q, r;
3371
+ if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
3372
+ argc);
3373
+ GetNArray(argv[0], m);
3374
+ GetNArray(argv[1], tau);
3375
+ mv = gsl_matrix_view_array((double*)m->ptr, m->shape[1], m->shape[0]);
3376
+ vv = gsl_vector_view_array((double*)tau->ptr, tau->shape[0]);
3377
+ shape[0] = m->shape[1];
3378
+ shape[1] = m->shape[1];
3379
+ q = na_make_object(NA_DFLOAT, 2, shape, CLASS_OF(argv[0]));
3380
+ shape[0] = m->shape[1];
3381
+ shape[1] = m->shape[0];
3382
+ r = na_make_object(NA_DFLOAT, 2, shape, CLASS_OF(argv[0]));
3383
+ mq = gsl_matrix_view_array(NA_PTR_TYPE(q,double*), m->shape[1], m->shape[1]);
3384
+ mr = gsl_matrix_view_array(NA_PTR_TYPE(r,double*), m->shape[1], m->shape[0]);
3385
+ // printf("OK 4 %d %d\n", mq.matrix.size1, mr.matrix.size2);
3386
+ gsl_linalg_QR_unpack(&mv.matrix, &vv.vector, &mq.matrix, &mr.matrix);
3387
+ // printf("OK 5\n");
3388
+ return rb_ary_new3(2, q, r);
3389
+ }
3390
+
3391
+ static VALUE rb_gsl_linalg_QR_solve_narray(int argc, VALUE *argv, VALUE obj)
3392
+ {
3393
+ struct NARRAY *qr, *tau, *b;
3394
+ VALUE x;
3395
+ gsl_matrix_view mv;
3396
+ gsl_vector_view tv, bv, xv;
3397
+ if (argc != 3) rb_raise(rb_eArgError, "Usage: QR.solve(qr, tau, b)");
3398
+ GetNArray(argv[0], qr);
3399
+ GetNArray(argv[1], tau);
3400
+ GetNArray(argv[2], b);
3401
+ x = na_make_object(NA_DFLOAT, 1, b->shape, CLASS_OF(argv[2]));
3402
+ mv = gsl_matrix_view_array((double*)qr->ptr, qr->shape[1], qr->shape[0]);
3403
+ tv = gsl_vector_view_array((double*)tau->ptr, tau->shape[0]);
3404
+ bv = gsl_vector_view_array((double*)b->ptr, b->shape[0]);
3405
+ xv = gsl_vector_view_array(NA_PTR_TYPE(x,double*), b->shape[0]);
3406
+ gsl_linalg_QR_solve(&mv.matrix, &tv.vector, &bv.vector, &xv.vector);
3407
+ return x;
3408
+ }
3409
+ static VALUE rb_gsl_linalg_QR_svx_narray(int argc, VALUE *argv, VALUE obj)
3410
+ {
3411
+ struct NARRAY *qr, *tau, *b;
3412
+ gsl_matrix_view mv;
3413
+ gsl_vector_view tv, bv;
3414
+ if (argc != 3) rb_raise(rb_eArgError, "Usage: QR.solve(qr, tau, b)");
3415
+ GetNArray(argv[0], qr);
3416
+ GetNArray(argv[1], tau);
3417
+ GetNArray(argv[2], b);
3418
+ mv = gsl_matrix_view_array((double*)qr->ptr, qr->shape[1], qr->shape[0]);
3419
+ tv = gsl_vector_view_array((double*)tau->ptr, tau->shape[0]);
3420
+ bv = gsl_vector_view_array((double*)b->ptr, b->shape[0]);
3421
+ gsl_linalg_QR_svx(&mv.matrix, &tv.vector, &bv.vector);
3422
+ return argv[2];
3423
+ }
3424
+
3425
+ #endif
3426
+
3427
+ #ifdef GSL_1_9_LATER
3428
+ static VALUE rb_gsl_linalg_hessenberg_decomp(VALUE module, VALUE AA)
3429
+ {
3430
+ gsl_matrix *A = NULL, *Atmp = NULL;
3431
+ gsl_vector *tau = NULL;
3432
+ VALUE vH, vtau;
3433
+ CHECK_MATRIX(AA);
3434
+ Data_Get_Struct(AA, gsl_matrix, Atmp);
3435
+ A = make_matrix_clone(Atmp);
3436
+ tau = gsl_vector_alloc(A->size1);
3437
+ gsl_linalg_hessenberg_decomp(A, tau);
3438
+ vH = Data_Wrap_Struct(cgsl_matrix_Q, 0, gsl_matrix_free, A);
3439
+ vtau = Data_Wrap_Struct(cgsl_vector_tau, 0, gsl_vector_free, tau);
3440
+ return rb_ary_new3(2, vH, vtau);
3441
+ }
3442
+
3443
+ static VALUE rb_gsl_linalg_hessenberg_unpack(VALUE module, VALUE HH, VALUE tt)
3444
+ {
3445
+ gsl_matrix *H = NULL, *U = NULL;
3446
+ gsl_vector *tau = NULL;
3447
+ CHECK_MATRIX(HH);
3448
+ CHECK_VECTOR(tt);
3449
+ Data_Get_Struct(HH, gsl_matrix, H);
3450
+ Data_Get_Struct(tt, gsl_vector, tau);
3451
+ U = gsl_matrix_alloc(H->size1, H->size2);
3452
+ gsl_linalg_hessenberg_unpack(H, tau, U);
3453
+
3454
+ return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, U);
3455
+ }
3456
+
3457
+ static VALUE rb_gsl_linalg_hessenberg_unpack_accum(int argc, VALUE *argv, VALUE module)
3458
+ {
3459
+ gsl_matrix *H = NULL, *V = NULL;
3460
+ gsl_vector *tau = NULL;
3461
+ size_t i;
3462
+ VALUE val;
3463
+ switch (argc) {
3464
+ case 2:
3465
+ /* nothing to do */
3466
+ break;
3467
+ case 3:
3468
+ CHECK_MATRIX(argv[2]);
3469
+ Data_Get_Struct(argv[2], gsl_matrix, V);
3470
+ val = argv[2];
3471
+ break;
3472
+ default:
3473
+ rb_raise(rb_eArgError, "Wrong number of arguments (%d for 2 or 3)", argc);
3474
+ }
3475
+ CHECK_MATRIX(argv[0]);
3476
+ CHECK_VECTOR(argv[1]);
3477
+ Data_Get_Struct(argv[0], gsl_matrix, H);
3478
+ Data_Get_Struct(argv[1], gsl_vector, tau);
3479
+ if (argc == 2) {
3480
+ V = gsl_matrix_alloc(H->size1, H->size2);
3481
+ val = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, V);
3482
+ for (i = 0; i < V->size1; i++) gsl_matrix_set(V, i, i, 1.0);
3483
+ }
3484
+ gsl_linalg_hessenberg_unpack_accum(H, tau, V);
3485
+ return val;
3486
+ }
3487
+ static VALUE rb_gsl_linalg_hessenberg_set_zero(VALUE module, VALUE HH)
3488
+ {
3489
+ gsl_matrix *H;
3490
+ CHECK_MATRIX(HH);
3491
+ Data_Get_Struct(HH, gsl_matrix, H);
3492
+ return INT2FIX(gsl_linalg_hessenberg_set_zero(H));
3493
+ /* gsl_linalg_hessenberg_set_zero(H);
3494
+ return INT2FIX(0);*/
3495
+ }
3496
+ static VALUE rb_gsl_linalg_hesstri_decomp(int argc, VALUE *argv, VALUE module)
3497
+ {
3498
+ gsl_matrix *A = NULL, *B = NULL, *Anew, *Bnew;
3499
+ gsl_matrix *U = NULL, *V = NULL;
3500
+ gsl_vector *work = NULL;
3501
+ VALUE vH, vR, vU, vV, ary;
3502
+ int flag = 0;
3503
+ switch (argc) {
3504
+ case 2:
3505
+ flag = 1;
3506
+ break;
3507
+ case 3:
3508
+ CHECK_VECTOR(argv[2]);
3509
+ Data_Get_Struct(argv[2], gsl_vector, work);
3510
+ break;
3511
+ case 4:
3512
+ CHECK_MATRIX(argv[2]);
3513
+ CHECK_MATRIX(argv[3]);
3514
+ Data_Get_Struct(argv[2], gsl_matrix, U);
3515
+ Data_Get_Struct(argv[3], gsl_matrix, V);
3516
+ flag = 1;
3517
+ break;
3518
+ case 5:
3519
+ CHECK_MATRIX(argv[2]);
3520
+ CHECK_MATRIX(argv[3]);
3521
+ CHECK_VECTOR(argv[4]);
3522
+ Data_Get_Struct(argv[2], gsl_matrix, U);
3523
+ Data_Get_Struct(argv[3], gsl_matrix, V);
3524
+ Data_Get_Struct(argv[4], gsl_vector, work);
3525
+ vU = argv[2];
3526
+ vV = argv[3];
3527
+ break;
3528
+ default:
3529
+ rb_raise(rb_eArgError, "Wrong number of arguments (%d for 2-55)", argc);
3530
+ }
3531
+ CHECK_MATRIX(argv[0]);
3532
+ CHECK_MATRIX(argv[1]);
3533
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3534
+ Data_Get_Struct(argv[1], gsl_matrix, B);
3535
+ Anew = make_matrix_clone(A);
3536
+ Bnew = make_matrix_clone(B);
3537
+ if (flag == 1) work = gsl_vector_alloc(A->size1);
3538
+ gsl_linalg_hesstri_decomp(Anew, Bnew, U, V, work);
3539
+ if (flag == 1) gsl_vector_free(work);
3540
+ vH = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Anew);
3541
+ vR = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Bnew);
3542
+ if (argc == 2 || argc == 3) {
3543
+ ary = rb_ary_new3(2, vH, vR);
3544
+ } else {
3545
+ ary = rb_ary_new3(4, vH, vR, vU, vV);
3546
+ }
3547
+ return ary;
3548
+ }
3549
+ static VALUE rb_gsl_linalg_hesstri_decomp_bang(int argc, VALUE *argv, VALUE module)
3550
+ {
3551
+ gsl_matrix *A = NULL, *B = NULL;
3552
+ gsl_matrix *U = NULL, *V = NULL;
3553
+ gsl_vector *work = NULL;
3554
+ VALUE vH, vR, vU, vV, ary;
3555
+ int flag = 0;
3556
+ switch (argc) {
3557
+ case 2:
3558
+ flag = 1;
3559
+ break;
3560
+ case 3:
3561
+ CHECK_VECTOR(argv[2]);
3562
+ Data_Get_Struct(argv[2], gsl_vector, work);
3563
+ break;
3564
+ case 4:
3565
+ CHECK_MATRIX(argv[2]);
3566
+ CHECK_MATRIX(argv[3]);
3567
+ Data_Get_Struct(argv[2], gsl_matrix, U);
3568
+ Data_Get_Struct(argv[3], gsl_matrix, V);
3569
+ flag = 1;
3570
+ break;
3571
+ case 5:
3572
+ CHECK_MATRIX(argv[2]);
3573
+ CHECK_MATRIX(argv[3]);
3574
+ CHECK_VECTOR(argv[4]);
3575
+ Data_Get_Struct(argv[2], gsl_matrix, U);
3576
+ Data_Get_Struct(argv[3], gsl_matrix, V);
3577
+ Data_Get_Struct(argv[4], gsl_vector, work);
3578
+ vU = argv[2];
3579
+ vV = argv[3];
3580
+ break;
3581
+ default:
3582
+ rb_raise(rb_eArgError, "Wrong number of arguments (%d for 2-55)", argc);
3583
+ }
3584
+ CHECK_MATRIX(argv[0]);
3585
+ CHECK_MATRIX(argv[1]);
3586
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3587
+ Data_Get_Struct(argv[1], gsl_matrix, B);
3588
+ if (flag == 1) work = gsl_vector_alloc(A->size1);
3589
+ gsl_linalg_hesstri_decomp(A, B, U, V, work);
3590
+ if (flag == 1) gsl_vector_free(work);
3591
+ vH = argv[0];
3592
+ vR = argv[1];
3593
+ if (argc == 2 || argc == 3) {
3594
+ ary = rb_ary_new3(2, vH, vR);
3595
+ } else {
3596
+ ary = rb_ary_new3(4, vH, vR, vU, vV);
3597
+ }
3598
+ return ary;
3599
+ }
3600
+
3601
+ static VALUE rb_gsl_linalg_balance_matrix(int argc, VALUE *argv, VALUE module)
3602
+ {
3603
+ gsl_matrix *A, *Anew;
3604
+ gsl_vector *D;
3605
+ VALUE vA, vD;
3606
+ switch (argc) {
3607
+ case 1:
3608
+ CHECK_MATRIX(argv[0]);
3609
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3610
+ Anew = make_matrix_clone(A);
3611
+ D = gsl_vector_alloc(A->size1);
3612
+ vD = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, D);
3613
+ break;
3614
+ case 2:
3615
+ CHECK_MATRIX(argv[0]);
3616
+ CHECK_VECTOR(argv[1]);
3617
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3618
+ Data_Get_Struct(argv[1], gsl_vector, D);
3619
+ Anew = make_matrix_clone(A);
3620
+ vD = argv[1];
3621
+ break;
3622
+ default:
3623
+ rb_raise(rb_eArgError, "Wrong number of arguments (%d for 1 or 2)", argc);
3624
+ }
3625
+ gsl_linalg_balance_matrix(Anew, D);
3626
+ vA = Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Anew);
3627
+ return rb_ary_new3(2, vA, vD);
3628
+
3629
+ }
3630
+ static VALUE rb_gsl_linalg_balance_matrix2(int argc, VALUE *argv, VALUE module)
3631
+ {
3632
+ gsl_matrix *A;
3633
+ gsl_vector *D;
3634
+ switch (argc) {
3635
+ case 1:
3636
+ CHECK_MATRIX(argv[0]);
3637
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3638
+ D = gsl_vector_alloc(A->size1);
3639
+ gsl_linalg_balance_matrix(A, D);
3640
+ return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, D);
3641
+ break;
3642
+ case 2:
3643
+ CHECK_MATRIX(argv[0]);
3644
+ CHECK_VECTOR(argv[1]);
3645
+ Data_Get_Struct(argv[0], gsl_matrix, A);
3646
+ Data_Get_Struct(argv[1], gsl_vector, D);
3647
+ return INT2FIX(gsl_linalg_balance_matrix(A, D));
3648
+ break;
3649
+ default:
3650
+ rb_raise(rb_eArgError, "Wrong number of arguments (%d for 1 or 2)", argc);
3651
+ }
3652
+ return Qtrue;
3653
+ }
3654
+ #endif
3655
+
3656
+ void Init_gsl_linalg_complex(VALUE module);
3657
+ void Init_gsl_linalg(VALUE module)
3658
+ {
3659
+ VALUE mgsl_linalg;
3660
+ VALUE mgsl_linalg_LU;
3661
+ VALUE mgsl_linalg_QR;
3662
+ VALUE mgsl_linalg_QRPT;
3663
+ VALUE mgsl_linalg_LQ;
3664
+ VALUE mgsl_linalg_PTLQ;
3665
+ VALUE mgsl_linalg_SV;
3666
+ VALUE mgsl_linalg_cholesky;
3667
+ VALUE mgsl_linalg_symmtd;
3668
+ VALUE mgsl_linalg_hermtd;
3669
+ VALUE mgsl_linalg_bidiag;
3670
+ VALUE mgsl_linalg_tridiag;
3671
+ VALUE mgsl_linalg_HH;
3672
+ VALUE mgsl_linalg_Householder;
3673
+
3674
+ mgsl_linalg = rb_define_module_under(module, "Linalg");
3675
+ mgsl_linalg_LU = rb_define_module_under(mgsl_linalg, "LU");
3676
+ cgsl_matrix_LU = rb_define_class_under(mgsl_linalg_LU, "LUMatrix", cgsl_matrix);
3677
+ mgsl_linalg_QR = rb_define_module_under(mgsl_linalg, "QR");
3678
+ mgsl_linalg_QRPT = rb_define_module_under(mgsl_linalg, "QRPT");
3679
+ cgsl_matrix_QR = rb_define_class_under(mgsl_linalg, "QRMatrix", cgsl_matrix);
3680
+ cgsl_matrix_QRPT = rb_define_class_under(mgsl_linalg, "QRPTMatrix", cgsl_matrix);
3681
+ cgsl_vector_tau = rb_define_class_under(mgsl_linalg, "TauVector", cgsl_vector);
3682
+ cgsl_matrix_Q = rb_define_class_under(mgsl_linalg, "QMatrix", cgsl_matrix);
3683
+ cgsl_matrix_R = rb_define_class_under(mgsl_linalg, "RMatrix", cgsl_matrix);
3684
+
3685
+ mgsl_linalg_LQ = rb_define_module_under(mgsl_linalg, "LQ");
3686
+ mgsl_linalg_PTLQ = rb_define_module_under(mgsl_linalg, "PTLQ");
3687
+ cgsl_matrix_LQ = rb_define_class_under(mgsl_linalg, "LQMatrix", cgsl_matrix);
3688
+ cgsl_matrix_PTLQ = rb_define_class_under(mgsl_linalg, "PTLQMatrix", cgsl_matrix);
3689
+ cgsl_matrix_L = rb_define_class_under(mgsl_linalg, "LMatrix", cgsl_matrix);
3690
+
3691
+ /*****/
3692
+ mgsl_linalg_SV = rb_define_module_under(mgsl_linalg, "SV");
3693
+ cgsl_matrix_SV = rb_define_class_under(mgsl_linalg_SV, "SVMatrix", cgsl_matrix);
3694
+ cgsl_matrix_U = rb_define_class_under(mgsl_linalg_SV, "UMatrix", cgsl_matrix);
3695
+ cgsl_matrix_V = rb_define_class_under(mgsl_linalg_SV, "VMatrix", cgsl_matrix);
3696
+ cgsl_vector_S = rb_define_class_under(mgsl_linalg_SV, "SingularValues", cgsl_vector);
3697
+
3698
+ /*****/
3699
+ mgsl_linalg_cholesky = rb_define_module_under(mgsl_linalg, "Cholesky");
3700
+ cgsl_matrix_C = rb_define_class_under(mgsl_linalg_cholesky, "CholeskyMatrix", cgsl_matrix);
3701
+ mgsl_linalg_symmtd = rb_define_module_under(mgsl_linalg, "Symmtd");
3702
+
3703
+ mgsl_linalg_hermtd = rb_define_module_under(mgsl_linalg, "Hermtd");
3704
+ mgsl_linalg_bidiag = rb_define_module_under(mgsl_linalg, "Bidiag");
3705
+ mgsl_linalg_tridiag = rb_define_module_under(mgsl_linalg, "Tridiag");
3706
+
3707
+ mgsl_linalg_HH = rb_define_module_under(mgsl_linalg, "HH");
3708
+ mgsl_linalg_Householder = rb_define_module_under(mgsl_linalg, "Householder");
3709
+
3710
+ /*****/
3711
+ rb_define_module_function(mgsl_linalg, "LU_decomp!", rb_gsl_linalg_LU_decomp_bang, -1);
3712
+ rb_define_module_function(mgsl_linalg_LU, "decomp!", rb_gsl_linalg_LU_decomp_bang, -1);
3713
+ rb_define_module_function(mgsl_linalg, "LU_decomp", rb_gsl_linalg_LU_decomp, -1);
3714
+ rb_define_module_function(mgsl_linalg_LU, "decomp", rb_gsl_linalg_LU_decomp, -1);
3715
+ rb_define_method(cgsl_matrix, "LU_decomp!", rb_gsl_linalg_LU_decomp_bang, -1);
3716
+ rb_define_method(cgsl_matrix, "LU_decomp", rb_gsl_linalg_LU_decomp, -1);
3717
+
3718
+ rb_define_module_function(mgsl_linalg, "LU_solve", rb_gsl_linalg_LU_solve, -1);
3719
+ rb_define_module_function(mgsl_linalg_LU, "solve", rb_gsl_linalg_LU_solve, -1);
3720
+ rb_define_method(cgsl_matrix, "LU_solve", rb_gsl_linalg_LU_solve, -1);
3721
+ rb_define_method(cgsl_matrix_LU, "solve", rb_gsl_linalg_LU_solve, -1);
3722
+
3723
+ rb_define_module_function(mgsl_linalg, "LU_svx", rb_gsl_linalg_LU_svx, -1);
3724
+ rb_define_module_function(mgsl_linalg_LU, "svx", rb_gsl_linalg_LU_svx, -1);
3725
+ rb_define_method(cgsl_matrix, "LU_svx", rb_gsl_linalg_LU_svx, -1);
3726
+ rb_define_method(cgsl_matrix_LU, "svx", rb_gsl_linalg_LU_svx, -1);
3727
+
3728
+ rb_define_module_function(mgsl_linalg, "LU_invert", rb_gsl_linalg_LU_invert, -1);
3729
+ rb_define_module_function(mgsl_linalg_LU, "invert", rb_gsl_linalg_LU_invert, -1);
3730
+ rb_define_module_function(mgsl_linalg_LU, "inv", rb_gsl_linalg_LU_invert, -1);
3731
+ rb_define_module_function(mgsl_linalg_LU, "refine", rb_gsl_linalg_LU_refine, 5);
3732
+
3733
+ rb_define_method(cgsl_matrix, "invert", rb_gsl_linalg_LU_invert, -1);
3734
+ rb_define_alias(cgsl_matrix, "LU_invert", "invert");
3735
+ rb_define_alias(cgsl_matrix, "inv", "invert");
3736
+
3737
+ rb_define_module_function(mgsl_linalg, "LU_det", rb_gsl_linalg_LU_det, -1);
3738
+ rb_define_module_function(mgsl_linalg_LU, "det", rb_gsl_linalg_LU_det, -1);
3739
+ rb_define_method(cgsl_matrix, "LU_det", rb_gsl_linalg_LU_det, -1);
3740
+ rb_define_alias(cgsl_matrix, "det", "LU_det");
3741
+
3742
+ rb_define_module_function(mgsl_linalg, "LU_lndet", rb_gsl_linalg_LU_lndet, -1);
3743
+ rb_define_module_function(mgsl_linalg_LU, "lndet", rb_gsl_linalg_LU_lndet, -1);
3744
+ rb_define_method(cgsl_matrix, "LU_lndet", rb_gsl_linalg_LU_lndet, -1);
3745
+ rb_define_alias(cgsl_matrix, "lndet", "LU_lndet");
3746
+
3747
+ rb_define_module_function(mgsl_linalg, "LU_sgndet", rb_gsl_linalg_LU_sgndet, -1);
3748
+ rb_define_module_function(mgsl_linalg_LU, "sgndet", rb_gsl_linalg_LU_sgndet, -1);
3749
+ rb_define_method(cgsl_matrix, "LU_sgndet", rb_gsl_linalg_LU_sgndet, -1);
3750
+ rb_define_alias(cgsl_matrix, "sgndet", "LU_sgndet");
3751
+
3752
+ /*****/
3753
+ rb_define_module_function(mgsl_linalg, "QR_decomp", rb_gsl_linalg_QR_decomp, -1);
3754
+ rb_define_module_function(mgsl_linalg_QR, "decomp", rb_gsl_linalg_QR_decomp, -1);
3755
+ rb_define_method(cgsl_matrix, "QR_decomp", rb_gsl_linalg_QR_decomp, -1);
3756
+ rb_define_module_function(mgsl_linalg, "QR_decomp!", rb_gsl_linalg_QR_decomp_bang, -1);
3757
+ rb_define_module_function(mgsl_linalg_QR, "decomp!", rb_gsl_linalg_QR_decomp_bang, -1);
3758
+ rb_define_method(cgsl_matrix, "QR_decomp!", rb_gsl_linalg_QR_decomp_bang, -1);
3759
+
3760
+ rb_define_module_function(mgsl_linalg, "QR_solve", rb_gsl_linalg_QR_solve, -1);
3761
+ rb_define_module_function(mgsl_linalg_QR, "solve", rb_gsl_linalg_QR_solve, -1);
3762
+ rb_define_module_function(mgsl_linalg, "QR_svx", rb_gsl_linalg_QR_svx, -1);
3763
+ rb_define_module_function(mgsl_linalg_QR, "svx", rb_gsl_linalg_QR_svx, -1);
3764
+ rb_define_method(cgsl_matrix, "QR_solve", rb_gsl_linalg_QR_solve, -1);
3765
+ rb_define_method(cgsl_matrix_QR, "solve", rb_gsl_linalg_QR_solve, -1);
3766
+ rb_define_method(cgsl_matrix, "QR_svx", rb_gsl_linalg_QR_svx, -1);
3767
+ rb_define_method(cgsl_matrix_QR, "svx", rb_gsl_linalg_QR_svx, -1);
3768
+
3769
+ rb_define_module_function(mgsl_linalg_QR, "lssolve", rb_gsl_linalg_QR_lssolve, -1);
3770
+ rb_define_method(cgsl_matrix, "QR_lssolve", rb_gsl_linalg_QR_lssolve, -1);
3771
+ rb_define_method(cgsl_matrix_QR, "lssolve", rb_gsl_linalg_QR_lssolve, -1);
3772
+
3773
+ rb_define_module_function(mgsl_linalg_QR, "QTvec", rb_gsl_linalg_QR_QTvec, -1);
3774
+ rb_define_method(cgsl_matrix_QR, "QTvec", rb_gsl_linalg_QR_QTvec, -1);
3775
+ rb_define_module_function(mgsl_linalg_QR, "Qvec", rb_gsl_linalg_QR_Qvec, -1);
3776
+ rb_define_method(cgsl_matrix_QR, "Qvec", rb_gsl_linalg_QR_Qvec, -1);
3777
+
3778
+ rb_define_module_function(mgsl_linalg_QR, "Rsolve", rb_gsl_linalg_QR_Rsolve, -1);
3779
+ rb_define_method(cgsl_matrix, "QR_Rsolve", rb_gsl_linalg_QR_Rsolve, -1);
3780
+ rb_define_method(cgsl_matrix_QR, "Rsolve", rb_gsl_linalg_QR_Rsolve, -1);
3781
+
3782
+ rb_define_module_function(mgsl_linalg_QR, "Rsvx", rb_gsl_linalg_QR_Rsvx, -1);
3783
+ rb_define_method(cgsl_matrix_QR, "Rsvx", rb_gsl_linalg_QR_Rsvx, 1);
3784
+
3785
+ rb_define_module_function(mgsl_linalg_QR, "unpack", rb_gsl_linalg_QR_unpack, -1);
3786
+ rb_define_method(cgsl_matrix_QR, "unpack", rb_gsl_linalg_QR_unpack, -1);
3787
+
3788
+ rb_define_module_function(mgsl_linalg_QR, "QRsolve", rb_gsl_linalg_QR_QRsolve, -1);
3789
+ rb_define_module_function(mgsl_linalg_QR, "update", rb_gsl_linalg_QR_update, 4);
3790
+
3791
+ rb_define_method(mgsl_linalg, "R_solve", rb_gsl_linalg_R_solve, -1);
3792
+ rb_define_method(cgsl_matrix_R, "solve", rb_gsl_linalg_R_solve, -1);
3793
+ /*
3794
+ rb_define_method(cgsl_matrix_R, "svx", rb_gsl_linalg_R_svx, -1);
3795
+ */
3796
+ rb_define_module_function(mgsl_linalg_QRPT, "decomp", rb_gsl_linalg_QRPT_decomp, -1);
3797
+ rb_define_method(cgsl_matrix, "QRPT_decomp", rb_gsl_linalg_QRPT_decomp, -1);
3798
+ rb_define_module_function(mgsl_linalg_QRPT, "decomp!", rb_gsl_linalg_QRPT_decomp_bang, -1);
3799
+ rb_define_method(cgsl_matrix, "QRPT_decomp!", rb_gsl_linalg_QRPT_decomp_bang, -1);
3800
+
3801
+ rb_define_module_function(mgsl_linalg_QRPT, "decomp2", rb_gsl_linalg_QRPT_decomp2, -1);
3802
+ rb_define_method(cgsl_matrix, "QRPT_decomp2", rb_gsl_linalg_QRPT_decomp2, -1);
3803
+
3804
+ rb_define_module_function(mgsl_linalg_QRPT, "solve", rb_gsl_linalg_QRPT_solve, -1);
3805
+ rb_define_method(cgsl_matrix, "QRPT_solve", rb_gsl_linalg_QRPT_solve, -1);
3806
+ rb_define_method(cgsl_matrix_QRPT, "solve", rb_gsl_linalg_QRPT_solve, -1);
3807
+
3808
+ rb_define_module_function(mgsl_linalg_QRPT, "svx", rb_gsl_linalg_QRPT_svx, -1);
3809
+ rb_define_method(cgsl_matrix, "QRPT_svx", rb_gsl_linalg_QRPT_svx, -1);
3810
+ rb_define_method(cgsl_matrix_QRPT, "svx", rb_gsl_linalg_QRPT_svx, -1);
3811
+
3812
+ rb_define_module_function(mgsl_linalg_QRPT, "QRsolve", rb_gsl_linalg_QRPT_QRsolve, 4);
3813
+ rb_define_module_function(mgsl_linalg_QRPT, "update", rb_gsl_linalg_QRPT_update, 5);
3814
+
3815
+ rb_define_module_function(mgsl_linalg_QRPT, "Rsolve", rb_gsl_linalg_QRPT_Rsolve, -1);
3816
+ rb_define_method(cgsl_matrix_QRPT, "Rsolve", rb_gsl_linalg_QRPT_Rsolve, -1);
3817
+ rb_define_module_function(mgsl_linalg_QRPT, "Rsvx", rb_gsl_linalg_QRPT_Rsvx, -1);
3818
+ rb_define_method(cgsl_matrix_QRPT, "Rsvx", rb_gsl_linalg_QRPT_Rsvx, -1);
3819
+
3820
+ /*****/
3821
+ rb_define_module_function(mgsl_linalg_SV, "decomp", rb_gsl_linalg_SV_decomp, -1);
3822
+ rb_define_method(cgsl_matrix, "SV_decomp", rb_gsl_linalg_SV_decomp, -1);
3823
+ rb_define_alias(cgsl_matrix, "SVD", "SV_decomp");
3824
+ rb_define_alias(cgsl_matrix, "svd", "SV_decomp");
3825
+ rb_define_module_function(mgsl_linalg_SV, "decomp_mod", rb_gsl_linalg_SV_decomp_mod, -1);
3826
+ rb_define_method(cgsl_matrix, "SV_decomp_mod", rb_gsl_linalg_SV_decomp_mod, -1);
3827
+ rb_define_module_function(mgsl_linalg_SV, "decomp_jacobi", rb_gsl_linalg_SV_decomp_jacobi, -1);
3828
+ rb_define_method(cgsl_matrix, "SV_decomp_jacobi", rb_gsl_linalg_SV_decomp_jacobi, -1);
3829
+
3830
+ rb_define_module_function(mgsl_linalg_SV, "solve", rb_gsl_linalg_SV_solve, -1);
3831
+
3832
+ rb_define_method(cgsl_matrix, "SV_solve", rb_gsl_linalg_SV_solve, -1);
3833
+
3834
+ /*****/
3835
+ rb_define_module_function(mgsl_linalg_cholesky, "decomp", rb_gsl_linalg_cholesky_decomp, -1);
3836
+ rb_define_method(cgsl_matrix, "cholesky_decomp", rb_gsl_linalg_cholesky_decomp, -1);
3837
+
3838
+ rb_define_module_function(mgsl_linalg_cholesky, "solve", rb_gsl_linalg_cholesky_solve, -1);
3839
+ rb_define_method(cgsl_matrix, "cholesky_solve", rb_gsl_linalg_cholesky_solve, -1);
3840
+ rb_define_method(cgsl_matrix_C, "solve", rb_gsl_linalg_cholesky_solve, -1);
3841
+ rb_define_module_function(mgsl_linalg_cholesky, "svx", rb_gsl_linalg_cholesky_svx, -1);
3842
+ rb_define_method(cgsl_matrix, "cholesky_svx", rb_gsl_linalg_cholesky_svx, -1);
3843
+ rb_define_method(cgsl_matrix_C, "svx", rb_gsl_linalg_cholesky_svx, -1);
3844
+
3845
+ /*****/
3846
+
3847
+ rb_define_module_function(mgsl_linalg_symmtd, "decomp", rb_gsl_linalg_symmtd_decomp, -1);
3848
+ rb_define_method(cgsl_matrix, "symmtd_decomp", rb_gsl_linalg_symmtd_decomp, -1);
3849
+ rb_define_module_function(mgsl_linalg_symmtd, "decomp!", rb_gsl_linalg_symmtd_decomp2, -1);
3850
+ rb_define_method(cgsl_matrix, "symmtd_decomp!", rb_gsl_linalg_symmtd_decomp2, -1);
3851
+
3852
+ rb_define_method(cgsl_matrix, "symmtd_unpack", rb_gsl_linalg_symmtd_unpack, -1);
3853
+ rb_define_method(cgsl_matrix, "symmtd_unpack_T", rb_gsl_linalg_symmtd_unpack_T, -1);
3854
+
3855
+ rb_define_module_function(mgsl_linalg_symmtd, "unpack", rb_gsl_linalg_symmtd_unpack, -1);
3856
+ rb_define_module_function(mgsl_linalg_symmtd, "unpack_T", rb_gsl_linalg_symmtd_unpack_T, -1);
3857
+ /*****/
3858
+ rb_define_module_function(mgsl_linalg_hermtd, "decomp", rb_gsl_linalg_hermtd_decomp, -1);
3859
+ rb_define_method(cgsl_matrix, "hermtd_decomp", rb_gsl_linalg_hermtd_decomp, -1);
3860
+ rb_define_module_function(mgsl_linalg_hermtd, "decomp!", rb_gsl_linalg_hermtd_decomp2, -1);
3861
+ rb_define_method(cgsl_matrix, "hermtd_decomp!", rb_gsl_linalg_hermtd_decomp2, -1);
3862
+
3863
+ rb_define_method(cgsl_matrix_complex, "hermtd_unpack", rb_gsl_linalg_hermtd_unpack, -1);
3864
+ rb_define_module_function(mgsl_linalg_hermtd, "unpack", rb_gsl_linalg_hermtd_unpack, -1);
3865
+ rb_define_method(cgsl_matrix_complex, "hermtd_unpack_T", rb_gsl_linalg_hermtd_unpack_T, -1);
3866
+ rb_define_module_function(mgsl_linalg_hermtd, "unpack_T", rb_gsl_linalg_hermtd_unpack_T, -1);
3867
+
3868
+ /*****/
3869
+ rb_define_method(cgsl_matrix, "bidiag_decomp", rb_gsl_linalg_bidiag_decomp, -1);
3870
+ rb_define_method(cgsl_matrix, "bidiag_decomp!", rb_gsl_linalg_bidiag_decomp2, -1);
3871
+
3872
+ rb_define_module_function(mgsl_linalg, "bidiag_decomp", rb_gsl_linalg_bidiag_decomp, -1);
3873
+ rb_define_module_function(mgsl_linalg, "bidiag_decomp!", rb_gsl_linalg_bidiag_decomp2, -1);
3874
+ rb_define_module_function(mgsl_linalg_bidiag, "decomp", rb_gsl_linalg_bidiag_decomp, -1);
3875
+ rb_define_module_function(mgsl_linalg_bidiag, "decomp!", rb_gsl_linalg_bidiag_decomp2, -1);
3876
+
3877
+ rb_define_method(cgsl_matrix, "bidiag_unpack", rb_gsl_linalg_bidiag_unpack, -1);
3878
+ rb_define_method(cgsl_matrix, "bidiag_unpack2", rb_gsl_linalg_bidiag_unpack2, -1);
3879
+ rb_define_module_function(mgsl_linalg, "bidiag_unpack", rb_gsl_linalg_bidiag_unpack, -1);
3880
+ rb_define_module_function(mgsl_linalg, "bidiag_unpack2", rb_gsl_linalg_bidiag_unpack2, -1);
3881
+ rb_define_module_function(mgsl_linalg_bidiag, "unpack", rb_gsl_linalg_bidiag_unpack, -1);
3882
+ rb_define_module_function(mgsl_linalg_bidiag, "unpack2", rb_gsl_linalg_bidiag_unpack2, -1);
3883
+
3884
+ rb_define_method(cgsl_matrix, "bidiag_unpack_B", rb_gsl_linalg_bidiag_unpack_B, -1);
3885
+ rb_define_module_function(mgsl_linalg, "bidiag_unpack_B", rb_gsl_linalg_bidiag_unpack_B, -1);
3886
+ rb_define_module_function(mgsl_linalg_bidiag, "unpack_B", rb_gsl_linalg_bidiag_unpack_B, -1);
3887
+ /*****/
3888
+ rb_define_module_function(mgsl_linalg, "householder_transform",
3889
+ rb_gsl_linalg_householder_transform, -1);
3890
+ rb_define_module_function(mgsl_linalg_Householder, "transform",
3891
+ rb_gsl_linalg_householder_transform, -1);
3892
+ rb_define_module_function(mgsl_linalg_HH, "transform",
3893
+ rb_gsl_linalg_householder_transform, -1);
3894
+ rb_define_method(cgsl_vector, "householder_transform",
3895
+ rb_gsl_linalg_householder_transform, -1);
3896
+
3897
+ rb_define_module_function(mgsl_linalg, "householder_hm",
3898
+ rb_gsl_linalg_householder_hm, 3);
3899
+ rb_define_module_function(mgsl_linalg_Householder, "hm",
3900
+ rb_gsl_linalg_householder_hm, 3);
3901
+ rb_define_module_function(mgsl_linalg_HH, "hm",
3902
+ rb_gsl_linalg_householder_hm, 3);
3903
+
3904
+ rb_define_module_function(mgsl_linalg, "householder_mh",
3905
+ rb_gsl_linalg_householder_mh, 3);
3906
+ rb_define_module_function(mgsl_linalg_Householder, "mh",
3907
+ rb_gsl_linalg_householder_mh, 3);
3908
+ rb_define_module_function(mgsl_linalg_HH, "mh",
3909
+ rb_gsl_linalg_householder_mh, 3);
3910
+
3911
+ rb_define_module_function(mgsl_linalg, "householder_hv",
3912
+ rb_gsl_linalg_householder_hv, 3);
3913
+ rb_define_module_function(mgsl_linalg_Householder, "hv",
3914
+ rb_gsl_linalg_householder_hv, 3);
3915
+ rb_define_module_function(mgsl_linalg_HH, "hv",
3916
+ rb_gsl_linalg_householder_hv, 3);
3917
+
3918
+ rb_define_module_function(mgsl_linalg_HH, "solve", rb_gsl_linalg_HH_solve, -1);
3919
+ rb_define_module_function(mgsl_linalg_HH, "solve!", rb_gsl_linalg_HH_solve_bang, -1);
3920
+ rb_define_method(cgsl_matrix, "HH_solve", rb_gsl_linalg_HH_solve, -1);
3921
+ rb_define_method(cgsl_matrix, "HH_solve!", rb_gsl_linalg_HH_solve_bang, -1);
3922
+ rb_define_module_function(mgsl_linalg_HH, "svx", rb_gsl_linalg_HH_svx, -1);
3923
+ rb_define_method(cgsl_matrix, "HH_svx", rb_gsl_linalg_HH_svx, -1);
3924
+
3925
+ /*****/
3926
+
3927
+ rb_define_module_function(mgsl_linalg, "solve_symm_tridiag", rb_gsl_linalg_solve_symm_tridiag, 3);
3928
+
3929
+ rb_define_module_function(mgsl_linalg_tridiag, "solve_symm", rb_gsl_linalg_solve_symm_tridiag, 3);
3930
+
3931
+ #ifdef GSL_1_2_LATER
3932
+ rb_define_module_function(mgsl_linalg, "solve_tridiag", rb_gsl_linalg_solve_tridiag, 4);
3933
+ rb_define_module_function(mgsl_linalg_tridiag, "solve", rb_gsl_linalg_solve_tridiag, 4);
3934
+ rb_define_module_function(mgsl_linalg, "solve_symm_cyc_tridiag", rb_gsl_linalg_solve_symm_cyc_tridiag, 3);
3935
+ rb_define_module_function(mgsl_linalg, "solve_cyc_tridiag", rb_gsl_linalg_solve_cyc_tridiag, 4);
3936
+ rb_define_module_function(mgsl_linalg_tridiag, "solve_symm_cyc", rb_gsl_linalg_solve_symm_cyc_tridiag, 3);
3937
+ rb_define_module_function(mgsl_linalg_tridiag, "solve_cyc", rb_gsl_linalg_solve_cyc_tridiag, 4);
3938
+ #endif
3939
+
3940
+ /*****/
3941
+ rb_define_module_function(mgsl_linalg, "balance_columns!",
3942
+ rb_gsl_linalg_balance_columns_bang, -1);
3943
+ rb_define_method(cgsl_matrix, "balance_columns!",
3944
+ rb_gsl_linalg_balance_columns_bang, -1);
3945
+ rb_define_module_function(mgsl_linalg, "balance_columns",
3946
+ rb_gsl_linalg_balance_columns, -1);
3947
+ rb_define_method(cgsl_matrix, "balance_columns",
3948
+ rb_gsl_linalg_balance_columns, -1);
3949
+ rb_define_alias(cgsl_matrix, "balance", "balance_columns");
3950
+ rb_define_alias(cgsl_matrix, "balanc", "balance_columns");
3951
+ /*****/
3952
+
3953
+ Init_gsl_linalg_complex(mgsl_linalg);
3954
+
3955
+ /** GSL-1.6 **/
3956
+ #ifdef GSL_1_6_LATER
3957
+ rb_define_module_function(mgsl_linalg, "LQ_decomp", rb_gsl_linalg_LQ_decomp, -1);
3958
+ rb_define_module_function(mgsl_linalg_LQ, "decomp", rb_gsl_linalg_LQ_decomp, -1);
3959
+ rb_define_method(cgsl_matrix, "LQ_decomp", rb_gsl_linalg_LQ_decomp, -1);
3960
+ rb_define_module_function(mgsl_linalg, "LQ_decomp!", rb_gsl_linalg_LQ_decomp_bang, -1);
3961
+ rb_define_module_function(mgsl_linalg_LQ, "decomp!", rb_gsl_linalg_LQ_decomp_bang, -1);
3962
+ rb_define_method(cgsl_matrix, "LQ_decomp!", rb_gsl_linalg_LQ_decomp_bang, -1);
3963
+
3964
+ rb_define_module_function(mgsl_linalg, "LQ_solve_T", rb_gsl_linalg_LQ_solve, -1);
3965
+ rb_define_module_function(mgsl_linalg_LQ, "solve_T", rb_gsl_linalg_LQ_solve, -1);
3966
+ rb_define_module_function(mgsl_linalg, "LQ_svx_T", rb_gsl_linalg_LQ_svx, -1);
3967
+ rb_define_module_function(mgsl_linalg_LQ, "svx_T", rb_gsl_linalg_LQ_svx, -1);
3968
+ rb_define_method(cgsl_matrix, "LQ_solve_T", rb_gsl_linalg_LQ_solve, -1);
3969
+ rb_define_method(cgsl_matrix_LQ, "solve_T", rb_gsl_linalg_LQ_solve, -1);
3970
+ rb_define_method(cgsl_matrix, "LQ_svx_T", rb_gsl_linalg_LQ_svx, -1);
3971
+ rb_define_method(cgsl_matrix_LQ, "svx_T", rb_gsl_linalg_LQ_svx, -1);
3972
+
3973
+ rb_define_module_function(mgsl_linalg_LQ, "lssolve_T", rb_gsl_linalg_LQ_lssolve, -1);
3974
+ rb_define_method(cgsl_matrix, "LQ_lssolve_T", rb_gsl_linalg_LQ_lssolve, -1);
3975
+ rb_define_method(cgsl_matrix_LQ, "lssolve_T", rb_gsl_linalg_LQ_lssolve, -1);
3976
+
3977
+ rb_define_module_function(mgsl_linalg_LQ, "vecQT", rb_gsl_linalg_LQ_vecQT, -1);
3978
+ rb_define_method(cgsl_matrix_LQ, "vecQT", rb_gsl_linalg_LQ_vecQT, -1);
3979
+ rb_define_module_function(mgsl_linalg_LQ, "vecQ", rb_gsl_linalg_LQ_vecQ, -1);
3980
+ rb_define_method(cgsl_matrix_LQ, "vecQ", rb_gsl_linalg_LQ_vecQ, -1);
3981
+
3982
+ rb_define_module_function(mgsl_linalg_LQ, "Lsolve_T", rb_gsl_linalg_LQ_Lsolve, -1);
3983
+ rb_define_method(cgsl_matrix, "LQ_Lsolve_T", rb_gsl_linalg_LQ_Lsolve, -1);
3984
+ rb_define_method(cgsl_matrix_LQ, "Lsolve_T", rb_gsl_linalg_LQ_Lsolve, -1);
3985
+
3986
+ rb_define_module_function(mgsl_linalg_LQ, "Lsvx_T", rb_gsl_linalg_LQ_Lsvx, -1);
3987
+ rb_define_method(cgsl_matrix_LQ, "Lsvx_T", rb_gsl_linalg_LQ_Lsvx, 1);
3988
+
3989
+ rb_define_module_function(mgsl_linalg_LQ, "unpack", rb_gsl_linalg_LQ_unpack, -1);
3990
+ rb_define_method(cgsl_matrix_LQ, "unpack", rb_gsl_linalg_LQ_unpack, -1);
3991
+
3992
+ rb_define_module_function(mgsl_linalg_LQ, "LQsolve_T", rb_gsl_linalg_LQ_LQsolve, -1);
3993
+ rb_define_module_function(mgsl_linalg_LQ, "update", rb_gsl_linalg_LQ_update, 4);
3994
+
3995
+ rb_define_method(mgsl_linalg, "L_solve_T", rb_gsl_linalg_L_solve, -1);
3996
+ rb_define_method(cgsl_matrix_L, "solve_T", rb_gsl_linalg_L_solve, -1);
3997
+ /*
3998
+ rb_define_method(cgsl_matrix_R, "svx", rb_gsl_linalg_R_svx, -1);
3999
+ */
4000
+ rb_define_module_function(mgsl_linalg_PTLQ, "decomp", rb_gsl_linalg_PTLQ_decomp, -1);
4001
+ rb_define_method(cgsl_matrix, "PTLQ_decomp", rb_gsl_linalg_PTLQ_decomp, -1);
4002
+ rb_define_module_function(mgsl_linalg_PTLQ, "decomp!", rb_gsl_linalg_PTLQ_decomp_bang, -1);
4003
+ rb_define_method(cgsl_matrix, "PTLQ_decomp!", rb_gsl_linalg_PTLQ_decomp_bang, -1);
4004
+
4005
+ rb_define_module_function(mgsl_linalg_PTLQ, "decomp2", rb_gsl_linalg_PTLQ_decomp2, -1);
4006
+ rb_define_method(cgsl_matrix, "PTLQ_decomp2", rb_gsl_linalg_PTLQ_decomp2, -1);
4007
+
4008
+ rb_define_module_function(mgsl_linalg_PTLQ, "solve_T", rb_gsl_linalg_PTLQ_solve, -1);
4009
+ rb_define_method(cgsl_matrix, "PTLQ_solve_T", rb_gsl_linalg_PTLQ_solve, -1);
4010
+ rb_define_method(cgsl_matrix_PTLQ, "solve_T", rb_gsl_linalg_PTLQ_solve, -1);
4011
+
4012
+ rb_define_module_function(mgsl_linalg_PTLQ, "svx_T", rb_gsl_linalg_PTLQ_svx, -1);
4013
+ rb_define_method(cgsl_matrix, "PTLQ_svx_T", rb_gsl_linalg_PTLQ_svx, -1);
4014
+ rb_define_method(cgsl_matrix_PTLQ, "svx_T", rb_gsl_linalg_PTLQ_svx, -1);
4015
+
4016
+ rb_define_module_function(mgsl_linalg_PTLQ, "LQsolve_T", rb_gsl_linalg_PTLQ_LQsolve, 4);
4017
+ rb_define_module_function(mgsl_linalg_PTLQ, "update", rb_gsl_linalg_PTLQ_update, 5);
4018
+
4019
+ rb_define_module_function(mgsl_linalg_PTLQ, "Lsolve_T", rb_gsl_linalg_PTLQ_Lsolve, -1);
4020
+ rb_define_method(cgsl_matrix_PTLQ, "Lsolve_T", rb_gsl_linalg_PTLQ_Lsolve, -1);
4021
+ rb_define_module_function(mgsl_linalg_PTLQ, "Lsvx_T", rb_gsl_linalg_PTLQ_Lsvx, -1);
4022
+ rb_define_method(cgsl_matrix_PTLQ, "Lsvx_T", rb_gsl_linalg_PTLQ_Lsvx, -1);
4023
+
4024
+ #endif
4025
+
4026
+ #ifdef GSL_1_9_LATER
4027
+ VALUE mhessen;
4028
+ mhessen = rb_define_module_under(mgsl_linalg, "Hessenberg");
4029
+ rb_define_module_function(mhessen, "decomp", rb_gsl_linalg_hessenberg_decomp, 1);
4030
+ rb_define_module_function(mgsl_linalg, "heesenberg_decomp", rb_gsl_linalg_hessenberg_decomp, 1);
4031
+ rb_define_module_function(mhessen, "unpack", rb_gsl_linalg_hessenberg_unpack, 2);
4032
+ rb_define_module_function(mgsl_linalg, "hessenberg_unpack", rb_gsl_linalg_hessenberg_unpack, 2);
4033
+ rb_define_module_function(mhessen, "unpack_accum", rb_gsl_linalg_hessenberg_unpack_accum, -1);
4034
+ rb_define_module_function(mgsl_linalg, "hessenberg_unpack_accum", rb_gsl_linalg_hessenberg_unpack_accum, -1);
4035
+ rb_define_module_function(mhessen, "set_zero", rb_gsl_linalg_hessenberg_set_zero, 1);
4036
+ rb_define_module_function(mgsl_linalg, "hessenberg_set_zero", rb_gsl_linalg_hessenberg_set_zero, 1);
4037
+
4038
+ rb_define_module_function(mgsl_linalg, "hesstri_decomp", rb_gsl_linalg_hesstri_decomp, -1);
4039
+ rb_define_module_function(mgsl_linalg, "hesstri_decomp!", rb_gsl_linalg_hesstri_decomp_bang, -1);
4040
+
4041
+ rb_define_module_function(mgsl_linalg, "balance_matrix", rb_gsl_linalg_balance_matrix, -1);
4042
+ rb_define_module_function(mgsl_linalg, "balance_matrix!", rb_gsl_linalg_balance_matrix2, -1);
4043
+ rb_define_module_function(mgsl_linalg, "balance", rb_gsl_linalg_balance_matrix, -1);
4044
+ rb_define_module_function(mgsl_linalg, "balance!", rb_gsl_linalg_balance_matrix2, -1);
4045
+ #endif
4046
+
4047
+ }