numo-linalg-alt 0.2.0 → 0.4.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (55) hide show
  1. checksums.yaml +4 -4
  2. data/CHANGELOG.md +10 -1
  3. data/README.md +3 -1
  4. data/ext/numo/linalg/blas/dot.c +59 -59
  5. data/ext/numo/linalg/blas/dot_sub.c +58 -58
  6. data/ext/numo/linalg/blas/gemm.c +157 -148
  7. data/ext/numo/linalg/blas/gemv.c +131 -127
  8. data/ext/numo/linalg/blas/nrm2.c +50 -50
  9. data/ext/numo/linalg/lapack/gees.c +276 -0
  10. data/ext/numo/linalg/lapack/gees.h +15 -0
  11. data/ext/numo/linalg/lapack/geev.c +127 -110
  12. data/ext/numo/linalg/lapack/gelsd.c +81 -70
  13. data/ext/numo/linalg/lapack/geqrf.c +52 -51
  14. data/ext/numo/linalg/lapack/gerqf.c +70 -0
  15. data/ext/numo/linalg/lapack/gerqf.h +15 -0
  16. data/ext/numo/linalg/lapack/gesdd.c +96 -86
  17. data/ext/numo/linalg/lapack/gesv.c +80 -78
  18. data/ext/numo/linalg/lapack/gesvd.c +140 -129
  19. data/ext/numo/linalg/lapack/getrf.c +51 -50
  20. data/ext/numo/linalg/lapack/getri.c +64 -63
  21. data/ext/numo/linalg/lapack/getrs.c +92 -88
  22. data/ext/numo/linalg/lapack/gges.c +214 -0
  23. data/ext/numo/linalg/lapack/gges.h +15 -0
  24. data/ext/numo/linalg/lapack/heev.c +54 -52
  25. data/ext/numo/linalg/lapack/heevd.c +54 -52
  26. data/ext/numo/linalg/lapack/heevr.c +109 -98
  27. data/ext/numo/linalg/lapack/hegv.c +77 -74
  28. data/ext/numo/linalg/lapack/hegvd.c +77 -74
  29. data/ext/numo/linalg/lapack/hegvx.c +132 -120
  30. data/ext/numo/linalg/lapack/hetrf.c +54 -50
  31. data/ext/numo/linalg/lapack/lange.c +45 -44
  32. data/ext/numo/linalg/lapack/orgqr.c +63 -62
  33. data/ext/numo/linalg/lapack/orgrq.c +78 -0
  34. data/ext/numo/linalg/lapack/orgrq.h +15 -0
  35. data/ext/numo/linalg/lapack/potrf.c +49 -48
  36. data/ext/numo/linalg/lapack/potri.c +49 -48
  37. data/ext/numo/linalg/lapack/potrs.c +74 -72
  38. data/ext/numo/linalg/lapack/syev.c +54 -52
  39. data/ext/numo/linalg/lapack/syevd.c +54 -52
  40. data/ext/numo/linalg/lapack/syevr.c +107 -98
  41. data/ext/numo/linalg/lapack/sygv.c +77 -73
  42. data/ext/numo/linalg/lapack/sygvd.c +77 -73
  43. data/ext/numo/linalg/lapack/sygvx.c +132 -120
  44. data/ext/numo/linalg/lapack/sytrf.c +54 -50
  45. data/ext/numo/linalg/lapack/trtrs.c +79 -75
  46. data/ext/numo/linalg/lapack/ungqr.c +63 -62
  47. data/ext/numo/linalg/lapack/ungrq.c +78 -0
  48. data/ext/numo/linalg/lapack/ungrq.h +15 -0
  49. data/ext/numo/linalg/linalg.c +21 -10
  50. data/ext/numo/linalg/linalg.h +5 -0
  51. data/ext/numo/linalg/util.c +8 -0
  52. data/ext/numo/linalg/util.h +1 -0
  53. data/lib/numo/linalg/version.rb +1 -1
  54. data/lib/numo/linalg.rb +322 -0
  55. metadata +14 -4
