numo-linalg-alt 0.3.0 → 0.4.1

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 +9 -0
  3. data/ext/numo/linalg/blas/dot.c +61 -61
  4. data/ext/numo/linalg/blas/dot_sub.c +60 -60
  5. data/ext/numo/linalg/blas/gemm.c +161 -152
  6. data/ext/numo/linalg/blas/gemv.c +135 -131
  7. data/ext/numo/linalg/blas/nrm2.c +54 -54
  8. data/ext/numo/linalg/lapack/gebal.c +87 -0
  9. data/ext/numo/linalg/lapack/gebal.h +15 -0
  10. data/ext/numo/linalg/lapack/gees.c +243 -224
  11. data/ext/numo/linalg/lapack/geev.c +131 -114
  12. data/ext/numo/linalg/lapack/gelsd.c +85 -74
  13. data/ext/numo/linalg/lapack/geqrf.c +56 -55
  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 +100 -90
  17. data/ext/numo/linalg/lapack/gesv.c +84 -82
  18. data/ext/numo/linalg/lapack/gesvd.c +144 -133
  19. data/ext/numo/linalg/lapack/getrf.c +55 -54
  20. data/ext/numo/linalg/lapack/getri.c +68 -67
  21. data/ext/numo/linalg/lapack/getrs.c +96 -92
  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 +56 -54
  25. data/ext/numo/linalg/lapack/heevd.c +56 -54
  26. data/ext/numo/linalg/lapack/heevr.c +111 -100
  27. data/ext/numo/linalg/lapack/hegv.c +79 -76
  28. data/ext/numo/linalg/lapack/hegvd.c +79 -76
  29. data/ext/numo/linalg/lapack/hegvx.c +134 -122
  30. data/ext/numo/linalg/lapack/hetrf.c +56 -52
  31. data/ext/numo/linalg/lapack/lange.c +49 -48
  32. data/ext/numo/linalg/lapack/orgqr.c +65 -64
  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 +53 -52
  36. data/ext/numo/linalg/lapack/potri.c +53 -52
  37. data/ext/numo/linalg/lapack/potrs.c +78 -76
  38. data/ext/numo/linalg/lapack/syev.c +56 -54
  39. data/ext/numo/linalg/lapack/syevd.c +56 -54
  40. data/ext/numo/linalg/lapack/syevr.c +109 -100
  41. data/ext/numo/linalg/lapack/sygv.c +79 -75
  42. data/ext/numo/linalg/lapack/sygvd.c +79 -75
  43. data/ext/numo/linalg/lapack/sygvx.c +134 -122
  44. data/ext/numo/linalg/lapack/sytrf.c +58 -54
  45. data/ext/numo/linalg/lapack/trtrs.c +83 -79
  46. data/ext/numo/linalg/lapack/ungqr.c +65 -64
  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 +24 -13
  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 +235 -3
  55. metadata +12 -2
data/ext/numo/linalg/blas/gemv.c CHANGED
@@ -1,138 +1,142 @@
1
1
  #include "gemv.h"
2
2
 
3
- #define DEF_LINALG_OPTIONS(tDType) \
4
- struct _gemv_options_##tDType { \
5
- tDType alpha; \
6
- tDType beta; \
7
- enum CBLAS_ORDER order; \
8
- enum CBLAS_TRANSPOSE trans; \
9
- blasint m; \
10
- blasint n; \
3
+ #define DEF_LINALG_OPTIONS(tDType) \
4
+ struct _gemv_options_##tDType { \
5
+ tDType alpha; \
6
+ tDType beta; \
7
+ enum CBLAS_ORDER order; \
8
+ enum CBLAS_TRANSPOSE trans; \
9
+ blasint m; \
10
+ blasint n; \
11
11
  };
12
12
 
