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
@@ -7,81 +7,85 @@ struct _trtrs_option {
7
7
  char diag;
8
8
  };
9
9
 
10
- #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
11
- static void _iter_##fLapackFunc(na_loop_t* const lp) { \
12
- tDType* a = (tDType*)NDL_PTR(lp, 0); \
13
- tDType* b = (tDType*)NDL_PTR(lp, 1); \
14
- int* info = (int*)NDL_PTR(lp, 2); \
15
- struct _trtrs_option* opt = (struct _trtrs_option*)(lp->opt_ptr); \
16
- const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
17
- const lapack_int nrhs = lp->args[1].ndim == 1 ? 1 : (lapack_int)NDL_SHAPE(lp, 1)[1]; \
18
- const lapack_int lda = n; \
19
- const lapack_int ldb = nrhs; \
20
- const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->uplo, opt->trans, opt->diag, n, nrhs, a, lda, 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 b_vnary = Qnil; \
27
- VALUE kw_args = Qnil; \
28
- rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
29
- ID kw_table[4] = { rb_intern("order"), rb_intern("uplo"), rb_intern("trans"), rb_intern("diag") }; \
30
- VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef }; \
31
- rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values); \
32
- const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
33
- const char uplo = kw_values[1] != Qundef ? get_uplo(kw_values[1]) : 'U'; \
34
- const char trans = kw_values[2] != Qundef ? NUM2CHR(kw_values[2]) : 'N'; \
35
- const char diag = kw_values[3] != Qundef ? NUM2CHR(kw_values[3]) : '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(b_vnary) != tNAryClass) { \
44
- b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
45
- } \
46
- if (!RTEST(nary_check_contiguous(b_vnary))) { \
47
- b_vnary = nary_dup(b_vnary); \
48
- } \
49
- \
50
- narray_t* a_nary = NULL; \
51
- GetNArray(a_vnary, a_nary); \
52
- if (NA_NDIM(a_nary) != 2) { \
53
- rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
54
- return Qnil; \
55
- } \
56
- if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
57
- rb_raise(rb_eArgError, "input array a must be square"); \
58
- return Qnil; \
59
- } \
60
- \
61
- narray_t* b_nary = NULL; \
62
- GetNArray(b_vnary, b_nary); \
63
- const int b_n_dims = NA_NDIM(b_nary); \
64
- if (b_n_dims != 1 && b_n_dims != 2) { \
65
- rb_raise(rb_eArgError, "input array b must be 1- or 2-dimensional"); \
66
- return Qnil; \
67
- } \
68
- \
69
- lapack_int n = (lapack_int)NA_SHAPE(a_nary)[0]; \
70
- lapack_int nb = (lapack_int)NA_SHAPE(b_nary)[0]; \
71
- if (n != nb) { \
72
- rb_raise(nary_eShapeError, "shape1[0](=%d) != shape2[0](=%d)", n, nb); \
73
- } \
74
- \
75
- ndfunc_arg_in_t ain[2] = { { tNAryClass, 2 }, { OVERWRITE, b_n_dims } }; \
76
- ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
77
- ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 1, ain, aout }; \
78
- struct _trtrs_option opt = { matrix_layout, uplo, trans, diag }; \
79
- VALUE info = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
80
- VALUE ret = rb_ary_new3(2, b_vnary, info); \
81
- \
82
- RB_GC_GUARD(a_vnary); \
83
- RB_GC_GUARD(b_vnary); \
84
- return ret; \
10
+ #define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc) \
11
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
12
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
13
+ tDType* b = (tDType*)NDL_PTR(lp, 1); \
14
+ int* info = (int*)NDL_PTR(lp, 2); \
15
+ struct _trtrs_option* opt = (struct _trtrs_option*)(lp->opt_ptr); \
16
+ const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
17
+ const lapack_int nrhs = lp->args[1].ndim == 1 ? 1 : (lapack_int)NDL_SHAPE(lp, 1)[1]; \
18
+ const lapack_int lda = n; \
19
+ const lapack_int ldb = nrhs; \
20
+ const lapack_int i = LAPACKE_##fLapackFunc( \
21
+ opt->matrix_layout, opt->uplo, opt->trans, opt->diag, n, nrhs, a, lda, b, ldb \
22
+ ); \
23
+ *info = (int)i; \
24
+ } \
25
+ \
26
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
27
+ VALUE a_vnary = Qnil; \
28
+ VALUE b_vnary = Qnil; \
29
+ VALUE kw_args = Qnil; \
30
+ rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
31
+ ID kw_table[4] = { rb_intern("order"), rb_intern("uplo"), rb_intern("trans"), \
32
+ rb_intern("diag") }; \
33
+ VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef }; \
34
+ rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values); \
35
+ const int matrix_layout = \
36
+ kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
37
+ const char uplo = kw_values[1] != Qundef ? get_uplo(kw_values[1]) : 'U'; \
38
+ const char trans = kw_values[2] != Qundef ? NUM2CHR(kw_values[2]) : 'N'; \
39
+ const char diag = kw_values[3] != Qundef ? NUM2CHR(kw_values[3]) : 'N'; \
40
+ \
41
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
42
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
43
+ } \
44
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
45
+ a_vnary = nary_dup(a_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
+ if (NA_NDIM(a_nary) != 2) { \
57
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
58
+ return Qnil; \
59
+ } \
60
+ if (NA_SHAPE(a_nary)[0] != NA_SHAPE(a_nary)[1]) { \
61
+ rb_raise(rb_eArgError, "input array a must be square"); \
62
+ return Qnil; \
63
+ } \
64
+ \
65
+ narray_t* b_nary = NULL; \
66
+ GetNArray(b_vnary, b_nary); \
67
+ const int b_n_dims = NA_NDIM(b_nary); \
68
+ if (b_n_dims != 1 && b_n_dims != 2) { \
69
+ rb_raise(rb_eArgError, "input array b must be 1- or 2-dimensional"); \
70
+ return Qnil; \
71
+ } \
72
+ \
73
+ lapack_int n = (lapack_int)NA_SHAPE(a_nary)[0]; \
74
+ lapack_int nb = (lapack_int)NA_SHAPE(b_nary)[0]; \
75
+ if (n != nb) { \
76
+ rb_raise(nary_eShapeError, "shape1[0](=%d) != shape2[0](=%d)", n, nb); \
77
+ } \
78
+ \
79
+ ndfunc_arg_in_t ain[2] = { { tNAryClass, 2 }, { OVERWRITE, b_n_dims } }; \
80
+ ndfunc_arg_out_t aout[1] = { { numo_cInt32, 0 } }; \
81
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 1, ain, aout }; \
82
+ struct _trtrs_option opt = { matrix_layout, uplo, trans, diag }; \
83
+ VALUE info = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
84
+ VALUE ret = rb_ary_new3(2, b_vnary, info); \
85
+ \
86
+ RB_GC_GUARD(a_vnary); \
87
+ RB_GC_GUARD(b_vnary); \
88
+ return ret; \
85
89
  }