data/ext/numo/linalg/lapack/gees.c ADDED
@@ -0,0 +1,276 @@
1
+ #include "gees.h"
2
+
3
+ #define DEF_GEES_OPTION(fLapackFunc, tSelectFunc) \
4
+ struct _gees_option_##fLapackFunc { \
5
+ int matrix_layout; \
6
+ char jobvs; \
7
+ char sort; \
8
+ tSelectFunc select; \
9
+ };
10
+
11
+ #define DEF_GEES_SORT_FUNC(tDType, fLapackFunc) \
12
+ lapack_logical _sort_nil_##fLapackFunc(const tDType* wr, const tDType* wi) { \
13
+ return 0; \
14
+ } \
15
+ lapack_logical _sort_lhp_##fLapackFunc(const tDType* wr, const tDType* wi) { \
16
+ if (*wr < (tDType)0) { \
17
+ return 1; \
18
+ } \
19
+ return 0; \
20
+ } \
21
+ lapack_logical _sort_rhp_##fLapackFunc(const tDType* wr, const tDType* wi) { \
22
+ if (*wr >= (tDType)0) { \
23
+ return 1; \
24
+ } \
25
+ return 0; \
26
+ } \
27
+ lapack_logical _sort_iup_##fLapackFunc(const tDType* wr, const tDType* wi) { \
28
+ tDType magnitude = *wr * *wr + *wi * *wi; \
29
+ if (magnitude <= (tDType)1) { \
30
+ return 1; \
31
+ } \
32
+ return 0; \
33
+ } \
34
+ lapack_logical _sort_ouc_##fLapackFunc(const tDType* wr, const tDType* wi) { \
35
+ tDType magnitude = *wr * *wr + *wi * *wi; \
36
+ if (magnitude > (tDType)1) { \
37
+ return 1; \
38
+ } \
39
+ return 0; \
40
+ }
41
+
42
+ #define DEF_GEES_SORT_FUNC_COMPLEX( \
43
+ tDType, tElType, fLapackRealFunc, fLapackImagFunc, fLapackFunc \
44
+ ) \
45
+ lapack_logical _sort_nil_##fLapackFunc(const tDType* w) { \
46
+ return 0; \
47
+ } \
48
+ lapack_logical _sort_lhp_##fLapackFunc(const tDType* w) { \
49
+ if (fLapackRealFunc(*w) < 0.0) { \
50
+ return 1; \
51
+ } \
52
+ return 0; \
53
+ } \
54
+ lapack_logical _sort_rhp_##fLapackFunc(const tDType* w) { \
55
+ if (fLapackRealFunc(*w) >= 0.0) { \
56
+ return 1; \
57
+ } \
58
+ return 0; \
59
+ } \
60
+ lapack_logical _sort_iup_##fLapackFunc(const tDType* w) { \
61
+ tElType real = fLapackRealFunc(*w); \
62
+ tElType imag = fLapackImagFunc(*w); \
63
+ tElType magnitude = real * real + imag * imag; \
64
+ if (magnitude <= (tElType)1.0) { \
65
+ return 1; \
66
+ } \
67
+ return 0; \
68
+ } \
69
+ lapack_logical _sort_ouc_##fLapackFunc(const tDType* w) { \
70
+ tElType real = fLapackRealFunc(*w); \
71
+ tElType imag = fLapackImagFunc(*w); \
72
+ tElType magnitude = real * real + imag * imag; \
73
+ if (magnitude > (tElType)1.0) { \
74
+ return 1; \
75
+ } \
76
+ return 0; \
77
+ }
78
+
79
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
80
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
81
+ tDType* a = (tDType*)(NDL_PTR(lp, 0)); \
82
+ tDType* wr = (tDType*)(NDL_PTR(lp, 1)); \
83
+ tDType* wi = (tDType*)(NDL_PTR(lp, 2)); \
84
+ tDType* vs = (tDType*)(NDL_PTR(lp, 3)); \
85
+ int* sdim = (int*)(NDL_PTR(lp, 4)); \
86
+ int* info = (int*)(NDL_PTR(lp, 5)); \
87
+ struct _gees_option_##fLapackFunc* opt = \
88
+ (struct _gees_option_##fLapackFunc*)(lp->opt_ptr); \
89
+ const lapack_int n = \
90
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
91
+ : NDL_SHAPE(lp, 0)[1]); \
92
+ const lapack_int lda = n; \
93
+ const lapack_int ldvs = (opt->jobvs == 'N') ? 1 : n; \
94
+ lapack_int s = 0; \
95
+ lapack_int i = LAPACKE_##fLapackFunc( \
96
+ opt->matrix_layout, opt->jobvs, opt->sort, opt->select, n, a, lda, &s, wr, wi, vs, ldvs \
97
+ ); \
98
+ *sdim = (int)s; \
99
+ *info = (int)i; \
100
+ } \
101
+ \
102
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
103
+ VALUE a_vnary = Qnil; \
104
+ VALUE kw_args = Qnil; \
105
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
106
+ ID kw_table[3] = { rb_intern("order"), rb_intern("jobvs"), rb_intern("sort") }; \
107
+ VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
108
+ rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
109
+ const int matrix_layout = \
110
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
111
+ const char jobvs = kw_values[1] != Qundef ? get_jobvs(kw_values[1]) : 'V'; \
112
+ VALUE sort_val = kw_values[2] != Qundef ? kw_values[2] : Qnil; \
113
+ const char sort_ch = NIL_P(sort_val) ? 'N' : 'S'; \
114
+ \
115
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
116
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
117
+ } \
118
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
119
+ a_vnary = nary_dup(a_vnary); \
120
+ } \
121
+ \
122
+ narray_t* a_nary = NULL; \
123
+ GetNArray(a_vnary, a_nary); \
124
+ if (NA_NDIM(a_nary) != 2) { \
125
+ rb_raise(rb_eArgError, "input array must be 2-dimensional array"); \
126
+ return Qnil; \
127
+ } \
128
+ \
129
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
130
+ size_t shape_wr[1] = { n }; \
131
+ size_t shape_wi[1] = { n }; \
132
+ size_t shape_vs[2] = { n, jobvs == 'N' ? 1 : n }; \
133
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
134
+ ndfunc_arg_out_t aout[5] = { { tNAryClass, 1, shape_wr }, \
135
+ { tNAryClass, 1, shape_wi }, \
136
+ { tNAryClass, 2, shape_vs }, \
137
+ { numo_cInt32, 0 }, \
138
+ { numo_cInt32, 0 } }; \
139
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 5, ain, aout }; \
140
+ struct _gees_option_##fLapackFunc opt = { matrix_layout, jobvs, sort_ch, NULL }; \
141
+ const char* sort_str = NIL_P(sort_val) ? "" : StringValueCStr(sort_val); \
142
+ if (NIL_P(sort_val)) { \
143
+ opt.select = _sort_nil_##fLapackFunc; \
144
+ } else if (strcmp(sort_str, "lhp") == 0) { \
145
+ opt.select = _sort_lhp_##fLapackFunc; \
146
+ } else if (strcmp(sort_str, "rhp") == 0) { \
147
+ opt.select = _sort_rhp_##fLapackFunc; \
148
+ } else if (strcmp(sort_str, "iup") == 0) { \
149
+ opt.select = _sort_iup_##fLapackFunc; \
150
+ } else if (strcmp(sort_str, "ouc") == 0) { \
151
+ opt.select = _sort_ouc_##fLapackFunc; \
152
+ } else { \
153
+ rb_raise(rb_eArgError, "invalid value for sort option"); \
154
+ return Qnil; \
155
+ } \
156
+ VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
157
+ VALUE ret = rb_ary_concat(rb_ary_new3(1, a_vnary), res); \
158
+ \
159
+ RB_GC_GUARD(sort_val); \
160
+ RB_GC_GUARD(a_vnary); \
161
+ return ret; \
162
+ }
163
+
164
+ #define DEF_LINALG_FUNC_COMPLEX(tDType, tNAryClass, fLapackFunc) \
165
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
166
+ tDType* a = (tDType*)(NDL_PTR(lp, 0)); \
167
+ tDType* w = (tDType*)(NDL_PTR(lp, 1)); \
168
+ tDType* vs = (tDType*)(NDL_PTR(lp, 2)); \
169
+ int* sdim = (int*)(NDL_PTR(lp, 3)); \
170
+ int* info = (int*)(NDL_PTR(lp, 4)); \
171
+ struct _gees_option_##fLapackFunc* opt = \
172
+ (struct _gees_option_##fLapackFunc*)(lp->opt_ptr); \
173
+ const lapack_int n = \
174
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
175
+ : NDL_SHAPE(lp, 0)[1]); \
176
+ const lapack_int lda = n; \
177
+ const lapack_int ldvs = (opt->jobvs == 'N') ? 1 : n; \
178
+ lapack_int s = 0; \
179
+ lapack_int i = LAPACKE_##fLapackFunc( \
180
+ opt->matrix_layout, opt->jobvs, opt->sort, opt->select, n, a, lda, &s, w, vs, ldvs \
181
+ ); \
182
+ *sdim = (int)s; \
183
+ *info = (int)i; \
184
+ } \
185
+ \
186
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
187
+ VALUE a_vnary = Qnil; \
188
+ VALUE kw_args = Qnil; \
189
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
190
+ ID kw_table[3] = { rb_intern("order"), rb_intern("jobvs"), rb_intern("sort") }; \
191
+ VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
192
+ rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
193
+ const int matrix_layout = \
194
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
195
+ const char jobvs = kw_values[1] != Qundef ? get_jobvs(kw_values[1]) : 'V'; \
196
+ VALUE sort_val = kw_values[2] != Qundef ? kw_values[2] : Qnil; \
197
+ const char sort_ch = NIL_P(sort_val) ? 'N' : 'S'; \
198
+ \
199
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
200
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
201
+ } \
202
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
203
+ a_vnary = nary_dup(a_vnary); \
204
+ } \
205
+ \
206
+ narray_t* a_nary = NULL; \
207
+ GetNArray(a_vnary, a_nary); \
208
+ if (NA_NDIM(a_nary) != 2) { \
209
+ rb_raise(rb_eArgError, "input array must be 2-dimensional array"); \
210
+ return Qnil; \
211
+ } \
212
+ \
213
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
214
+ size_t shape_w[1] = { n }; \
215
+ size_t shape_vs[2] = { n, jobvs == 'N' ? 1 : n }; \
216
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
217
+ ndfunc_arg_out_t aout[4] = { { tNAryClass, 1, shape_w }, \
218
+ { tNAryClass, 2, shape_vs }, \
219
+ { numo_cInt32, 0 }, \
220
+ { numo_cInt32, 0 } }; \
221
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout }; \
222
+ struct _gees_option_##fLapackFunc opt = { matrix_layout, jobvs, sort_ch, NULL }; \
223
+ const char* sort_str = NIL_P(sort_val) ? "" : StringValueCStr(sort_val); \
224
+ if (NIL_P(sort_val)) { \
225
+ opt.select = _sort_nil_##fLapackFunc; \
226
+ } else if (strcmp(sort_str, "lhp") == 0) { \
227
+ opt.select = _sort_lhp_##fLapackFunc; \
228
+ } else if (strcmp(sort_str, "rhp") == 0) { \
229
+ opt.select = _sort_rhp_##fLapackFunc; \
230
+ } else if (strcmp(sort_str, "iup") == 0) { \
231
+ opt.select = _sort_iup_##fLapackFunc; \
232
+ } else if (strcmp(sort_str, "ouc") == 0) { \
233
+ opt.select = _sort_ouc_##fLapackFunc; \
234
+ } else { \
235
+ rb_raise(rb_eArgError, "invalid value for sort option"); \
236
+ return Qnil; \
237
+ } \
238
+ VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
239
+ VALUE ret = rb_ary_concat(rb_ary_new3(1, a_vnary), res); \
240
+ \
241
+ RB_GC_GUARD(sort_val); \
242
+ RB_GC_GUARD(a_vnary); \
243
+ return ret; \
244
+ }
245
+
246
+ DEF_GEES_OPTION(dgees, LAPACK_D_SELECT2)
247
+ DEF_GEES_OPTION(sgees, LAPACK_S_SELECT2)
248
+ DEF_GEES_OPTION(zgees, LAPACK_Z_SELECT1)
249
+ DEF_GEES_OPTION(cgees, LAPACK_C_SELECT1)
250
+
251
+ DEF_GEES_SORT_FUNC(double, dgees)
252
+ DEF_GEES_SORT_FUNC(float, sgees)
253
+ DEF_GEES_SORT_FUNC_COMPLEX(
254
+ lapack_complex_double, double, lapack_complex_double_real, lapack_complex_double_imag, zgees
255
+ )
256
+ DEF_GEES_SORT_FUNC_COMPLEX(
257
+ lapack_complex_float, float, lapack_complex_float_real, lapack_complex_float_imag, cgees
258
+ )
259
+
260
+ DEF_LINALG_FUNC(double, numo_cDFloat, dgees)
261
+ DEF_LINALG_FUNC(float, numo_cSFloat, sgees)
262
+ DEF_LINALG_FUNC_COMPLEX(lapack_complex_double, numo_cDComplex, zgees)
263
+ DEF_LINALG_FUNC_COMPLEX(lapack_complex_float, numo_cSComplex, cgees)
264
+
265
+ #undef DEF_GEES_OPTION
266
+ #undef DEF_GEES_SORT_FUNC
267
+ #undef DEF_GEES_SORT_FUNC_COMPLEX
268
+ #undef DEF_LINALG_FUNC
269
+ #undef DEF_LINALG_FUNC_COMPLEX
270
+
271
+ void define_linalg_lapack_gees(VALUE mLapack) {
272
+ rb_define_module_function(mLapack, "dgees", RUBY_METHOD_FUNC(_linalg_lapack_dgees), -1);
273
+ rb_define_module_function(mLapack, "sgees", RUBY_METHOD_FUNC(_linalg_lapack_sgees), -1);
274
+ rb_define_module_function(mLapack, "zgees", RUBY_METHOD_FUNC(_linalg_lapack_zgees), -1);
275
+ rb_define_module_function(mLapack, "cgees", RUBY_METHOD_FUNC(_linalg_lapack_cgees), -1);
276
+ }
data/ext/numo/linalg/lapack/gees.h ADDED
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GEES_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GEES_H 1
3
+
4
+ #include <lapacke.h>
5
+
6
+ #include <ruby.h>
7
+
8
+ #include <numo/narray.h>
9
+ #include <numo/template.h>
10
+
11
+ #include "../util.h"
12
+
13
+ void define_linalg_lapack_gees(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GEES_H */
data/ext/numo/linalg/lapack/geev.c CHANGED
@@ -22,118 +22,135 @@ char _get_jobvr(VALUE val) {
22
22
  return jobvr;
23
23
  }
24
24
 
25
- #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
26
- static void _iter_##fLapackFunc(na_loop_t* const lp) { \
27
- tDType* a = (tDType*)NDL_PTR(lp, 0); \
28
- tDType* wr = (tDType*)NDL_PTR(lp, 1); \
29
- tDType* wi = (tDType*)NDL_PTR(lp, 2); \
30
- tDType* vl = (tDType*)NDL_PTR(lp, 3); \
31
- tDType* vr = (tDType*)NDL_PTR(lp, 4); \
32
- int* info = (int*)NDL_PTR(lp, 5); \
33
- struct _geev_option* opt = (struct _geev_option*)(lp->opt_ptr); \
34
- const lapack_int n = (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]); \
35
- const lapack_int lda = n; \
36
- const lapack_int ldvl = (opt->jobvl == 'N') ? 1 : n; \
37
- const lapack_int ldvr = (opt->jobvr == 'N') ? 1 : n; \
38
- lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->jobvl, opt->jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr); \
39
- *info = (int)i; \
40
- } \
41
- \
42
- static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
43
- VALUE a_vnary = Qnil; \
44
- VALUE kw_args = Qnil; \
45
- rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
46
- ID kw_table[3] = { rb_intern("order"), rb_intern("jobvl"), rb_intern("jobvr") }; \
47
- VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
48
- rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
49
- const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
50
- const char jobvl = kw_values[1] != Qundef ? _get_jobvl(kw_values[1]) : 'V'; \
51
- const char jobvr = kw_values[2] != Qundef ? _get_jobvr(kw_values[2]) : 'V'; \
52
- \
53
- if (CLASS_OF(a_vnary) != tNAryClass) { \
54
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
55
- } \
56
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
57
- a_vnary = nary_dup(a_vnary); \
58
- } \
59
- \
60
- narray_t* a_nary = NULL; \
61
- GetNArray(a_vnary, a_nary); \
62
- const int n_dims = NA_NDIM(a_nary); \
63
- if (n_dims != 2) { \
64
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
65
- return Qnil; \
66
- } \
67
- \
68
- size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
69
- size_t shape_wr[1] = { n }; \
70
- size_t shape_wi[1] = { n }; \
71
- size_t shape_vl[2] = { n, (jobvl == 'N') ? 1 : n }; \
72
- size_t shape_vr[2] = { n, (jobvr == 'N') ? 1 : n }; \
73
- ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
74
- ndfunc_arg_out_t aout[5] = { { tNAryClass, 1, shape_wr }, { tNAryClass, 1, shape_wi }, { tNAryClass, 2, shape_vl }, { tNAryClass, 2, shape_vr }, { numo_cInt32, 0 } }; \
75
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 5, ain, aout }; \
76
- struct _geev_option opt = { matrix_layout, jobvl, jobvr }; \
77
- VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
78
- \
79
- RB_GC_GUARD(a_vnary); \
80
- return ret; \
25
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
26
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
27
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
28
+ tDType* wr = (tDType*)NDL_PTR(lp, 1); \
29
+ tDType* wi = (tDType*)NDL_PTR(lp, 2); \
30
+ tDType* vl = (tDType*)NDL_PTR(lp, 3); \
31
+ tDType* vr = (tDType*)NDL_PTR(lp, 4); \
32
+ int* info = (int*)NDL_PTR(lp, 5); \
33
+ struct _geev_option* opt = (struct _geev_option*)(lp->opt_ptr); \
34
+ const lapack_int n = \
35
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
36
+ : NDL_SHAPE(lp, 0)[1]); \
37
+ const lapack_int lda = n; \
38
+ const lapack_int ldvl = (opt->jobvl == 'N') ? 1 : n; \
39
+ const lapack_int ldvr = (opt->jobvr == 'N') ? 1 : n; \
40
+ lapack_int i = LAPACKE_##fLapackFunc( \
41
+ opt->matrix_layout, opt->jobvl, opt->jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr \
42
+ ); \
43
+ *info = (int)i; \
44
+ } \
45
+ \
46
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
47
+ VALUE a_vnary = Qnil; \
48
+ VALUE kw_args = Qnil; \
49
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
50
+ ID kw_table[3] = { rb_intern("order"), rb_intern("jobvl"), rb_intern("jobvr") }; \
51
+ VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
52
+ rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
53
+ const int matrix_layout = \
54
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
55
+ const char jobvl = kw_values[1] != Qundef ? _get_jobvl(kw_values[1]) : 'V'; \
56
+ const char jobvr = kw_values[2] != Qundef ? _get_jobvr(kw_values[2]) : 'V'; \
57
+ \
58
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
59
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
60
+ } \
61
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
62
+ a_vnary = nary_dup(a_vnary); \
63
+ } \
64
+ \
65
+ narray_t* a_nary = NULL; \
66
+ GetNArray(a_vnary, a_nary); \
67
+ const int n_dims = NA_NDIM(a_nary); \
68
+ if (n_dims != 2) { \
69
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
70
+ return Qnil; \
71
+ } \
72
+ \
73
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
74
+ size_t shape_wr[1] = { n }; \
75
+ size_t shape_wi[1] = { n }; \
76
+ size_t shape_vl[2] = { n, (jobvl == 'N') ? 1 : n }; \
77
+ size_t shape_vr[2] = { n, (jobvr == 'N') ? 1 : n }; \
78
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
79
+ ndfunc_arg_out_t aout[5] = { { tNAryClass, 1, shape_wr }, \
80
+ { tNAryClass, 1, shape_wi }, \
81
+ { tNAryClass, 2, shape_vl }, \
82
+ { tNAryClass, 2, shape_vr }, \
83
+ { numo_cInt32, 0 } }; \
84
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 5, ain, aout }; \
85
+ struct _geev_option opt = { matrix_layout, jobvl, jobvr }; \
86
+ VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
87
+ \
88
+ RB_GC_GUARD(a_vnary); \
89
+ return ret; \
81
90
  }
