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/hetrf.c CHANGED
@@ -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 = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->uplo, n, a, lda, ipiv); \
17
- *info = (int)i; \
18
- } \
19
- \
20
- static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
21
- VALUE a_vnary = Qnil; \
22
- VALUE kw_args = Qnil; \
23
- rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
24
- ID kw_tables[2] = { rb_intern("matrix_layout"), rb_intern("uplo") }; \
25
- VALUE kw_values[2] = { Qundef, Qundef }; \
26
- rb_get_kwargs(kw_args, kw_tables, 0, 2, kw_values); \
27
- const int matrix_layout = kw_values[0] != Qundef && kw_values[0] != Qnil ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
28
- const char uplo = kw_values[1] != Qundef && kw_values[1] != Qnil ? get_uplo(kw_values[1]) : 'U'; \
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
- if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
44
- rb_raise(rb_eArgError, "input array a must be square"); \
45
- return Qnil; \
46
- } \
47
- \
48
- const size_t n = NA_SHAPE(a_nary)[0]; \
49
- size_t shape[1] = { n }; \
50
- ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
51
- ndfunc_arg_out_t aout[2] = { { numo_cInt32, 1, shape }, { numo_cInt32, 0 } }; \
52
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 2, ain, aout }; \
53
- struct _hetrf_option opt = { matrix_layout, uplo }; \
54
- VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
55
- \
56
- RB_GC_GUARD(a_vnary); \
57
- return res; \
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)
data/ext/numo/linalg/lapack/lange.c CHANGED
@@ -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 = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
27
- const char norm = kw_values[1] != Qundef ? NUM2CHR(kw_values[1]) : 'F'; \
28
- \
29
- if (CLASS_OF(a_vnary) != tNAryClass) { \
30
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
31
- } \
32
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
33
- a_vnary = nary_dup(a_vnary); \
34
- } \
35
- \
36
- narray_t* a_nary = NULL; \
37
- GetNArray(a_vnary, a_nary); \
38
- if (NA_NDIM(a_nary) != 2) { \
39
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
40
- return Qnil; \
41
- } \
42
- \
43
- ndfunc_arg_in_t ain[1] = { { tNAryClass, 2 } }; \
44
- size_t shape_out[1] = { 1 }; \
45
- ndfunc_arg_out_t aout[1] = { { tNAryClass, 0, shape_out } }; \
46
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
47
- struct _lange_option opt = { matrix_layout, norm }; \
48
- VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
49
- \
50
- RB_GC_GUARD(a_vnary); \
51
- 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
+ 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)
data/ext/numo/linalg/lapack/orgqr.c CHANGED
@@ -4,68 +4,69 @@ struct _orgqr_option {
4
4
  int matrix_layout;
5
5
  };
6
6
 
