numo-linalg-alt 0.3.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 (53) hide show
  1. checksums.yaml +4 -4
  2. data/CHANGELOG.md +4 -0
  3. data/ext/numo/linalg/blas/dot.c +59 -59
  4. data/ext/numo/linalg/blas/dot_sub.c +58 -58
  5. data/ext/numo/linalg/blas/gemm.c +157 -148
  6. data/ext/numo/linalg/blas/gemv.c +131 -127
  7. data/ext/numo/linalg/blas/nrm2.c +50 -50
  8. data/ext/numo/linalg/lapack/gees.c +239 -220
  9. data/ext/numo/linalg/lapack/geev.c +127 -110
  10. data/ext/numo/linalg/lapack/gelsd.c +81 -70
  11. data/ext/numo/linalg/lapack/geqrf.c +52 -51
  12. data/ext/numo/linalg/lapack/gerqf.c +70 -0
  13. data/ext/numo/linalg/lapack/gerqf.h +15 -0
  14. data/ext/numo/linalg/lapack/gesdd.c +96 -86
  15. data/ext/numo/linalg/lapack/gesv.c +80 -78
  16. data/ext/numo/linalg/lapack/gesvd.c +140 -129
  17. data/ext/numo/linalg/lapack/getrf.c +51 -50
  18. data/ext/numo/linalg/lapack/getri.c +64 -63
  19. data/ext/numo/linalg/lapack/getrs.c +92 -88
  20. data/ext/numo/linalg/lapack/gges.c +214 -0
  21. data/ext/numo/linalg/lapack/gges.h +15 -0
  22. data/ext/numo/linalg/lapack/heev.c +54 -52
  23. data/ext/numo/linalg/lapack/heevd.c +54 -52
  24. data/ext/numo/linalg/lapack/heevr.c +109 -98
  25. data/ext/numo/linalg/lapack/hegv.c +77 -74
  26. data/ext/numo/linalg/lapack/hegvd.c +77 -74
  27. data/ext/numo/linalg/lapack/hegvx.c +132 -120
  28. data/ext/numo/linalg/lapack/hetrf.c +54 -50
  29. data/ext/numo/linalg/lapack/lange.c +45 -44
  30. data/ext/numo/linalg/lapack/orgqr.c +63 -62
  31. data/ext/numo/linalg/lapack/orgrq.c +78 -0
  32. data/ext/numo/linalg/lapack/orgrq.h +15 -0
  33. data/ext/numo/linalg/lapack/potrf.c +49 -48
  34. data/ext/numo/linalg/lapack/potri.c +49 -48
  35. data/ext/numo/linalg/lapack/potrs.c +74 -72
  36. data/ext/numo/linalg/lapack/syev.c +54 -52
  37. data/ext/numo/linalg/lapack/syevd.c +54 -52
  38. data/ext/numo/linalg/lapack/syevr.c +107 -98
  39. data/ext/numo/linalg/lapack/sygv.c +77 -73
  40. data/ext/numo/linalg/lapack/sygvd.c +77 -73
  41. data/ext/numo/linalg/lapack/sygvx.c +132 -120
  42. data/ext/numo/linalg/lapack/sytrf.c +54 -50
  43. data/ext/numo/linalg/lapack/trtrs.c +79 -75
  44. data/ext/numo/linalg/lapack/ungqr.c +63 -62
  45. data/ext/numo/linalg/lapack/ungrq.c +78 -0
  46. data/ext/numo/linalg/lapack/ungrq.h +15 -0
  47. data/ext/numo/linalg/linalg.c +20 -10
  48. data/ext/numo/linalg/linalg.h +4 -0
  49. data/ext/numo/linalg/util.c +8 -0
  50. data/ext/numo/linalg/util.h +1 -0
  51. data/lib/numo/linalg/version.rb +1 -1
  52. data/lib/numo/linalg.rb +139 -3
  53. metadata +10 -2
