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.
- checksums.yaml +4 -4
- data/CHANGELOG.md +10 -1
- data/README.md +3 -1
- data/ext/numo/linalg/blas/dot.c +59 -59
- data/ext/numo/linalg/blas/dot_sub.c +58 -58
- data/ext/numo/linalg/blas/gemm.c +157 -148
- data/ext/numo/linalg/blas/gemv.c +131 -127
- data/ext/numo/linalg/blas/nrm2.c +50 -50
- data/ext/numo/linalg/lapack/gees.c +276 -0
- data/ext/numo/linalg/lapack/gees.h +15 -0
- data/ext/numo/linalg/lapack/geev.c +127 -110
- data/ext/numo/linalg/lapack/gelsd.c +81 -70
- data/ext/numo/linalg/lapack/geqrf.c +52 -51
- data/ext/numo/linalg/lapack/gerqf.c +70 -0
- data/ext/numo/linalg/lapack/gerqf.h +15 -0
- data/ext/numo/linalg/lapack/gesdd.c +96 -86
- data/ext/numo/linalg/lapack/gesv.c +80 -78
- data/ext/numo/linalg/lapack/gesvd.c +140 -129
- data/ext/numo/linalg/lapack/getrf.c +51 -50
- data/ext/numo/linalg/lapack/getri.c +64 -63
- data/ext/numo/linalg/lapack/getrs.c +92 -88
- data/ext/numo/linalg/lapack/gges.c +214 -0
- data/ext/numo/linalg/lapack/gges.h +15 -0
- data/ext/numo/linalg/lapack/heev.c +54 -52
- data/ext/numo/linalg/lapack/heevd.c +54 -52
- data/ext/numo/linalg/lapack/heevr.c +109 -98
- data/ext/numo/linalg/lapack/hegv.c +77 -74
- data/ext/numo/linalg/lapack/hegvd.c +77 -74
- data/ext/numo/linalg/lapack/hegvx.c +132 -120
- data/ext/numo/linalg/lapack/hetrf.c +54 -50
- data/ext/numo/linalg/lapack/lange.c +45 -44
- data/ext/numo/linalg/lapack/orgqr.c +63 -62
- data/ext/numo/linalg/lapack/orgrq.c +78 -0
- data/ext/numo/linalg/lapack/orgrq.h +15 -0
- data/ext/numo/linalg/lapack/potrf.c +49 -48
- data/ext/numo/linalg/lapack/potri.c +49 -48
- data/ext/numo/linalg/lapack/potrs.c +74 -72
- data/ext/numo/linalg/lapack/syev.c +54 -52
- data/ext/numo/linalg/lapack/syevd.c +54 -52
- data/ext/numo/linalg/lapack/syevr.c +107 -98
- data/ext/numo/linalg/lapack/sygv.c +77 -73
- data/ext/numo/linalg/lapack/sygvd.c +77 -73
- data/ext/numo/linalg/lapack/sygvx.c +132 -120
- data/ext/numo/linalg/lapack/sytrf.c +54 -50
- data/ext/numo/linalg/lapack/trtrs.c +79 -75
- data/ext/numo/linalg/lapack/ungqr.c +63 -62
- data/ext/numo/linalg/lapack/ungrq.c +78 -0
- data/ext/numo/linalg/lapack/ungrq.h +15 -0
- data/ext/numo/linalg/linalg.c +21 -10
- data/ext/numo/linalg/linalg.h +5 -0
- data/ext/numo/linalg/util.c +8 -0
- data/ext/numo/linalg/util.h +1 -0
- data/lib/numo/linalg/version.rb +1 -1
- data/lib/numo/linalg.rb +322 -0
- metadata +14 -4
|
@@ -1,125 +1,137 @@
|
|
|
1
1
|
#include "hegvx.h"
|
|
2
2
|
|
|
3
|
-
#define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc)
|
|
4
|
-
struct _hegvx_option_##tRtDType {
|
|
5
|
-
int matrix_layout;
|
|
6
|
-
lapack_int itype;
|
|
7
|
-
char jobz;
|
|
8
|
-
char range;
|
|
9
|
-
char uplo;
|
|
10
|
-
tRtDType vl;
|
|
11
|
-
tRtDType vu;
|
|
12
|
-
lapack_int il;
|
|
13
|
-
lapack_int iu;
|
|
14
|
-
};
|
|
15
|
-
|
|
16
|
-
static void _iter_##fLapackFunc(na_loop_t* const lp) {
|
|
17
|
-
tDType* a = (tDType*)NDL_PTR(lp, 0);
|
|
18
|
-
tDType* b = (tDType*)NDL_PTR(lp, 1);
|
|
19
|
-
int* m = (int*)NDL_PTR(lp, 2);
|
|
20
|
-
tRtDType* w = (tRtDType*)NDL_PTR(lp, 3);
|
|
21
|
-
tDType* z = (tDType*)NDL_PTR(lp, 4);
|
|
22
|
-
int* ifail = (int*)NDL_PTR(lp, 5);
|
|
23
|
-
int* info = (int*)NDL_PTR(lp, 6);
|
|
24
|
-
struct _hegvx_option_##tRtDType* opt = (struct _hegvx_option_##tRtDType*)(lp->opt_ptr);
|
|
25
|
-
const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[1];
|
|
26
|
-
const lapack_int lda = (lapack_int)NDL_SHAPE(lp, 0)[0];
|
|
27
|
-
const lapack_int ldb = (lapack_int)NDL_SHAPE(lp, 1)[0];
|
|
28
|
-
const lapack_int ldz = opt->range != 'I' ? n : opt->iu - opt->il + 1;
|
|
29
|
-
const tRtDType abstol = 0.0;
|
|
30
|
-
const lapack_int i = LAPACKE_##fLapackFunc(
|
|
31
|
-
opt->matrix_layout, opt->itype, opt->jobz, opt->range, opt->uplo, n, a, lda, b, ldb,
|
|
32
|
-
opt->vl, opt->vu, opt->il, opt->iu, abstol, m, w, z, ldz, ifail
|
|
33
|
-
|
|
34
|
-
|
|
35
|
-
|
|
36
|
-
|
|
37
|
-
|
|
38
|
-
VALUE
|
|
39
|
-
VALUE
|
|
40
|
-
|
|
41
|
-
|
|
42
|
-
|
|
43
|
-
|
|
44
|
-
|
|
45
|
-
|
|
46
|
-
|
|
47
|
-
|
|
48
|
-
const
|
|
49
|
-
const
|
|
50
|
-
const
|
|
51
|
-
const
|
|
52
|
-
const
|
|
53
|
-
const
|
|
54
|
-
|
|
55
|
-
|
|
56
|
-
|
|
57
|
-
|
|
58
|
-
|
|
59
|
-
|
|
60
|
-
|
|
61
|
-
|
|
62
|
-
|
|
63
|
-
|
|
64
|
-
|
|
65
|
-
|
|
66
|
-
|
|
67
|
-
|
|
68
|
-
|
|
69
|
-
|
|
70
|
-
|
|
71
|
-
|
|
72
|
-
|
|
73
|
-
|
|
74
|
-
if (
|
|
75
|
-
rb_raise(rb_eArgError, "input array a must be
|
|
76
|
-
return Qnil;
|
|
77
|
-
}
|
|
78
|
-
|
|
79
|
-
|
|
80
|
-
|
|
81
|
-
|
|
82
|
-
|
|
83
|
-
|
|
84
|
-
if (
|
|
85
|
-
rb_raise(rb_eArgError, "input array b must be
|
|
86
|
-
return Qnil;
|
|
87
|
-
}
|
|
88
|
-
|
|
89
|
-
|
|
90
|
-
|
|
91
|
-
|
|
92
|
-
|
|
93
|
-
|
|
94
|
-
|
|
95
|
-
|
|
96
|
-
|
|
97
|
-
|
|
98
|
-
|
|
99
|
-
if (range == 'I' && (
|
|
100
|
-
rb_raise(rb_eArgError, "
|
|
101
|
-
return Qnil;
|
|
102
|
-
}
|
|
103
|
-
if (range == 'I' && iu <
|
|
104
|
-
rb_raise(rb_eArgError, "
|
|
105
|
-
return Qnil;
|
|
106
|
-
}
|
|
107
|
-
|
|
108
|
-
|
|
109
|
-
|
|
110
|
-
|
|
111
|
-
|
|
112
|
-
|
|
113
|
-
|
|
114
|
-
|
|
115
|
-
|
|
116
|
-
|
|
117
|
-
|
|
118
|
-
|
|
119
|
-
|
|
120
|
-
|
|
121
|
-
|
|
122
|
-
|
|
3
|
+
#define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc) \
|
|
4
|
+
struct _hegvx_option_##tRtDType { \
|
|
5
|
+
int matrix_layout; \
|
|
6
|
+
lapack_int itype; \
|
|
7
|
+
char jobz; \
|
|
8
|
+
char range; \
|
|
9
|
+
char uplo; \
|
|
10
|
+
tRtDType vl; \
|
|
11
|
+
tRtDType vu; \
|
|
12
|
+
lapack_int il; \
|
|
13
|
+
lapack_int iu; \
|
|
14
|
+
}; \
|
|
15
|
+
\
|
|
16
|
+
static void _iter_##fLapackFunc(na_loop_t* const lp) { \
|
|
17
|
+
tDType* a = (tDType*)NDL_PTR(lp, 0); \
|
|
18
|
+
tDType* b = (tDType*)NDL_PTR(lp, 1); \
|
|
19
|
+
int* m = (int*)NDL_PTR(lp, 2); \
|
|
20
|
+
tRtDType* w = (tRtDType*)NDL_PTR(lp, 3); \
|
|
21
|
+
tDType* z = (tDType*)NDL_PTR(lp, 4); \
|
|
22
|
+
int* ifail = (int*)NDL_PTR(lp, 5); \
|
|
23
|
+
int* info = (int*)NDL_PTR(lp, 6); \
|
|
24
|
+
struct _hegvx_option_##tRtDType* opt = (struct _hegvx_option_##tRtDType*)(lp->opt_ptr); \
|
|
25
|
+
const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[1]; \
|
|
26
|
+
const lapack_int lda = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
|
|
27
|
+
const lapack_int ldb = (lapack_int)NDL_SHAPE(lp, 1)[0]; \
|
|
28
|
+
const lapack_int ldz = opt->range != 'I' ? n : opt->iu - opt->il + 1; \
|
|
29
|
+
const tRtDType abstol = 0.0; \
|
|
30
|
+
const lapack_int i = LAPACKE_##fLapackFunc( \
|
|
31
|
+
opt->matrix_layout, opt->itype, opt->jobz, opt->range, opt->uplo, n, a, lda, b, ldb, \
|
|
32
|
+
opt->vl, opt->vu, opt->il, opt->iu, abstol, m, w, z, ldz, ifail \
|
|
33
|
+
); \
|
|
34
|
+
*info = (int)i; \
|
|
35
|
+
} \
|
|
36
|
+
\
|
|
37
|
+
static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
|
|
38
|
+
VALUE a_vnary = Qnil; \
|
|
39
|
+
VALUE b_vnary = Qnil; \
|
|
40
|
+
VALUE kw_args = Qnil; \
|
|
41
|
+
rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
|
|
42
|
+
ID kw_table[9] = { rb_intern("itype"), rb_intern("jobz"), rb_intern("range"), \
|
|
43
|
+
rb_intern("uplo"), rb_intern("vl"), rb_intern("vu"), \
|
|
44
|
+
rb_intern("il"), rb_intern("iu"), rb_intern("order") }; \
|
|
45
|
+
VALUE kw_values[9] = { Qundef, Qundef, Qundef, Qundef, Qundef, \
|
|
46
|
+
Qundef, Qundef, Qundef, Qundef }; \
|
|
47
|
+
rb_get_kwargs(kw_args, kw_table, 0, 9, kw_values); \
|
|
48
|
+
const lapack_int itype = kw_values[0] != Qundef ? get_itype(kw_values[0]) : 1; \
|
|
49
|
+
const char jobz = kw_values[1] != Qundef ? get_jobz(kw_values[1]) : 'V'; \
|
|
50
|
+
const char range = kw_values[2] != Qundef ? get_range(kw_values[2]) : 'A'; \
|
|
51
|
+
const char uplo = kw_values[3] != Qundef ? get_uplo(kw_values[3]) : 'U'; \
|
|
52
|
+
const tRtDType vl = kw_values[4] != Qundef ? NUM2DBL(kw_values[4]) : 0.0; \
|
|
53
|
+
const tRtDType vu = kw_values[5] != Qundef ? NUM2DBL(kw_values[5]) : 0.0; \
|
|
54
|
+
const lapack_int il = kw_values[6] != Qundef ? NUM2INT(kw_values[6]) : 0; \
|
|
55
|
+
const lapack_int iu = kw_values[7] != Qundef ? NUM2INT(kw_values[7]) : 0; \
|
|
56
|
+
const int matrix_layout = \
|
|
57
|
+
kw_values[8] != Qundef ? get_matrix_layout(kw_values[8]) : LAPACK_ROW_MAJOR; \
|
|
58
|
+
\
|
|
59
|
+
if (CLASS_OF(a_vnary) != tNAryClass) { \
|
|
60
|
+
a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
|
|
61
|
+
} \
|
|
62
|
+
if (!RTEST(nary_check_contiguous(a_vnary))) { \
|
|
63
|
+
a_vnary = nary_dup(a_vnary); \
|
|
64
|
+
} \
|
|
65
|
+
if (CLASS_OF(b_vnary) != tNAryClass) { \
|
|
66
|
+
b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
|
|
67
|
+
} \
|
|
68
|
+
if (!RTEST(nary_check_contiguous(b_vnary))) { \
|
|
69
|
+
b_vnary = nary_dup(b_vnary); \
|
|
70
|
+
} \
|
|
71
|
+
\
|
|
72
|
+
narray_t* a_nary = NULL; \
|
|
73
|
+
GetNArray(a_vnary, a_nary); \
|
|
74
|
+
if (NA_NDIM(a_nary) != 2) { \
|
|
75
|
+
rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
|
|
76
|
+
return Qnil; \
|
|
77
|
+
} \
|
|
78
|
+
if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
|
|
79
|
+
rb_raise(rb_eArgError, "input array a must be square"); \
|
|
80
|
+
return Qnil; \
|
|
81
|
+
} \
|
|
82
|
+
narray_t* b_nary = NULL; \
|
|
83
|
+
GetNArray(b_vnary, b_nary); \
|
|
84
|
+
if (NA_NDIM(b_nary) != 2) { \
|
|
85
|
+
rb_raise(rb_eArgError, "input array b must be 2-dimensional"); \
|
|
86
|
+
return Qnil; \
|
|
87
|
+
} \
|
|
88
|
+
if (NA_SHAPE(b_nary)[0] != NA_SHAPE(b_nary)[1]) { \
|
|
89
|
+
rb_raise(rb_eArgError, "input array b must be square"); \
|
|
90
|
+
return Qnil; \
|
|
91
|
+
} \
|
|
92
|
+
\
|
|
93
|
+
if (range == 'V' && vu <= vl) { \
|
|
94
|
+
rb_raise(rb_eArgError, "vu must be greater than vl"); \
|
|
95
|
+
return Qnil; \
|
|
96
|
+
} \
|
|
97
|
+
\
|
|
98
|
+
const size_t n = NA_SHAPE(a_nary)[1]; \
|
|
99
|
+
if (range == 'I' && (il < 1 || il > (lapack_int)n)) { \
|
|
100
|
+
rb_raise(rb_eArgError, "il must satisfy 1 <= il <= n"); \
|
|
101
|
+
return Qnil; \
|
|
102
|
+
} \
|
|
103
|
+
if (range == 'I' && (iu < 1 || iu > (lapack_int)n)) { \
|
|
104
|
+
rb_raise(rb_eArgError, "iu must satisfy 1 <= iu <= n"); \
|
|
105
|
+
return Qnil; \
|
|
106
|
+
} \
|
|
107
|
+
if (range == 'I' && iu < il) { \
|
|
108
|
+
rb_raise(rb_eArgError, "il must be less than or equal to iu"); \
|
|
109
|
+
return Qnil; \
|
|
110
|
+
} \
|
|
111
|
+
\
|
|
112
|
+
size_t m = range != 'I' ? n : (size_t)(iu - il + 1); \
|
|
113
|
+
size_t w_shape[1] = { m }; \
|
|
114
|
+
size_t z_shape[2] = { n, m }; \
|
|
115
|
+
size_t ifail_shape[1] = { n }; \
|
|
116
|
+
ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { OVERWRITE, 2 } }; \
|
|
117
|
+
ndfunc_arg_out_t aout[5] = { { numo_cInt32, 0 }, \
|
|
118
|
+
{ tRtNAryClass, 1, w_shape }, \
|
|
119
|
+
{ tNAryClass, 2, z_shape }, \
|
|
120
|
+
{ numo_cInt32, 1, ifail_shape }, \
|
|
121
|
+
{ numo_cInt32, 0 } }; \
|
|
122
|
+
ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 5, ain, aout }; \
|
|
123
|
+
struct _hegvx_option_##tRtDType opt = { \
|
|
124
|
+
matrix_layout, itype, jobz, range, uplo, vl, vu, il, iu \
|
|
125
|
+
}; \
|
|
126
|
+
VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
|
|
127
|
+
VALUE ret = rb_ary_new3( \
|
|
128
|
+
7, a_vnary, b_vnary, rb_ary_entry(res, 0), rb_ary_entry(res, 1), rb_ary_entry(res, 2), \
|
|
129
|
+
rb_ary_entry(res, 3), rb_ary_entry(res, 4) \
|
|
130
|
+
); \
|
|
131
|
+
\
|
|
132
|
+
RB_GC_GUARD(a_vnary); \
|
|
133
|
+
RB_GC_GUARD(b_vnary); \
|
|
134
|
+
return ret; \
|
|
123
135
|
}
|
|
124
136
|
|
|
125
137
|
DEF_LINALG_FUNC(lapack_complex_double, double, numo_cDComplex, numo_cDFloat, zhegvx)
|
|
@@ -5,56 +5,60 @@ struct _hetrf_option {
|
|
|
5
5
|
char uplo;
|
|
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
|
-
lapack_int* ipiv = (lapack_int*)NDL_PTR(lp, 1);
|
|
12
|
-
int* info = (int*)NDL_PTR(lp, 2);
|
|
13
|
-
struct _hetrf_option* opt = (struct _hetrf_option*)(lp->opt_ptr);
|
|
14
|
-
const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0];
|
|
15
|
-
const lapack_int lda = n;
|
|
16
|
-
const lapack_int i =
|
|
17
|
-
|
|
18
|
-
|
|
19
|
-
|
|
20
|
-
|
|
21
|
-
|
|
22
|
-
VALUE
|
|
23
|
-
|
|
24
|
-
|
|
25
|
-
|
|
26
|
-
|
|
27
|
-
|
|
28
|
-
const
|
|
29
|
-
|
|
30
|
-
|
|
31
|
-
|
|
32
|
-
|
|
33
|
-
|
|
34
|
-
|
|
35
|
-
|
|
36
|
-
|
|
37
|
-
|
|
38
|
-
|
|
39
|
-
|
|
40
|
-
|
|
41
|
-
|
|
42
|
-
|
|
43
|
-
if (
|
|
44
|
-
rb_raise(rb_eArgError, "input array a must be
|
|
45
|
-
return Qnil;
|
|
46
|
-
}
|
|
47
|
-
|
|
48
|
-
|
|
49
|
-
|
|
50
|
-
|
|
51
|
-
|
|
52
|
-
|
|
53
|
-
|
|
54
|
-
|
|
55
|
-
|
|
56
|
-
|
|
57
|
-
|
|
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
|
+
lapack_int* ipiv = (lapack_int*)NDL_PTR(lp, 1); \
|
|
12
|
+
int* info = (int*)NDL_PTR(lp, 2); \
|
|
13
|
+
struct _hetrf_option* opt = (struct _hetrf_option*)(lp->opt_ptr); \
|
|
14
|
+
const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
|
|
15
|
+
const lapack_int lda = n; \
|
|
16
|
+
const lapack_int i = \
|
|
17
|
+
LAPACKE_##fLapackFunc(opt->matrix_layout, opt->uplo, n, a, lda, ipiv); \
|
|
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_tables[2] = { rb_intern("matrix_layout"), rb_intern("uplo") }; \
|
|
26
|
+
VALUE kw_values[2] = { Qundef, Qundef }; \
|
|
27
|
+
rb_get_kwargs(kw_args, kw_tables, 0, 2, kw_values); \
|
|
28
|
+
const int matrix_layout = kw_values[0] != Qundef && kw_values[0] != Qnil \
|
|
29
|
+
? get_matrix_layout(kw_values[0]) \
|
|
30
|
+
: LAPACK_ROW_MAJOR; \
|
|
31
|
+
const char uplo = \
|
|
32
|
+
kw_values[1] != Qundef && kw_values[1] != Qnil ? get_uplo(kw_values[1]) : 'U'; \
|
|
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)[0]; \
|
|
53
|
+
size_t shape[1] = { n }; \
|
|
54
|
+
ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
|
|
55
|
+
ndfunc_arg_out_t aout[2] = { { numo_cInt32, 1, shape }, { numo_cInt32, 0 } }; \
|
|
56
|
+
ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 2, ain, aout }; \
|
|
57
|
+
struct _hetrf_option opt = { matrix_layout, uplo }; \
|
|
58
|
+
VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
|
|
59
|
+
\
|
|
60
|
+
RB_GC_GUARD(a_vnary); \
|
|
61
|
+
return res; \
|
|
58
62
|
}
|
|
59
63
|
|
|
60
64
|
DEF_LINALG_FUNC(lapack_complex_double, numo_cDComplex, zhetrf)
|
|
@@ -5,50 +5,51 @@ struct _lange_option {
|
|
|
5
5
|
char norm;
|
|
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
|
-
tDType* d = (tDType*)NDL_PTR(lp, 1);
|
|
12
|
-
struct _lange_option* opt = (struct _lange_option*)(lp->opt_ptr);
|
|
13
|
-
const lapack_int m = (lapack_int)NDL_SHAPE(lp, 0)[0];
|
|
14
|
-
const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[1];
|
|
15
|
-
const lapack_int lda = n;
|
|
16
|
-
*d = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->norm, m, n, a, lda);
|
|
17
|
-
}
|
|
18
|
-
|
|
19
|
-
static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) {
|
|
20
|
-
VALUE a_vnary = Qnil;
|
|
21
|
-
VALUE kw_args = Qnil;
|
|
22
|
-
rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args);
|
|
23
|
-
ID kw_table[2] = { rb_intern("order"), rb_intern("norm") };
|
|
24
|
-
VALUE kw_values[2] = { Qundef, Qundef };
|
|
25
|
-
rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values);
|
|
26
|
-
const int matrix_layout =
|
|
27
|
-
|
|
28
|
-
|
|
29
|
-
|
|
30
|
-
|
|
31
|
-
|
|
32
|
-
|
|
33
|
-
|
|
34
|
-
|
|
35
|
-
|
|
36
|
-
|
|
37
|
-
|
|
38
|
-
|
|
39
|
-
|
|
40
|
-
|
|
41
|
-
|
|
42
|
-
|
|
43
|
-
|
|
44
|
-
|
|
45
|
-
|
|
46
|
-
|
|
47
|
-
|
|
48
|
-
|
|
49
|
-
|
|
50
|
-
|
|
51
|
-
|
|
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
|
+
tDType* d = (tDType*)NDL_PTR(lp, 1); \
|
|
12
|
+
struct _lange_option* opt = (struct _lange_option*)(lp->opt_ptr); \
|
|
13
|
+
const lapack_int m = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
|
|
14
|
+
const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[1]; \
|
|
15
|
+
const lapack_int lda = n; \
|
|
16
|
+
*d = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->norm, m, n, a, lda); \
|
|
17
|
+
} \
|
|
18
|
+
\
|
|
19
|
+
static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
|
|
20
|
+
VALUE a_vnary = Qnil; \
|
|
21
|
+
VALUE kw_args = Qnil; \
|
|
22
|
+
rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
|
|
23
|
+
ID kw_table[2] = { rb_intern("order"), rb_intern("norm") }; \
|
|
24
|
+
VALUE kw_values[2] = { Qundef, Qundef }; \
|
|
25
|
+
rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
|
|
26
|
+
const int matrix_layout = \
|
|
27
|
+
kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
|
|
28
|
+
const char norm = kw_values[1] != Qundef ? NUM2CHR(kw_values[1]) : 'F'; \
|
|
29
|
+
\
|
|
30
|
+
if (CLASS_OF(a_vnary) != tNAryClass) { \
|
|
31
|
+
a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
|
|
32
|
+
} \
|
|
33
|
+
if (!RTEST(nary_check_contiguous(a_vnary))) { \
|
|
34
|
+
a_vnary = nary_dup(a_vnary); \
|
|
35
|
+
} \
|
|
36
|
+
\
|
|
37
|
+
narray_t* a_nary = NULL; \
|
|
38
|
+
GetNArray(a_vnary, a_nary); \
|
|
39
|
+
if (NA_NDIM(a_nary) != 2) { \
|
|
40
|
+
rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
|
|
41
|
+
return Qnil; \
|
|
42
|
+
} \
|
|
43
|
+
\
|
|
44
|
+
ndfunc_arg_in_t ain[1] = { { tNAryClass, 2 } }; \
|
|
45
|
+
size_t shape_out[1] = { 1 }; \
|
|
46
|
+
ndfunc_arg_out_t aout[1] = { { tNAryClass, 0, shape_out } }; \
|
|
47
|
+
ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
|
|
48
|
+
struct _lange_option opt = { matrix_layout, norm }; \
|
|
49
|
+
VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
|
|
50
|
+
\
|
|
51
|
+
RB_GC_GUARD(a_vnary); \
|
|
52
|
+
return ret; \
|
|
52
53
|
}
|
|
53
54
|
|
|
54
55
|
DEF_LINALG_FUNC(double, numo_cDFloat, dlange)
|