7
- #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
8
- static void _iter_##fLapackFunc(na_loop_t* const lp) { \
9
- tDType* a = (tDType*)NDL_PTR(lp, 0); \
10
- tDType* tau = (tDType*)NDL_PTR(lp, 1); \
11
- int* info = (int*)NDL_PTR(lp, 2); \
12
- struct _orgqr_option* opt = (struct _orgqr_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 k = (lapack_int)NDL_SHAPE(lp, 1)[0]; \
16
- const lapack_int lda = n; \
17
- const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, m, n, k, a, lda, tau); \
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 tau_vnary = Qnil; \
24
- VALUE kw_args = Qnil; \
25
- rb_scan_args(argc, argv, "2:", &a_vnary, &tau_vnary, &kw_args); \
26
- ID kw_table[1] = { rb_intern("order") }; \
27
- VALUE kw_values[1] = { Qundef }; \
28
- rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
29
- const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
30
- \
31
- if (CLASS_OF(a_vnary) != tNAryClass) { \
32
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
33
- } \
34
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
35
- a_vnary = nary_dup(a_vnary); \
36
- } \
37
- if (CLASS_OF(tau_vnary) != tNAryClass) { \
38
- tau_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, tau_vnary); \
39
- } \
40
- if (!RTEST(nary_check_contiguous(tau_vnary))) { \
41
- tau_vnary = nary_dup(tau_vnary); \
42
- } \
43
- \
44
- narray_t* a_nary = NULL; \
45
- GetNArray(a_vnary, a_nary); \
46
- if (NA_NDIM(a_nary) != 2) { \
47
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
48
- return Qnil; \
49
- } \
50
- narray_t* tau_nary = NULL; \
51
- GetNArray(tau_vnary, tau_nary); \
52
- if (NA_NDIM(tau_nary) != 1) { \
53
- rb_raise(rb_eArgError, "input array tau must be 1-dimensional"); \
54
- return Qnil; \
55
- } \
56
- \
57
- ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { tNAryClass, 1 } }; \
58
- ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
59
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 1, ain, aout }; \
60
- struct _orgqr_option opt = { matrix_layout }; \
61
- VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, tau_vnary); \
62
- \
63
- VALUE ret = rb_ary_new3(2, a_vnary, res); \
64
- \
65
- RB_GC_GUARD(a_vnary); \
66
- RB_GC_GUARD(tau_vnary); \
67
- \
68
- return ret; \
7
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
8
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
9
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
10
+ tDType* tau = (tDType*)NDL_PTR(lp, 1); \
11
+ int* info = (int*)NDL_PTR(lp, 2); \
12
+ struct _orgqr_option* opt = (struct _orgqr_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 k = (lapack_int)NDL_SHAPE(lp, 1)[0]; \
16
+ const lapack_int lda = n; \
17
+ const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, m, n, k, a, lda, tau); \
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 tau_vnary = Qnil; \
24
+ VALUE kw_args = Qnil; \
25
+ rb_scan_args(argc, argv, "2:", &a_vnary, &tau_vnary, &kw_args); \
26
+ ID kw_table[1] = { rb_intern("order") }; \
27
+ VALUE kw_values[1] = { Qundef }; \
28
+ rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
29
+ const int matrix_layout = \
30
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : 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
+ if (CLASS_OF(tau_vnary) != tNAryClass) { \
39
+ tau_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, tau_vnary); \
40
+ } \
41
+ if (!RTEST(nary_check_contiguous(tau_vnary))) { \
42
+ tau_vnary = nary_dup(tau_vnary); \
43
+ } \
44
+ \
45
+ narray_t* a_nary = NULL; \
46
+ GetNArray(a_vnary, a_nary); \
47
+ if (NA_NDIM(a_nary) != 2) { \
48
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
49
+ return Qnil; \
50
+ } \
51
+ narray_t* tau_nary = NULL; \
52
+ GetNArray(tau_vnary, tau_nary); \
53
+ if (NA_NDIM(tau_nary) != 1) { \
54
+ rb_raise(rb_eArgError, "input array tau must be 1-dimensional"); \
55
+ return Qnil; \
56
+ } \
57
+ \
58
+ ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { tNAryClass, 1 } }; \
59
+ ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
60
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 1, ain, aout }; \
61
+ struct _orgqr_option opt = { matrix_layout }; \
62
+ VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, tau_vnary); \
63
+ \
64
+ VALUE ret = rb_ary_new3(2, a_vnary, res); \
65
+ \
66
+ RB_GC_GUARD(a_vnary); \
67
+ RB_GC_GUARD(tau_vnary); \
68
+ \
69
+ return ret; \
69
70
  }
70
71
 
71
72
  DEF_LINALG_FUNC(double, numo_cDFloat, dorgqr)