13
- #define DEF_LINALG_ITER_FUNC(tDType, fBlasFunc) \
14
- static void _iter_##fBlasFunc(na_loop_t* const lp) { \
15
- const tDType* a = (tDType*)NDL_PTR(lp, 0); \
16
- const tDType* x = (tDType*)NDL_PTR(lp, 1); \
17
- tDType* y = (tDType*)NDL_PTR(lp, 2); \
18
- const struct _gemv_options_##tDType* opt = (struct _gemv_options_##tDType*)(lp->opt_ptr); \
19
- const blasint lda = opt->n; \
20
- cblas_##fBlasFunc(opt->order, opt->trans, opt->m, opt->n, \
21
- opt->alpha, a, lda, x, 1, opt->beta, y, 1); \
13
+ #define DEF_LINALG_ITER_FUNC(tDType, fBlasFunc) \
14
+ static void _iter_##fBlasFunc(na_loop_t* const lp) { \
15
+ const tDType* a = (tDType*)NDL_PTR(lp, 0); \
16
+ const tDType* x = (tDType*)NDL_PTR(lp, 1); \
17
+ tDType* y = (tDType*)NDL_PTR(lp, 2); \
18
+ const struct _gemv_options_##tDType* opt = (struct _gemv_options_##tDType*)(lp->opt_ptr); \
19
+ const blasint lda = opt->n; \
20
+ cblas_##fBlasFunc( \
21
+ opt->order, opt->trans, opt->m, opt->n, opt->alpha, a, lda, x, 1, opt->beta, y, 1 \
22
+ ); \
22
23
  }
23
24
 
24
- #define DEF_LINALG_ITER_FUNC_COMPLEX(tDType, fBlasFunc) \
25
- static void _iter_##fBlasFunc(na_loop_t* const lp) { \
26
- const tDType* a = (tDType*)NDL_PTR(lp, 0); \
27
- const tDType* x = (tDType*)NDL_PTR(lp, 1); \
28
- tDType* y = (tDType*)NDL_PTR(lp, 2); \
29
- const struct _gemv_options_##tDType* opt = (struct _gemv_options_##tDType*)(lp->opt_ptr); \
30
- const blasint lda = opt->n; \
31
- cblas_##fBlasFunc(opt->order, opt->trans, opt->m, opt->n, \
32
- &opt->alpha, a, lda, x, 1, &opt->beta, y, 1); \
25
+ #define DEF_LINALG_ITER_FUNC_COMPLEX(tDType, fBlasFunc) \
26
+ static void _iter_##fBlasFunc(na_loop_t* const lp) { \
27
+ const tDType* a = (tDType*)NDL_PTR(lp, 0); \
28
+ const tDType* x = (tDType*)NDL_PTR(lp, 1); \
29
+ tDType* y = (tDType*)NDL_PTR(lp, 2); \
30
+ const struct _gemv_options_##tDType* opt = (struct _gemv_options_##tDType*)(lp->opt_ptr); \
31
+ const blasint lda = opt->n; \
32
+ cblas_##fBlasFunc( \
33
+ opt->order, opt->trans, opt->m, opt->n, &opt->alpha, a, lda, x, 1, &opt->beta, y, 1 \
34
+ ); \
33
35
  }
34
36
 