86
90
 
87
91
  DEF_LINALG_FUNC(double, numo_cDFloat, dtrtrs)
@@ -4,68 +4,69 @@ struct _ungqr_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 _ungqr_option* opt = (struct _ungqr_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 _ungqr_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 _ungqr_option* opt = (struct _ungqr_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 _ungqr_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(lapack_complex_double, numo_cDComplex, zungqr)
@@ -0,0 +1,78 @@
1
+ #include "ungrq.h"
2
+
3
+ struct _ungrq_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 _ungrq_option* opt = (struct _ungrq_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 _ungrq_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(lapack_complex_double, numo_cDComplex, zungrq)
71
+ DEF_LINALG_FUNC(lapack_complex_float, numo_cSComplex, cungrq)
72
+
73
+ #undef DEF_LINALG_FUNC
74
+
75
+ void define_linalg_lapack_ungrq(VALUE mLapack) {
76
+ rb_define_module_function(mLapack, "zungrq", RUBY_METHOD_FUNC(_linalg_lapack_zungrq), -1);
77
+ rb_define_module_function(mLapack, "cungrq", RUBY_METHOD_FUNC(_linalg_lapack_cungrq), -1);
78
+ }
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_UNGRQ_H
2
+ #define NUMO_LINALG_ALT_LAPACK_UNGRQ_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_ungrq(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_UNGRQ_H */
@@ -42,9 +42,11 @@ char blas_char(VALUE nary_arr) {
42
42
  if (RB_TYPE_P(arg, T_ARRAY)) {
43
43
  arg = rb_funcall(numo_cNArray, rb_intern("asarray"), 1, arg);
44
44
  }
45
- if (CLASS_OF(arg) == numo_cBit || CLASS_OF(arg) == numo_cInt64 || CLASS_OF(arg) == numo_cInt32 ||
46
- CLASS_OF(arg) == numo_cInt16 || CLASS_OF(arg) == numo_cInt8 || CLASS_OF(arg) == numo_cUInt64 ||
47
- CLASS_OF(arg) == numo_cUInt32 || CLASS_OF(arg) == numo_cUInt16 || CLASS_OF(arg) == numo_cUInt8) {
45
+ if (CLASS_OF(arg) == numo_cBit || CLASS_OF(arg) == numo_cInt64 ||
46
+ CLASS_OF(arg) == numo_cInt32 || CLASS_OF(arg) == numo_cInt16 ||
47
+ CLASS_OF(arg) == numo_cInt8 || CLASS_OF(arg) == numo_cUInt64 ||
48
+ CLASS_OF(arg) == numo_cUInt32 || CLASS_OF(arg) == numo_cUInt16 ||
49
+ CLASS_OF(arg) == numo_cUInt8) {
48
50
  if (type == 'n') {
49
51
  type = 'd';
50
52
  }
@@ -97,8 +99,7 @@ static VALUE linalg_blas_call(int argc, VALUE* argv, VALUE self) {
97
99
  }
98
100
 
99
101
  char fn_str[256];
100
- snprintf(fn_str, sizeof(fn_str), "%c%s",
101
- type, rb_id2name(rb_to_id(rb_to_symbol(fn_name))));
102
+ snprintf(fn_str, sizeof(fn_str), "%c%s", type, rb_id2name(rb_to_id(rb_to_symbol(fn_name))));
102
103
  ID fn_id = rb_intern(fn_str);
103
104
  size_t n = RARRAY_LEN(nary_arr);
104
105
  VALUE ret = Qnil;
@@ -146,7 +147,8 @@ static VALUE linalg_dot(VALUE self, VALUE a_, VALUE b_) {
146
147
  ret = rb_funcall(rb_mLinalgBlas, rb_intern("call"), 3, ID2SYM(fn_id), a, b);
147
148
  } else {
148
149
  VALUE kw_args = rb_hash_new();
149
- if (!RTEST(nary_check_contiguous(b)) && RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
150
+ if (!RTEST(nary_check_contiguous(b)) &&
151
+ RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
150
152
  b = rb_funcall(b, rb_intern("transpose"), 0);
151
153
  rb_hash_aset(kw_args, ID2SYM(rb_intern("trans")), rb_str_new_cstr("N"));
152
154
  } else {
@@ -160,7 +162,8 @@ static VALUE linalg_dot(VALUE self, VALUE a_, VALUE b_) {
160
162
  } else {
161
163
  if (b_ndim == 1) {
162
164
  VALUE kw_args = rb_hash_new();
163
- if (!RTEST(nary_check_contiguous(a)) && RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
165
+ if (!RTEST(nary_check_contiguous(a)) &&
166
+ RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
164
167
  a = rb_funcall(a, rb_intern("transpose"), 0);
165
168
  rb_hash_aset(kw_args, ID2SYM(rb_intern("trans")), rb_str_new_cstr("T"));
166
169
  } else {
@@ -172,13 +175,15 @@ static VALUE linalg_dot(VALUE self, VALUE a_, VALUE b_) {
172
175
  ret = rb_funcallv_kw(rb_mLinalgBlas, rb_intern(fn_name), 3, argv, RB_PASS_KEYWORDS);
173
176
  } else {
174
177
  VALUE kw_args = rb_hash_new();
175
- if (!RTEST(nary_check_contiguous(a)) && RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
178
+ if (!RTEST(nary_check_contiguous(a)) &&
179
+ RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
176
180
  a = rb_funcall(a, rb_intern("transpose"), 0);
177
181
  rb_hash_aset(kw_args, ID2SYM(rb_intern("transa")), rb_str_new_cstr("T"));
178
182
  } else {
179
183
  rb_hash_aset(kw_args, ID2SYM(rb_intern("transa")), rb_str_new_cstr("N"));
180
184
  }
181
- if (!RTEST(nary_check_contiguous(b)) && RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
185
+ if (!RTEST(nary_check_contiguous(b)) &&
186
+ RTEST(rb_funcall(b, rb_intern("fortran_contiguous?"), 0))) {
182
187
  b = rb_funcall(b, rb_intern("transpose"), 0);
183
188
  rb_hash_aset(kw_args, ID2SYM(rb_intern("transb")), rb_str_new_cstr("T"));
184
189
  } else {
@@ -202,7 +207,8 @@ void Init_linalg(void) {
202
207
 
203
208
  /**
204
209
  * Document-module: Numo::Linalg
205
- * Numo::Linalg is a subset library from Numo::Linalg consisting only of methods used in Machine Learning algorithms.
210
+ * Numo::Linalg is a subset library from Numo::Linalg consisting only of methods used
211
+ * in Machine Learning algorithms.
206
212
  */
207
213
  rb_mLinalg = rb_define_module_under(rb_mNumo, "Linalg");
208
214
  /**
@@ -255,9 +261,13 @@ void Init_linalg(void) {
255
261
  define_linalg_blas_gemv(rb_mLinalgBlas);
256
262
  define_linalg_blas_nrm2(rb_mLinalgBlas);
257
263
  define_linalg_lapack_geqrf(rb_mLinalgLapack);
264
+ define_linalg_lapack_gerqf(rb_mLinalgLapack);
258
265
  define_linalg_lapack_orgqr(rb_mLinalgLapack);
266
+ define_linalg_lapack_orgrq(rb_mLinalgLapack);
259
267
  define_linalg_lapack_ungqr(rb_mLinalgLapack);
268
+ define_linalg_lapack_ungrq(rb_mLinalgLapack);
260
269
  define_linalg_lapack_gees(rb_mLinalgLapack);
270
+ define_linalg_lapack_gges(rb_mLinalgLapack);
261
271
  define_linalg_lapack_geev(rb_mLinalgLapack);
262
272
  define_linalg_lapack_gesv(rb_mLinalgLapack);
263
273
  define_linalg_lapack_gesvd(rb_mLinalgLapack);
@@ -55,12 +55,14 @@
55
55
  #include "lapack/geev.h"
56
56
  #include "lapack/gelsd.h"
57
57
  #include "lapack/geqrf.h"
58
+ #include "lapack/gerqf.h"
58
59
  #include "lapack/gesdd.h"
59
60
  #include "lapack/gesv.h"
60
61
  #include "lapack/gesvd.h"
61
62
  #include "lapack/getrf.h"
62
63
  #include "lapack/getri.h"
63
64
  #include "lapack/getrs.h"
65
+ #include "lapack/gges.h"
64
66
  #include "lapack/heev.h"
65
67
  #include "lapack/heevd.h"
66
68
  #include "lapack/heevr.h"
@@ -70,6 +72,7 @@
70
72
  #include "lapack/hetrf.h"
71
73
  #include "lapack/lange.h"
72
74
  #include "lapack/orgqr.h"
75
+ #include "lapack/orgrq.h"
73
76
  #include "lapack/potrf.h"
74
77
  #include "lapack/potri.h"
75
78
  #include "lapack/potrs.h"
@@ -82,5 +85,6 @@
82
85
  #include "lapack/sytrf.h"
83
86
  #include "lapack/trtrs.h"
84
87
  #include "lapack/ungqr.h"
88
+ #include "lapack/ungrq.h"
85
89
 
86
90
  #endif /* NUMO_LINALG_ALT_LINALG_H */
@@ -20,6 +20,14 @@ char get_jobz(VALUE val) {
20
20
  return jobz;
21
21
  }
22
22
 
23
+ char get_jobvs(VALUE val) {
24
+ const char jobvs = NUM2CHR(val);
25
+ if (jobvs != 'N' && jobvs != 'V') {
26
+ rb_raise(rb_eArgError, "jobvs must be 'N' or 'V'");
27
+ }
28
+ return jobvs;
29
+ }
30
+
23
31
  char get_range(VALUE val) {
24
32
  const char range = NUM2CHR(val);
25
33
 
@@ -8,6 +8,7 @@
8
8
 
9
9
  lapack_int get_itype(VALUE val);
10
10
  char get_jobz(VALUE val);
11
+ char get_jobvs(VALUE val);
11
12
  char get_range(VALUE val);
12
13
  char get_uplo(VALUE val);
13
14
  int get_matrix_layout(VALUE val);
@@ -5,6 +5,6 @@ module Numo
5
5
  # Numo::Linalg Alternative (numo-linalg-alt) is an alternative to Numo::Linalg.
6
6
  module Linalg
7
7
  # The version of numo-linalg-alt you install.
8
- VERSION = '0.3.0'
8
+ VERSION = '0.4.0'
9
9
  end
10
10
  end