data/ext/numo/linalg/lapack/getrs.c CHANGED
@@ -5,94 +5,98 @@ struct _getrs_option {
5
5
  char trans;
6
6
  };
7
7
 
8
- #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
9
- static void _iter_##fLapackFunc(na_loop_t* const lp) { \
10
- tDType* a = (tDType*)NDL_PTR(lp, 0); \
11
- int* ipiv = (int*)NDL_PTR(lp, 1); \
12
- tDType* b = (tDType*)NDL_PTR(lp, 2); \
13
- int* info = (int*)NDL_PTR(lp, 3); \
14
- struct _getrs_option* opt = (struct _getrs_option*)(lp->opt_ptr); \
15
- const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
16
- const lapack_int nrhs = lp->args[2].ndim == 1 ? 1 : (lapack_int)NDL_SHAPE(lp, 2)[1]; \
17
- const lapack_int lda = n; \
18
- const lapack_int ldb = nrhs; \
19
- const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->trans, n, nrhs, a, lda, ipiv, b, ldb); \
20
- *info = (int)i; \
21
- } \
22
- \
23
- static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
24
- VALUE a_vnary = Qnil; \
25
- VALUE ipiv_vnary = Qnil; \
26
- VALUE b_vnary = Qnil; \
27
- VALUE kw_args = Qnil; \
28
- rb_scan_args(argc, argv, "3:", &a_vnary, &ipiv_vnary, &b_vnary, &kw_args); \
29
- ID kw_table[2] = { rb_intern("order"), rb_intern("trans") }; \
30
- VALUE kw_values[2] = { Qundef, Qundef }; \
31
- rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
32
- const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
33
- const char trans = kw_values[1] != Qundef ? NUM2CHR(kw_values[1]) : 'N'; \
34
- \
35
- if (CLASS_OF(a_vnary) != tNAryClass) { \
36
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
37
- } \
38
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
39
- a_vnary = nary_dup(a_vnary); \
40
- } \
41
- if (CLASS_OF(ipiv_vnary) != numo_cInt32) { \
42
- ipiv_vnary = rb_funcall(numo_cInt32, rb_intern("cast"), 1, ipiv_vnary); \
43
- } \
44
- if (!RTEST(nary_check_contiguous(ipiv_vnary))) { \
45
- ipiv_vnary = nary_dup(ipiv_vnary); \
46
- } \
47
- if (CLASS_OF(b_vnary) != tNAryClass) { \
48
- b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
49
- } \
50
- if (!RTEST(nary_check_contiguous(b_vnary))) { \
51
- b_vnary = nary_dup(b_vnary); \
52
- } \
53
- \
54
- narray_t* a_nary = NULL; \
55
- GetNArray(a_vnary, a_nary); \
56
- const int n_dims = NA_NDIM(a_nary); \
57
- if (n_dims != 2) { \
58
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
59
- return Qnil; \
60
- } \
61
- if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
62
- rb_raise(rb_eArgError, "input array a must be square"); \
63
- return Qnil; \
64
- } \
65
- narray_t* ipiv_nary = NULL; \
66
- GetNArray(ipiv_vnary, ipiv_nary); \
67
- const int ipiv_n_dims = NA_NDIM(ipiv_nary); \
68
- if (ipiv_n_dims != 1) { \
69
- rb_raise(rb_eArgError, "input array ipiv must be 1-dimensional"); \
70
- return Qnil; \
71
- } \
72
- narray_t* b_nary = NULL; \
73
- GetNArray(b_vnary, b_nary); \
74
- const int b_n_dims = NA_NDIM(b_nary); \
75
- if (b_n_dims != 1 && b_n_dims != 2) { \
76
- rb_raise(rb_eArgError, "input array b must be 1 or 2-dimensional"); \
77
- return Qnil; \
78
- } \
79
- lapack_int n = (lapack_int)NA_SHAPE(a_nary)[0]; \
80
- lapack_int nb = (lapack_int)NA_SHAPE(b_nary)[0]; \
81
- if (n != nb) { \
82
- rb_raise(nary_eShapeError, "shape1[0](=%d) != shape2[0](=%d)", n, nb); \
83
- } \
84
- \
85
- ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { numo_cInt32, 1 }, { OVERWRITE, b_n_dims } }; \
86
- ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
87
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 3, 1, ain, aout }; \
88
- struct _getrs_option opt = { matrix_layout, trans }; \
89
- VALUE info = na_ndloop3(&ndf, &opt, 3, a_vnary, ipiv_vnary, b_vnary); \
90
- VALUE ret = rb_ary_new3(2, b_vnary, info); \
91
- \
92
- RB_GC_GUARD(a_vnary); \
93
- RB_GC_GUARD(ipiv_vnary); \
94
- RB_GC_GUARD(b_vnary); \
95
- return ret; \
8
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
9
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
10
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
11
+ int* ipiv = (int*)NDL_PTR(lp, 1); \
12
+ tDType* b = (tDType*)NDL_PTR(lp, 2); \
13
+ int* info = (int*)NDL_PTR(lp, 3); \
14
+ struct _getrs_option* opt = (struct _getrs_option*)(lp->opt_ptr); \
15
+ const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
16
+ const lapack_int nrhs = lp->args[2].ndim == 1 ? 1 : (lapack_int)NDL_SHAPE(lp, 2)[1]; \
17
+ const lapack_int lda = n; \
18
+ const lapack_int ldb = nrhs; \
19
+ const lapack_int i = \
20
+ LAPACKE_##fLapackFunc(opt->matrix_layout, opt->trans, n, nrhs, a, lda, ipiv, b, ldb); \
21
+ *info = (int)i; \
22
+ } \
23
+ \
24
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
25
+ VALUE a_vnary = Qnil; \
26
+ VALUE ipiv_vnary = Qnil; \
27
+ VALUE b_vnary = Qnil; \
28
+ VALUE kw_args = Qnil; \
29
+ rb_scan_args(argc, argv, "3:", &a_vnary, &ipiv_vnary, &b_vnary, &kw_args); \
30
+ ID kw_table[2] = { rb_intern("order"), rb_intern("trans") }; \
31
+ VALUE kw_values[2] = { Qundef, Qundef }; \
32
+ rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
33
+ const int matrix_layout = \
34
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
35
+ const char trans = kw_values[1] != Qundef ? NUM2CHR(kw_values[1]) : 'N'; \
36
+ \
37
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
38
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
39
+ } \
40
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
41
+ a_vnary = nary_dup(a_vnary); \
42
+ } \
43
+ if (CLASS_OF(ipiv_vnary) != numo_cInt32) { \
44
+ ipiv_vnary = rb_funcall(numo_cInt32, rb_intern("cast"), 1, ipiv_vnary); \
45
+ } \
46
+ if (!RTEST(nary_check_contiguous(ipiv_vnary))) { \
47
+ ipiv_vnary = nary_dup(ipiv_vnary); \
48
+ } \
49
+ if (CLASS_OF(b_vnary) != tNAryClass) { \
50
+ b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
51
+ } \
52
+ if (!RTEST(nary_check_contiguous(b_vnary))) { \
53
+ b_vnary = nary_dup(b_vnary); \
54
+ } \
55
+ \
56
+ narray_t* a_nary = NULL; \
57
+ GetNArray(a_vnary, a_nary); \
58
+ const int n_dims = NA_NDIM(a_nary); \
59
+ if (n_dims != 2) { \
60
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
61
+ return Qnil; \
62
+ } \
63
+ if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
64
+ rb_raise(rb_eArgError, "input array a must be square"); \
65
+ return Qnil; \
66
+ } \
67
+ narray_t* ipiv_nary = NULL; \
68
+ GetNArray(ipiv_vnary, ipiv_nary); \
69
+ const int ipiv_n_dims = NA_NDIM(ipiv_nary); \
70
+ if (ipiv_n_dims != 1) { \
71
+ rb_raise(rb_eArgError, "input array ipiv must be 1-dimensional"); \
72
+ return Qnil; \
73
+ } \
74
+ narray_t* b_nary = NULL; \
75
+ GetNArray(b_vnary, b_nary); \
76
+ const int b_n_dims = NA_NDIM(b_nary); \
77
+ if (b_n_dims != 1 && b_n_dims != 2) { \
78
+ rb_raise(rb_eArgError, "input array b must be 1 or 2-dimensional"); \
79
+ return Qnil; \
80
+ } \
81
+ lapack_int n = (lapack_int)NA_SHAPE(a_nary)[0]; \
82
+ lapack_int nb = (lapack_int)NA_SHAPE(b_nary)[0]; \
83
+ if (n != nb) { \
84
+ rb_raise(nary_eShapeError, "shape1[0](=%d) != shape2[0](=%d)", n, nb); \
85
+ } \
86
+ \
87
+ ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, \
88
+ { numo_cInt32, 1 }, \
89
+ { OVERWRITE, b_n_dims } }; \
90
+ ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
91
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 3, 1, ain, aout }; \
92
+ struct _getrs_option opt = { matrix_layout, trans }; \
93
+ VALUE info = na_ndloop3(&ndf, &opt, 3, a_vnary, ipiv_vnary, b_vnary); \
94
+ VALUE ret = rb_ary_new3(2, b_vnary, info); \
95
+ \
96
+ RB_GC_GUARD(a_vnary); \
97
+ RB_GC_GUARD(ipiv_vnary); \
98
+ RB_GC_GUARD(b_vnary); \
99
+ return ret; \
96
100
  }