35
- #define DEF_LINALG_FUNC(tDType, tNAryClass, fBlasFunc) \
36
- static VALUE _linalg_blas_##fBlasFunc(int argc, VALUE* argv, VALUE self) { \
37
- VALUE a = Qnil; \
38
- VALUE x = Qnil; \
39
- VALUE y = Qnil; \
40
- VALUE kw_args = Qnil; \
41
- rb_scan_args(argc, argv, "21:", &a, &x, &y, &kw_args); \
42
- \
43
- ID kw_table[4] = { rb_intern("alpha"), rb_intern("beta"), \
44
- rb_intern("order"), rb_intern("trans") }; \
45
- VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef }; \
46
- rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values); \
47
- \
48
- if (CLASS_OF(a) != tNAryClass) { \
49
- a = rb_funcall(tNAryClass, rb_intern("cast"), 1, a); \
50
- } \
51
- if (!RTEST(nary_check_contiguous(a))) { \
52
- a = nary_dup(a); \
53
- } \
54
- if (CLASS_OF(x) != tNAryClass) { \
55
- x = rb_funcall(tNAryClass, rb_intern("cast"), 1, x); \
56
- } \
57
- if (!RTEST(nary_check_contiguous(x))) { \
58
- x = nary_dup(x); \
59
- } \
60
- if (!NIL_P(y)) { \
61
- if (CLASS_OF(y) != tNAryClass) { \
62
- y = rb_funcall(tNAryClass, rb_intern("cast"), 1, y); \
63
- } \
64
- if (!RTEST(nary_check_contiguous(y))) { \
65
- y = nary_dup(y); \
66
- } \
67
- } \
68
- \
69
- tDType alpha = kw_values[0] != Qundef ? conv_##tDType(kw_values[0]) : one_##tDType(); \
70
- tDType beta = kw_values[1] != Qundef ? conv_##tDType(kw_values[1]) : zero_##tDType(); \
71
- enum CBLAS_ORDER order = kw_values[2] != Qundef ? get_cblas_order(kw_values[2]) : CblasRowMajor; \
72
- enum CBLAS_TRANSPOSE trans = kw_values[3] != Qundef ? get_cblas_trans(kw_values[3]) : CblasNoTrans; \
73
- \
74
- narray_t* a_nary = NULL; \
75
- GetNArray(a, a_nary); \
76
- narray_t* x_nary = NULL; \
77
- GetNArray(x, x_nary); \
78
- \
79
- if (NA_NDIM(a_nary) != 2) { \
80
- rb_raise(rb_eArgError, "a must be 2-dimensional"); \
81
- return Qnil; \
82
- } \
83
- if (NA_NDIM(x_nary) != 1) { \
84
- rb_raise(rb_eArgError, "x must be 1-dimensional"); \
85
- return Qnil; \
86
- } \
87
- if (NA_SIZE(a_nary) == 0) { \
88
- rb_raise(rb_eArgError, "a must not be empty"); \
89
- return Qnil; \
90
- } \
91
- if (NA_SIZE(x_nary) == 0) { \
92
- rb_raise(rb_eArgError, "x must not be empty"); \
93
- return Qnil; \
94
- } \
95
- \
96
- const blasint ma = (blasint)NA_SHAPE(a_nary)[0]; \
97
- const blasint na = (blasint)NA_SHAPE(a_nary)[1]; \
98
- const blasint mx = (blasint)NA_SHAPE(x_nary)[0]; \
99
- const blasint m = trans == CblasNoTrans ? ma : na; \
100
- const blasint n = trans == CblasNoTrans ? na : ma; \
101
- \
102
- if (n != mx) { \
103
- rb_raise(nary_eShapeError, "shape1[1](=%d) != shape2[0](=%d)", n, mx); \
104
- return Qnil; \
105
- } \
106
- \
107
- struct _gemv_options_##tDType opt = { alpha, beta, order, trans, ma, na }; \
108
- size_t shape_out[1] = { (size_t)(m) }; \
109
- ndfunc_arg_out_t aout[1] = { { tNAryClass, 1, shape_out } }; \
110
- VALUE ret = Qnil; \
111
- \
112
- if (!NIL_P(y)) { \
113
- narray_t* y_nary = NULL; \
114
- GetNArray(y, y_nary); \
115
- blasint my = (blasint)NA_SHAPE(y_nary)[0]; \
116
- if (m > my) { \
117
- rb_raise(nary_eShapeError, "shape3[0](=%d) >= shape1[0]=%d", my, m); \
118
- return Qnil; \
119
- } \
120
- ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { tNAryClass, 1 }, { OVERWRITE, 1 } }; \
121
- ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP, 3, 0, ain, aout }; \
122
- na_ndloop3(&ndf, &opt, 3, a, x, y); \
123
- ret = y; \
124
- } else { \
125
- y = INT2NUM(0); \
126
- ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { tNAryClass, 1 }, { sym_init, 0 } }; \
127
- ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP, 3, 1, ain, aout }; \
128
- ret = na_ndloop3(&ndf, &opt, 3, a, x, y); \
129
- } \
130
- \
131
- RB_GC_GUARD(a); \
132
- RB_GC_GUARD(x); \
133
- RB_GC_GUARD(y); \
134
- \
135
- return ret; \
37
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fBlasFunc) \
38
+ static VALUE _linalg_blas_##fBlasFunc(int argc, VALUE* argv, VALUE self) { \
39
+ VALUE a = Qnil; \
40
+ VALUE x = Qnil; \
41
+ VALUE y = Qnil; \
42
+ VALUE kw_args = Qnil; \
43
+ rb_scan_args(argc, argv, "21:", &a, &x, &y, &kw_args); \
44
+ \
45
+ ID kw_table[4] = { rb_intern("alpha"), rb_intern("beta"), rb_intern("order"), \
46
+ rb_intern("trans") }; \
47
+ VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef }; \
48
+ rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values); \
49
+ \
50
+ if (CLASS_OF(a) != tNAryClass) { \
51
+ a = rb_funcall(tNAryClass, rb_intern("cast"), 1, a); \
52
+ } \
53
+ if (!RTEST(nary_check_contiguous(a))) { \
54
+ a = nary_dup(a); \
55
+ } \
56
+ if (CLASS_OF(x) != tNAryClass) { \
57
+ x = rb_funcall(tNAryClass, rb_intern("cast"), 1, x); \
58
+ } \
59
+ if (!RTEST(nary_check_contiguous(x))) { \
60
+ x = nary_dup(x); \
61
+ } \
62
+ if (!NIL_P(y)) { \
63
+ if (CLASS_OF(y) != tNAryClass) { \
64
+ y = rb_funcall(tNAryClass, rb_intern("cast"), 1, y); \
65
+ } \
66
+ if (!RTEST(nary_check_contiguous(y))) { \
67
+ y = nary_dup(y); \
68
+ } \
69
+ } \
70
+ \
71
+ tDType alpha = kw_values[0] != Qundef ? conv_##tDType(kw_values[0]) : one_##tDType(); \
72
+ tDType beta = kw_values[1] != Qundef ? conv_##tDType(kw_values[1]) : zero_##tDType(); \
73
+ enum CBLAS_ORDER order = \
74
+ kw_values[2] != Qundef ? get_cblas_order(kw_values[2]) : CblasRowMajor; \
75
+ enum CBLAS_TRANSPOSE trans = \
76
+ kw_values[3] != Qundef ? get_cblas_trans(kw_values[3]) : CblasNoTrans; \
77
+ \
78
+ narray_t* a_nary = NULL; \
79
+ GetNArray(a, a_nary); \
80
+ narray_t* x_nary = NULL; \
81
+ GetNArray(x, x_nary); \
82
+ \
83
+ if (NA_NDIM(a_nary) != 2) { \
84
+ rb_raise(rb_eArgError, "a must be 2-dimensional"); \
85
+ return Qnil; \
86
+ } \
87
+ if (NA_NDIM(x_nary) != 1) { \
88
+ rb_raise(rb_eArgError, "x must be 1-dimensional"); \
89
+ return Qnil; \
90
+ } \
91
+ if (NA_SIZE(a_nary) == 0) { \
92
+ rb_raise(rb_eArgError, "a must not be empty"); \
93
+ return Qnil; \
94
+ } \
95
+ if (NA_SIZE(x_nary) == 0) { \
96
+ rb_raise(rb_eArgError, "x must not be empty"); \
97
+ return Qnil; \
98
+ } \
99
+ \
100
+ const blasint ma = (blasint)NA_SHAPE(a_nary)[0]; \
101
+ const blasint na = (blasint)NA_SHAPE(a_nary)[1]; \
102
+ const blasint mx = (blasint)NA_SHAPE(x_nary)[0]; \
103
+ const blasint m = trans == CblasNoTrans ? ma : na; \
104
+ const blasint n = trans == CblasNoTrans ? na : ma; \
105
+ \
106
+ if (n != mx) { \
107
+ rb_raise(nary_eShapeError, "shape1[1](=%d) != shape2[0](=%d)", n, mx); \
108
+ return Qnil; \
109
+ } \
110
+ \
111
+ struct _gemv_options_##tDType opt = { alpha, beta, order, trans, ma, na }; \
112
+ size_t shape_out[1] = { (size_t)(m) }; \
113
+ ndfunc_arg_out_t aout[1] = { { tNAryClass, 1, shape_out } }; \
114
+ VALUE ret = Qnil; \
115
+ \
116
+ if (!NIL_P(y)) { \
117
+ narray_t* y_nary = NULL; \
118
+ GetNArray(y, y_nary); \
119
+ blasint my = (blasint)NA_SHAPE(y_nary)[0]; \
120
+ if (m > my) { \
121
+ rb_raise(nary_eShapeError, "shape3[0](=%d) >= shape1[0]=%d", my, m); \
122
+ return Qnil; \
123
+ } \
124
+ ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { tNAryClass, 1 }, { OVERWRITE, 1 } }; \
125
+ ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP, 3, 0, ain, aout }; \
126
+ na_ndloop3(&ndf, &opt, 3, a, x, y); \
127
+ ret = y; \
128
+ } else { \
129
+ y = INT2NUM(0); \
130
+ ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { tNAryClass, 1 }, { sym_init, 0 } }; \
131
+ ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP, 3, 1, ain, aout }; \
132
+ ret = na_ndloop3(&ndf, &opt, 3, a, x, y); \
133
+ } \
134
+ \
135
+ RB_GC_GUARD(a); \
136
+ RB_GC_GUARD(x); \
137
+ RB_GC_GUARD(y); \
138
+ \
139
+ return ret; \
136
140
  }