data/ext/numo/linalg/lapack/orgrq.c ADDED
@@ -0,0 +1,78 @@
1
+ #include "orgrq.h"
2
+
3
+ struct _orgrq_option {
4
+ int matrix_layout;
5
+ };
6
+
7
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
8
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
9
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
10
+ tDType* tau = (tDType*)NDL_PTR(lp, 1); \
11
+ int* info = (int*)NDL_PTR(lp, 2); \
12
+ struct _orgrq_option* opt = (struct _orgrq_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 k = (lapack_int)NDL_SHAPE(lp, 1)[0]; \
16
+ const lapack_int lda = n; \
17
+ const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, m, n, k, a, lda, tau); \
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 tau_vnary = Qnil; \
24
+ VALUE kw_args = Qnil; \
25
+ rb_scan_args(argc, argv, "2:", &a_vnary, &tau_vnary, &kw_args); \
26
+ ID kw_table[1] = { rb_intern("order") }; \
27
+ VALUE kw_values[1] = { Qundef }; \
28
+ rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
29
+ const int matrix_layout = \
30
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : 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
+ if (CLASS_OF(tau_vnary) != tNAryClass) { \
39
+ tau_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, tau_vnary); \
40
+ } \
41
+ if (!RTEST(nary_check_contiguous(tau_vnary))) { \
42
+ tau_vnary = nary_dup(tau_vnary); \
43
+ } \
44
+ \
45
+ narray_t* a_nary = NULL; \
46
+ GetNArray(a_vnary, a_nary); \
47
+ if (NA_NDIM(a_nary) != 2) { \
48
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
49
+ return Qnil; \
50
+ } \
51
+ narray_t* tau_nary = NULL; \
52
+ GetNArray(tau_vnary, tau_nary); \
53
+ if (NA_NDIM(tau_nary) != 1) { \
54
+ rb_raise(rb_eArgError, "input array tau must be 1-dimensional"); \
55
+ return Qnil; \
56
+ } \
57
+ \
58
+ ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { tNAryClass, 1 } }; \
59
+ ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
60
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 1, ain, aout }; \
61
+ struct _orgrq_option opt = { matrix_layout }; \
62
+ VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, tau_vnary); \
63
+ VALUE ret = rb_ary_new3(2, a_vnary, res); \
64
+ \
65
+ RB_GC_GUARD(a_vnary); \
66
+ RB_GC_GUARD(tau_vnary); \
67
+ return ret; \
68
+ }
69
+
70
+ DEF_LINALG_FUNC(double, numo_cDFloat, dorgrq)
71
+ DEF_LINALG_FUNC(float, numo_cSFloat, sorgrq)
72
+
73
+ #undef DEF_LINALG_FUNC
74
+
75
+ void define_linalg_lapack_orgrq(VALUE mLapack) {
76
+ rb_define_module_function(mLapack, "dorgrq", RUBY_METHOD_FUNC(_linalg_lapack_dorgrq), -1);
77
+ rb_define_module_function(mLapack, "sorgrq", RUBY_METHOD_FUNC(_linalg_lapack_sorgrq), -1);
78
+ }
data/ext/numo/linalg/lapack/orgrq.h ADDED
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_ORGRQ_H
2
+ #define NUMO_LINALG_ALT_LAPACK_ORGRQ_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_orgrq(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_ORGRQ_H */
data/ext/numo/linalg/lapack/potrf.c CHANGED
@@ -5,54 +5,55 @@ struct _potrf_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
- int* info = (int*)NDL_PTR(lp, 1); \
12
- struct _potrf_option* opt = (struct _potrf_option*)(lp->opt_ptr); \
13
- const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
14
- const lapack_int lda = (lapack_int)NDL_SHAPE(lp, 0)[1]; \
15
- const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->uplo, n, a, lda); \
16
- *info = (int)i; \
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("uplo") }; \
24
- VALUE kw_values[2] = { Qundef, Qundef }; \
25
- rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
26
- const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
27
- const char uplo = kw_values[1] != Qundef ? get_uplo(kw_values[1]) : 'U'; \
28
- \
29
- if (CLASS_OF(a_vnary) != tNAryClass) { \
30
- a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
31
- } \
32
- if (!RTEST(nary_check_contiguous(a_vnary))) { \
33
- a_vnary = nary_dup(a_vnary); \
34
- } \
35
- \
36
- narray_t* a_nary = NULL; \
37
- GetNArray(a_vnary, a_nary); \
38
- if (NA_NDIM(a_nary) != 2) { \
39
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
40
- return Qnil; \
41
- } \
42
- if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
43
- rb_raise(rb_eArgError, "input array a must be square"); \
44
- return Qnil; \
45
- } \
46
- \
47
- ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
48
- ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
49
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
50
- struct _potrf_option opt = { matrix_layout, uplo }; \
51
- VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
52
- VALUE ret = rb_ary_new3(2, a_vnary, res); \
53
- \
54
- RB_GC_GUARD(a_vnary); \
55
- 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* info = (int*)NDL_PTR(lp, 1); \
12
+ struct _potrf_option* opt = (struct _potrf_option*)(lp->opt_ptr); \
13
+ const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
14
+ const lapack_int lda = (lapack_int)NDL_SHAPE(lp, 0)[1]; \
15
+ const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->uplo, n, a, lda); \
16
+ *info = (int)i; \
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("uplo") }; \
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 uplo = kw_values[1] != Qundef ? get_uplo(kw_values[1]) : 'U'; \
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
+ if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
44
+ rb_raise(rb_eArgError, "input array a must be square"); \
45
+ return Qnil; \
46
+ } \
47
+ \
48
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
49
+ ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
50
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
51
+ struct _potrf_option opt = { matrix_layout, uplo }; \
52
+ VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
53
+ VALUE ret = rb_ary_new3(2, a_vnary, res); \
54
+ \
55
+ RB_GC_GUARD(a_vnary); \
56
+ return ret; \
56
57
  }
57
58
 
58
59
  DEF_LINALG_FUNC(double, numo_cDFloat, dpotrf)