97
101
 
98
102
  DEF_LINALG_FUNC(double, numo_cDFloat, dgetrs)
data/ext/numo/linalg/lapack/gges.c ADDED
@@ -0,0 +1,214 @@
1
+ #include "gges.h"
2
+
3
+ #define DEF_GGES_OPTION(fLapackFunc, tSelectFunc) \
4
+ struct _gges_option_##fLapackFunc { \
5
+ int matrix_layout; \
6
+ char jobvsl; \
7
+ char jobvsr; \
8
+ char sort; \
9
+ tSelectFunc select; \
10
+ };
11
+
12
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
13
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
14
+ tDType* a = (tDType*)(NDL_PTR(lp, 0)); \
15
+ tDType* b = (tDType*)(NDL_PTR(lp, 1)); \
16
+ tDType* alpha_r = (tDType*)(NDL_PTR(lp, 2)); \
17
+ tDType* alpha_i = (tDType*)(NDL_PTR(lp, 3)); \
18
+ tDType* beta = (tDType*)(NDL_PTR(lp, 4)); \
19
+ tDType* vsl = (tDType*)(NDL_PTR(lp, 5)); \
20
+ tDType* vsr = (tDType*)(NDL_PTR(lp, 6)); \
21
+ int* sdim = (int*)(NDL_PTR(lp, 7)); \
22
+ int* info = (int*)(NDL_PTR(lp, 8)); \
23
+ struct _gges_option_##fLapackFunc* opt = \
24
+ (struct _gges_option_##fLapackFunc*)(lp->opt_ptr); \
25
+ const lapack_int n = \
26
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
27
+ : NDL_SHAPE(lp, 0)[1]); \
28
+ const lapack_int lda = n; \
29
+ const lapack_int ldb = n; \
30
+ const lapack_int ldvsl = (opt->jobvsl == 'N') ? 1 : n; \
31
+ const lapack_int ldvsr = (opt->jobvsr == 'N') ? 1 : n; \
32
+ lapack_int s = 0; \
33
+ lapack_int i = LAPACKE_##fLapackFunc( \
34
+ opt->matrix_layout, opt->jobvsl, opt->jobvsr, opt->sort, opt->select, n, a, lda, b, ldb, \
35
+ &s, alpha_r, alpha_i, beta, vsl, ldvsl, vsr, ldvsr \
36
+ ); \
37
+ *sdim = (int)s; \
38
+ *info = (int)i; \
39
+ } \
40
+ \
41
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
42
+ VALUE a_vnary = Qnil; \
43
+ VALUE b_vnary = Qnil; \
44
+ VALUE kw_args = Qnil; \
45
+ rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
46
+ ID kw_table[4] = { rb_intern("order"), rb_intern("jobvsl"), rb_intern("jobvsr"), \
47
+ rb_intern("sort") }; \
48
+ VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef }; \
49
+ rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values); \
50
+ const int matrix_layout = \
51
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
52
+ const char jobvsl = kw_values[1] != Qundef ? get_jobvs(kw_values[1]) : 'V'; \
53
+ const char jobvsr = kw_values[2] != Qundef ? get_jobvs(kw_values[2]) : 'V'; \
54
+ \
55
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
56
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
57
+ } \
58
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
59
+ a_vnary = nary_dup(a_vnary); \
60
+ } \
61
+ if (CLASS_OF(b_vnary) != tNAryClass) { \
62
+ b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
63
+ } \
64
+ if (!RTEST(nary_check_contiguous(b_vnary))) { \
65
+ b_vnary = nary_dup(b_vnary); \
66
+ } \
67
+ \
68
+ narray_t* a_nary = NULL; \
69
+ GetNArray(a_vnary, a_nary); \
70
+ if (NA_NDIM(a_nary) != 2) { \
71
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional array"); \
72
+ return Qnil; \
73
+ } \
74
+ narray_t* b_nary = NULL; \
75
+ GetNArray(b_vnary, b_nary); \
76
+ if (NA_NDIM(b_nary) != 2) { \
77
+ rb_raise(rb_eArgError, "input array b must be 2-dimensional array"); \
78
+ return Qnil; \
79
+ } \
80
+ \
81
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
82
+ size_t shape_alphar[1] = { n }; \
83
+ size_t shape_alphai[1] = { n }; \
84
+ size_t shape_beta[1] = { n }; \
85
+ size_t shape_vsl[2] = { n, jobvsl == 'N' ? 1 : n }; \
86
+ size_t shape_vsr[2] = { n, jobvsr == 'N' ? 1 : n }; \
87
+ ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { OVERWRITE, 2 } }; \
88
+ ndfunc_arg_out_t aout[7] = { { tNAryClass, 1, shape_alphar }, \
89
+ { tNAryClass, 1, shape_alphai }, \
90
+ { tNAryClass, 1, shape_beta }, \
91
+ { tNAryClass, 2, shape_vsl }, \
92
+ { tNAryClass, 2, shape_vsr }, \
93
+ { numo_cInt32, 0 }, \
94
+ { numo_cInt32, 0 } }; \
95
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 7, ain, aout }; \
96
+ struct _gges_option_##fLapackFunc opt = { matrix_layout, jobvsl, jobvsr, 'N', NULL }; \
97
+ VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
98
+ VALUE ret = rb_ary_concat(rb_ary_new3(2, a_vnary, b_vnary), res); \
99
+ \
100
+ RB_GC_GUARD(a_vnary); \
101
+ RB_GC_GUARD(b_vnary); \
102
+ return ret; \
103
+ }
104
+
105
+ #define DEF_LINALG_FUNC_COMPLEX(tDType, tNAryClass, fLapackFunc) \
106
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
107
+ tDType* a = (tDType*)(NDL_PTR(lp, 0)); \
108
+ tDType* b = (tDType*)(NDL_PTR(lp, 1)); \
109
+ tDType* alpha = (tDType*)(NDL_PTR(lp, 2)); \
110
+ tDType* beta = (tDType*)(NDL_PTR(lp, 3)); \
111
+ tDType* vsl = (tDType*)(NDL_PTR(lp, 4)); \
112
+ tDType* vsr = (tDType*)(NDL_PTR(lp, 5)); \
113
+ int* sdim = (int*)(NDL_PTR(lp, 6)); \
114
+ int* info = (int*)(NDL_PTR(lp, 7)); \
115
+ struct _gges_option_##fLapackFunc* opt = \
116
+ (struct _gges_option_##fLapackFunc*)(lp->opt_ptr); \
117
+ const lapack_int n = \
118
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
119
+ : NDL_SHAPE(lp, 0)[1]); \
120
+ const lapack_int lda = n; \
121
+ const lapack_int ldb = n; \
122
+ const lapack_int ldvsl = (opt->jobvsl == 'N') ? 1 : n; \
123
+ const lapack_int ldvsr = (opt->jobvsr == 'N') ? 1 : n; \
124
+ lapack_int s = 0; \
125
+ lapack_int i = LAPACKE_##fLapackFunc( \
126
+ opt->matrix_layout, opt->jobvsl, opt->jobvsr, opt->sort, opt->select, n, a, lda, b, ldb, \
127
+ &s, alpha, beta, vsl, ldvsl, vsr, ldvsr \
128
+ ); \
129
+ *sdim = (int)s; \
130
+ *info = (int)i; \
131
+ } \
132
+ \
133
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
134
+ VALUE a_vnary = Qnil; \
135
+ VALUE b_vnary = Qnil; \
136
+ VALUE kw_args = Qnil; \
137
+ rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
138
+ ID kw_table[4] = { rb_intern("order"), rb_intern("jobvsl"), rb_intern("jobvsr"), \
139
+ rb_intern("sort") }; \
140
+ VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef }; \
141
+ rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values); \
142
+ const int matrix_layout = \
143
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
144
+ const char jobvsl = kw_values[1] != Qundef ? get_jobvs(kw_values[1]) : 'V'; \
145
+ const char jobvsr = kw_values[2] != Qundef ? get_jobvs(kw_values[1]) : 'V'; \
146
+ \
147
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
148
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
149
+ } \
150
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
151
+ a_vnary = nary_dup(a_vnary); \
152
+ } \
153
+ if (CLASS_OF(b_vnary) != tNAryClass) { \
154
+ b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
155
+ } \
156
+ if (!RTEST(nary_check_contiguous(b_vnary))) { \
157
+ b_vnary = nary_dup(b_vnary); \
158
+ } \
159
+ \
160
+ narray_t* a_nary = NULL; \
161
+ GetNArray(a_vnary, a_nary); \
162
+ if (NA_NDIM(a_nary) != 2) { \
163
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional array"); \
164
+ return Qnil; \
165
+ } \
166
+ narray_t* b_nary = NULL; \
167
+ GetNArray(b_vnary, b_nary); \
168
+ if (NA_NDIM(b_nary) != 2) { \
169
+ rb_raise(rb_eArgError, "input array b must be 2-dimensional array"); \
170
+ return Qnil; \
171
+ } \
172
+ \
173
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
174
+ size_t shape_alpha[1] = { n }; \
175
+ size_t shape_beta[1] = { n }; \
176
+ size_t shape_vsl[2] = { n, jobvsl == 'N' ? 1 : n }; \
177
+ size_t shape_vsr[2] = { n, jobvsr == 'N' ? 1 : n }; \
178
+ ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { OVERWRITE, 2 } }; \
179
+ ndfunc_arg_out_t aout[6] = { { tNAryClass, 1, shape_alpha }, \
180
+ { tNAryClass, 1, shape_beta }, \
181
+ { tNAryClass, 2, shape_vsl }, \
182
+ { tNAryClass, 2, shape_vsr }, \
183
+ { numo_cInt32, 0 }, \
184
+ { numo_cInt32, 0 } }; \
185
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 6, ain, aout }; \
186
+ struct _gges_option_##fLapackFunc opt = { matrix_layout, jobvsl, jobvsr, 'N', NULL }; \
187
+ VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
188
+ VALUE ret = rb_ary_concat(rb_ary_new3(2, a_vnary, b_vnary), res); \
189
+ \
190
+ RB_GC_GUARD(a_vnary); \
191
+ RB_GC_GUARD(b_vnary); \
192
+ return ret; \
193
+ }
194
+
195
+ DEF_GGES_OPTION(dgges, LAPACK_D_SELECT3)
196
+ DEF_GGES_OPTION(sgges, LAPACK_S_SELECT3)
197
+ DEF_GGES_OPTION(zgges, LAPACK_Z_SELECT2)
198
+ DEF_GGES_OPTION(cgges, LAPACK_C_SELECT2)
199
+
200
+ DEF_LINALG_FUNC(double, numo_cDFloat, dgges)
201
+ DEF_LINALG_FUNC(float, numo_cSFloat, sgges)
202
+ DEF_LINALG_FUNC_COMPLEX(lapack_complex_double, numo_cDComplex, zgges)
203
+ DEF_LINALG_FUNC_COMPLEX(lapack_complex_float, numo_cSComplex, cgges)
204
+
205
+ #undef DEF_GGES_OPTION
206
+ #undef DEF_LINALG_FUNC
207
+ #undef DEF_LINALG_FUNC_COMPLEX
208
+
209
+ void define_linalg_lapack_gges(VALUE mLapack) {
210
+ rb_define_module_function(mLapack, "dgges", RUBY_METHOD_FUNC(_linalg_lapack_dgges), -1);
211
+ rb_define_module_function(mLapack, "sgges", RUBY_METHOD_FUNC(_linalg_lapack_sgges), -1);
212
+ rb_define_module_function(mLapack, "zgges", RUBY_METHOD_FUNC(_linalg_lapack_zgges), -1);
213
+ rb_define_module_function(mLapack, "cgges", RUBY_METHOD_FUNC(_linalg_lapack_cgges), -1);
214
+ }
data/ext/numo/linalg/lapack/gges.h ADDED
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GGES_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GGES_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_gges(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GGES_H */
data/ext/numo/linalg/lapack/heev.c CHANGED
@@ -6,58 +6,60 @@ struct _heev_option {
6
6
  char uplo;
7
7
  };
8
8
 
9
- #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc) \
10
- static void _iter_##fLapackFunc(na_loop_t* const lp) { \
11
- tDType* a = (tDType*)NDL_PTR(lp, 0); \
12
- tRtDType* w = (tRtDType*)NDL_PTR(lp, 1); \
13
- int* info = (int*)NDL_PTR(lp, 2); \
14
- struct _heev_option* opt = (struct _heev_option*)(lp->opt_ptr); \
15
- const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[1]; \
16
- const lapack_int lda = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
17
- const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->jobz, opt->uplo, n, a, lda, w); \
18
- *info = (int)i; \
19
- } \
20
- \
21
- static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
22
- VALUE a_vnary = Qnil; \
23
- VALUE kw_args = Qnil; \
24
- rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
25
- ID kw_table[3] = { rb_intern("jobz"), rb_intern("uplo"), rb_intern("order") }; \
26
- VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
27
- rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
28
- const char jobz = kw_values[0] != Qundef ? get_jobz(kw_values[0]) : 'V'; \
29
- const char uplo = kw_values[1] != Qundef ? get_uplo(kw_values[1]) : 'U'; \
30
- const int matrix_layout = kw_values[2] != Qundef ? get_matrix_layout(kw_values[2]) : LAPACK_ROW_MAJOR; \
31
- \
32
- if (CLASS_OF(a_vnary) != tNAryClass) { \
33
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
34
- } \
35
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
36
- a_vnary = nary_dup(a_vnary); \
37
- } \
38
- \
39
- narray_t* a_nary = NULL; \
40
- GetNArray(a_vnary, a_nary); \
41
- if (NA_NDIM(a_nary) != 2) { \
42
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
43
- return Qnil; \
44
- } \
45
- if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
46
- rb_raise(rb_eArgError, "input array a must be square"); \
47
- return Qnil; \
48
- } \
49
- \
50
- const size_t n = NA_SHAPE(a_nary)[1]; \
51
- size_t shape[1] = { n }; \
52
- ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
53
- ndfunc_arg_out_t aout[2] = { { tRtNAryClass, 1, shape }, { numo_cInt32, 0 } }; \
54
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 2, ain, aout }; \
55
- struct _heev_option opt = { matrix_layout, jobz, uplo }; \
56
- VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
57
- VALUE ret = rb_ary_new3(3, a_vnary, rb_ary_entry(res, 0), rb_ary_entry(res, 1)); \
58
- \
59
- RB_GC_GUARD(a_vnary); \
60
- return ret; \
9
+ #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc) \
10
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
11
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
12
+ tRtDType* w = (tRtDType*)NDL_PTR(lp, 1); \
13
+ int* info = (int*)NDL_PTR(lp, 2); \
14
+ struct _heev_option* opt = (struct _heev_option*)(lp->opt_ptr); \
15
+ const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[1]; \
16
+ const lapack_int lda = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
17
+ const lapack_int i = \
18
+ LAPACKE_##fLapackFunc(opt->matrix_layout, opt->jobz, opt->uplo, n, a, lda, w); \
19
+ *info = (int)i; \
20
+ } \
21
+ \
22
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
23
+ VALUE a_vnary = Qnil; \
24
+ VALUE kw_args = Qnil; \
25
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
26
+ ID kw_table[3] = { rb_intern("jobz"), rb_intern("uplo"), rb_intern("order") }; \
27
+ VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
28
+ rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
29
+ const char jobz = kw_values[0] != Qundef ? get_jobz(kw_values[0]) : 'V'; \
30
+ const char uplo = kw_values[1] != Qundef ? get_uplo(kw_values[1]) : 'U'; \
31
+ const int matrix_layout = \
32
+ kw_values[2] != Qundef ? get_matrix_layout(kw_values[2]) : LAPACK_ROW_MAJOR; \
33
+ \
34
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
35
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
36
+ } \
37
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
38
+ a_vnary = nary_dup(a_vnary); \
39
+ } \
40
+ \
41
+ narray_t* a_nary = NULL; \
42
+ GetNArray(a_vnary, a_nary); \
43
+ if (NA_NDIM(a_nary) != 2) { \
44
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
45
+ return Qnil; \
46
+ } \
47
+ if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
48
+ rb_raise(rb_eArgError, "input array a must be square"); \
49
+ return Qnil; \
50
+ } \
51
+ \
52
+ const size_t n = NA_SHAPE(a_nary)[1]; \
53
+ size_t shape[1] = { n }; \
54
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
55
+ ndfunc_arg_out_t aout[2] = { { tRtNAryClass, 1, shape }, { numo_cInt32, 0 } }; \
56
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 2, ain, aout }; \
57
+ struct _heev_option opt = { matrix_layout, jobz, uplo }; \
58
+ VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
59
+ VALUE ret = rb_ary_new3(3, a_vnary, rb_ary_entry(res, 0), rb_ary_entry(res, 1)); \
60
+ \
61
+ RB_GC_GUARD(a_vnary); \
62
+ return ret; \
61
63
  }
62
64
 
63
65
  DEF_LINALG_FUNC(lapack_complex_double, double, numo_cDComplex, numo_cDFloat, zheev)