137
141
 
138
142
  DEF_LINALG_OPTIONS(double)
@@ -154,8 +158,8 @@ DEF_LINALG_FUNC(scomplex, numo_cSComplex, cgemv)
154
158
  #undef DEF_LINALG_FUNC
155
159
 
156
160
  void define_linalg_blas_gemv(VALUE mBlas) {
157
- rb_define_module_function(mBlas, "dgemv", RUBY_METHOD_FUNC(_linalg_blas_dgemv), -1);
158
- rb_define_module_function(mBlas, "sgemv", RUBY_METHOD_FUNC(_linalg_blas_sgemv), -1);
159
- rb_define_module_function(mBlas, "zgemv", RUBY_METHOD_FUNC(_linalg_blas_zgemv), -1);
160
- rb_define_module_function(mBlas, "cgemv", RUBY_METHOD_FUNC(_linalg_blas_cgemv), -1);
161
+ rb_define_module_function(mBlas, "dgemv", _linalg_blas_dgemv, -1);
162
+ rb_define_module_function(mBlas, "sgemv", _linalg_blas_sgemv, -1);
163
+ rb_define_module_function(mBlas, "zgemv", _linalg_blas_zgemv, -1);
164
+ rb_define_module_function(mBlas, "cgemv", _linalg_blas_cgemv, -1);
161
165
  }