82
91
 
83
- #define DEF_LINALG_FUNC_COMPLEX(tDType, tNAryClass, fLapackFunc) \
84
- static void _iter_##fLapackFunc(na_loop_t* const lp) { \
85
- tDType* a = (tDType*)NDL_PTR(lp, 0); \
86
- tDType* w = (tDType*)NDL_PTR(lp, 1); \
87
- tDType* vl = (tDType*)NDL_PTR(lp, 2); \
88
- tDType* vr = (tDType*)NDL_PTR(lp, 3); \
89
- int* info = (int*)NDL_PTR(lp, 4); \
90
- struct _geev_option* opt = (struct _geev_option*)(lp->opt_ptr); \
91
- const lapack_int n = (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]); \
92
- const lapack_int lda = n; \
93
- const lapack_int ldvl = (opt->jobvl == 'N') ? 1 : n; \
94
- const lapack_int ldvr = (opt->jobvr == 'N') ? 1 : n; \
95
- lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->jobvl, opt->jobvr, n, a, lda, w, vl, ldvl, vr, ldvr); \
96
- *info = (int)i; \
97
- } \
98
- \
99
- static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
100
- VALUE a_vnary = Qnil; \
101
- VALUE kw_args = Qnil; \
102
- rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
103
- ID kw_table[3] = { rb_intern("order"), rb_intern("jobvl"), rb_intern("jobvr") }; \
104
- VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
105
- rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
106
- const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
107
- const char jobvl = kw_values[1] != Qundef ? _get_jobvl(kw_values[1]) : 'V'; \
108
- const char jobvr = kw_values[2] != Qundef ? _get_jobvr(kw_values[2]) : 'V'; \
109
- \
110
- if (CLASS_OF(a_vnary) != tNAryClass) { \
111
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
112
- } \
113
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
114
- a_vnary = nary_dup(a_vnary); \
115
- } \
116
- \
117
- narray_t* a_nary = NULL; \
118
- GetNArray(a_vnary, a_nary); \
119
- const int n_dims = NA_NDIM(a_nary); \
120
- if (n_dims != 2) { \
121
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
122
- return Qnil; \
123
- } \
124
- \
125
- size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
126
- size_t shape_w[1] = { n }; \
127
- size_t shape_vl[2] = { n, (jobvl == 'N') ? 1 : n }; \
128
- size_t shape_vr[2] = { n, (jobvr == 'N') ? 1 : n }; \
129
- ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
130
- ndfunc_arg_out_t aout[4] = { { tNAryClass, 1, shape_w }, { tNAryClass, 2, shape_vl }, { tNAryClass, 2, shape_vr }, { numo_cInt32, 0 } }; \
131
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout }; \
132
- struct _geev_option opt = { matrix_layout, jobvl, jobvr }; \
133
- VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
134
- \
135
- RB_GC_GUARD(a_vnary); \
136
- return ret; \
92
+ #define DEF_LINALG_FUNC_COMPLEX(tDType, tNAryClass, fLapackFunc) \
93
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
94
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
95
+ tDType* w = (tDType*)NDL_PTR(lp, 1); \
96
+ tDType* vl = (tDType*)NDL_PTR(lp, 2); \
97
+ tDType* vr = (tDType*)NDL_PTR(lp, 3); \
98
+ int* info = (int*)NDL_PTR(lp, 4); \
99
+ struct _geev_option* opt = (struct _geev_option*)(lp->opt_ptr); \
100
+ const lapack_int n = \
101
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
102
+ : NDL_SHAPE(lp, 0)[1]); \
103
+ const lapack_int lda = n; \
104
+ const lapack_int ldvl = (opt->jobvl == 'N') ? 1 : n; \
105
+ const lapack_int ldvr = (opt->jobvr == 'N') ? 1 : n; \
106
+ lapack_int i = LAPACKE_##fLapackFunc( \
107
+ opt->matrix_layout, opt->jobvl, opt->jobvr, n, a, lda, w, vl, ldvl, vr, ldvr \
108
+ ); \
109
+ *info = (int)i; \
110
+ } \
111
+ \
112
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
113
+ VALUE a_vnary = Qnil; \
114
+ VALUE kw_args = Qnil; \
115
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
116
+ ID kw_table[3] = { rb_intern("order"), rb_intern("jobvl"), rb_intern("jobvr") }; \
117
+ VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
118
+ rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
119
+ const int matrix_layout = \
120
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
121
+ const char jobvl = kw_values[1] != Qundef ? _get_jobvl(kw_values[1]) : 'V'; \
122
+ const char jobvr = kw_values[2] != Qundef ? _get_jobvr(kw_values[2]) : 'V'; \
123
+ \
124
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
125
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
126
+ } \
127
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
128
+ a_vnary = nary_dup(a_vnary); \
129
+ } \
130
+ \
131
+ narray_t* a_nary = NULL; \
132
+ GetNArray(a_vnary, a_nary); \
133
+ const int n_dims = NA_NDIM(a_nary); \
134
+ if (n_dims != 2) { \
135
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
136
+ return Qnil; \
137
+ } \
138
+ \
139
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
140
+ size_t shape_w[1] = { n }; \
141
+ size_t shape_vl[2] = { n, (jobvl == 'N') ? 1 : n }; \
142
+ size_t shape_vr[2] = { n, (jobvr == 'N') ? 1 : n }; \
143
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
144
+ ndfunc_arg_out_t aout[4] = { { tNAryClass, 1, shape_w }, \
145
+ { tNAryClass, 2, shape_vl }, \
146
+ { tNAryClass, 2, shape_vr }, \
147
+ { numo_cInt32, 0 } }; \
148
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout }; \
149
+ struct _geev_option opt = { matrix_layout, jobvl, jobvr }; \
150
+ VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
151
+ \
152
+ RB_GC_GUARD(a_vnary); \
153
+ return ret; \
137
154
  }
138
155
 
139
156
  DEF_LINALG_FUNC(double, numo_cDFloat, dgeev)