data/ext/numo/linalg/blas/nrm2.c CHANGED
@@ -1,55 +1,55 @@
1
1
  #include "nrm2.h"
2
2
 
3
- #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fBlasFunc) \
4
- static void _iter_##fBlasFunc(na_loop_t* const lp) { \
5
- tDType* x = (tDType*)NDL_PTR(lp, 0); \
6
- tRtDType* d = (tRtDType*)NDL_PTR(lp, 1); \
7
- const blasint n = (blasint)NDL_SHAPE(lp, 0)[0]; \
8
- tRtDType ret = cblas_##fBlasFunc(n, x, 1); \
9
- *d = ret; \
10
- } \
11
- \
12
- static VALUE _linalg_blas_##fBlasFunc(int argc, VALUE* argv, VALUE self) { \
13
- VALUE x = Qnil; \
14
- VALUE kw_args = Qnil; \
15
- rb_scan_args(argc, argv, "1:", &x, &kw_args); \
16
- \
17
- ID kw_table[1] = { rb_intern("keepdims") }; \
18
- VALUE kw_values[1] = { Qundef }; \
19
- rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
20
- const bool keepdims = kw_values[0] != Qundef ? RTEST(kw_values[0]) : false; \
21
- \
22
- if (CLASS_OF(x) != tNAryClass) { \
23
- x = rb_funcall(tNAryClass, rb_intern("cast"), 1, x); \
24
- } \
25
- if (!RTEST(nary_check_contiguous(x))) { \
26
- x = nary_dup(x); \
27
- } \
28
- \
29
- narray_t* x_nary = NULL; \
30
- GetNArray(x, x_nary); \
31
- \
32
- if (NA_NDIM(x_nary) != 1) { \
33
- rb_raise(rb_eArgError, "x must be 1-dimensional"); \
34
- return Qnil; \
35
- } \
36
- if (NA_SIZE(x_nary) == 0) { \
37
- rb_raise(rb_eArgError, "x must not be empty"); \
38
- return Qnil; \
39
- } \
40
- \
41
- ndfunc_arg_in_t ain[1] = { { tNAryClass, 1 } }; \
42
- size_t shape_out[1] = { 1 }; \
43
- ndfunc_arg_out_t aout[1] = { { tRtNAryClass, 0, shape_out } }; \
44
- ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
45
- if (keepdims) { \
46
- ndf.flag |= NDF_KEEP_DIM; \
47
- } \
48
- \
49
- VALUE ret = na_ndloop(&ndf, 1, x); \
50
- \
51
- RB_GC_GUARD(x); \
52
- return ret; \
3
+ #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fBlasFunc) \
4
+ static void _iter_##fBlasFunc(na_loop_t* const lp) { \
5
+ tDType* x = (tDType*)NDL_PTR(lp, 0); \
6
+ tRtDType* d = (tRtDType*)NDL_PTR(lp, 1); \
7
+ const blasint n = (blasint)NDL_SHAPE(lp, 0)[0]; \
8
+ tRtDType ret = cblas_##fBlasFunc(n, x, 1); \
9
+ *d = ret; \
10
+ } \
11
+ \
12
+ static VALUE _linalg_blas_##fBlasFunc(int argc, VALUE* argv, VALUE self) { \
13
+ VALUE x = Qnil; \
14
+ VALUE kw_args = Qnil; \
15
+ rb_scan_args(argc, argv, "1:", &x, &kw_args); \
16
+ \
17
+ ID kw_table[1] = { rb_intern("keepdims") }; \
18
+ VALUE kw_values[1] = { Qundef }; \
19
+ rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
20
+ const bool keepdims = kw_values[0] != Qundef ? RTEST(kw_values[0]) : false; \
21
+ \
22
+ if (CLASS_OF(x) != tNAryClass) { \
23
+ x = rb_funcall(tNAryClass, rb_intern("cast"), 1, x); \
24
+ } \
25
+ if (!RTEST(nary_check_contiguous(x))) { \
26
+ x = nary_dup(x); \
27
+ } \
28
+ \
29
+ narray_t* x_nary = NULL; \
30
+ GetNArray(x, x_nary); \
31
+ \
32
+ if (NA_NDIM(x_nary) != 1) { \
33
+ rb_raise(rb_eArgError, "x must be 1-dimensional"); \
34
+ return Qnil; \
35
+ } \
36
+ if (NA_SIZE(x_nary) == 0) { \
37
+ rb_raise(rb_eArgError, "x must not be empty"); \
38
+ return Qnil; \
39
+ } \
40
+ \
41
+ ndfunc_arg_in_t ain[1] = { { tNAryClass, 1 } }; \
42
+ size_t shape_out[1] = { 1 }; \
43
+ ndfunc_arg_out_t aout[1] = { { tRtNAryClass, 0, shape_out } }; \
44
+ ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
45
+ if (keepdims) { \
46
+ ndf.flag |= NDF_KEEP_DIM; \
47
+ } \
48
+ \
49
+ VALUE ret = na_ndloop(&ndf, 1, x); \
50
+ \
51
+ RB_GC_GUARD(x); \
52
+ return ret; \
53
53
  }
54
54
 
55
55
  DEF_LINALG_FUNC(double, double, numo_cDFloat, numo_cDFloat, dnrm2)
@@ -60,8 +60,8 @@ DEF_LINALG_FUNC(scomplex, float, numo_cSComplex, numo_cSFloat, scnrm2)
60
60
  #undef DEF_LINALG_FUNC
61
61
 
62
62
  void define_linalg_blas_nrm2(VALUE mBlas) {
63
- rb_define_module_function(mBlas, "dnrm2", RUBY_METHOD_FUNC(_linalg_blas_dnrm2), -1);
64
- rb_define_module_function(mBlas, "snrm2", RUBY_METHOD_FUNC(_linalg_blas_snrm2), -1);
65
- rb_define_module_function(mBlas, "dznrm2", RUBY_METHOD_FUNC(_linalg_blas_dznrm2), -1);
66
- rb_define_module_function(mBlas, "scnrm2", RUBY_METHOD_FUNC(_linalg_blas_scnrm2), -1);
63
+ rb_define_module_function(mBlas, "dnrm2", _linalg_blas_dnrm2, -1);
64
+ rb_define_module_function(mBlas, "snrm2", _linalg_blas_snrm2, -1);
65
+ rb_define_module_function(mBlas, "dznrm2", _linalg_blas_dznrm2, -1);
66
+ rb_define_module_function(mBlas, "scnrm2", _linalg_blas_scnrm2, -1);
67
67
  }
data/ext/numo/linalg/lapack/gebal.c ADDED
@@ -0,0 +1,87 @@
1
+ #include "gebal.h"
2
+
3
+ struct _gebal_option {
4
+ int matrix_layout;
5
+ char job;
6
+ };
7
+
8
+ char _get_job(VALUE val) {
9
+ const char job = NUM2CHR(val);
10
+ if (job != 'N' && job != 'P' && job != 'S' && job != 'B') {
11
+ rb_raise(rb_eArgError, "job must be 'N', 'P', 'S', or 'B'");
12
+ }
13
+ return job;
14
+ }
15
+
16
+ #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc) \
17
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
18
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
19
+ int* ilo = (int*)NDL_PTR(lp, 1); \
20
+ int* ihi = (int*)NDL_PTR(lp, 2); \
21
+ tRtDType* scale = (tRtDType*)NDL_PTR(lp, 3); \
22
+ int* info = (int*)NDL_PTR(lp, 4); \
23
+ struct _gebal_option* opt = (struct _gebal_option*)(lp->opt_ptr); \
24
+ const lapack_int n = \
25
+ (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] \
26
+ : NDL_SHAPE(lp, 0)[1]); \
27
+ const lapack_int lda = n; \
28
+ lapack_int i = \
29
+ LAPACKE_##fLapackFunc(opt->matrix_layout, opt->job, n, a, lda, ilo, ihi, scale); \
30
+ *info = (int)i; \
31
+ } \
32
+ \
33
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
34
+ VALUE a_vnary = Qnil; \
35
+ VALUE kw_args = Qnil; \
36
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
37
+ ID kw_table[2] = { rb_intern("order"), rb_intern("job") }; \
38
+ VALUE kw_values[2] = { Qundef, Qundef }; \
39
+ rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
40
+ const int matrix_layout = \
41
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
42
+ const char job = kw_values[1] != Qundef ? _get_job(kw_values[1]) : 'B'; \
43
+ \
44
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
45
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
46
+ } \
47
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
48
+ a_vnary = nary_dup(a_vnary); \
49
+ } \
50
+ \
51
+ narray_t* a_nary = NULL; \
52
+ GetNArray(a_vnary, a_nary); \
53
+ const int n_dims = NA_NDIM(a_nary); \
54
+ if (n_dims != 2) { \
55
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
56
+ return Qnil; \
57
+ } \
58
+ \
59
+ size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
60
+ size_t shape_scale[1] = { n }; \
61
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
62
+ ndfunc_arg_out_t aout[4] = { { numo_cInt32, 0 }, \
63
+ { numo_cInt32, 0 }, \
64
+ { tRtNAryClass, 1, shape_scale }, \
65
+ { numo_cInt32, 0 } }; \
66
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout }; \
67
+ struct _gebal_option opt = { matrix_layout, job }; \
68
+ VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
69
+ VALUE ret = rb_ary_concat(rb_ary_new3(1, a_vnary), res); \
70
+ \
71
+ RB_GC_GUARD(a_vnary); \
72
+ return ret; \
73
+ }
74
+
75
+ DEF_LINALG_FUNC(double, double, numo_cDFloat, numo_cDFloat, dgebal)
76
+ DEF_LINALG_FUNC(float, float, numo_cSFloat, numo_cSFloat, sgebal)
77
+ DEF_LINALG_FUNC(lapack_complex_double, double, numo_cDComplex, numo_cDFloat, zgebal)
78
+ DEF_LINALG_FUNC(lapack_complex_float, float, numo_cSComplex, numo_cSFloat, cgebal)
79
+
80
+ #undef DEF_LINALG_FUNC
81
+
82
+ void define_linalg_lapack_gebal(VALUE mLapack) {
83
+ rb_define_module_function(mLapack, "dgebal", _linalg_lapack_dgebal, -1);
84
+ rb_define_module_function(mLapack, "sgebal", _linalg_lapack_sgebal, -1);
85
+ rb_define_module_function(mLapack, "zgebal", _linalg_lapack_zgebal, -1);
86
+ rb_define_module_function(mLapack, "cgebal", _linalg_lapack_cgebal, -1);
87
+ }
data/ext/numo/linalg/lapack/gebal.h ADDED
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GEBAL_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GEBAL_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_gebal(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GEBAL_H */