numo-linalg-alt 0.2.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 (86) hide show
  1. checksums.yaml +7 -0
  2. data/CHANGELOG.md +5 -0
  3. data/CODE_OF_CONDUCT.md +84 -0
  4. data/LICENSE.txt +27 -0
  5. data/README.md +106 -0
  6. data/ext/numo/linalg/blas/dot.c +72 -0
  7. data/ext/numo/linalg/blas/dot.h +13 -0
  8. data/ext/numo/linalg/blas/dot_sub.c +71 -0
  9. data/ext/numo/linalg/blas/dot_sub.h +13 -0
  10. data/ext/numo/linalg/blas/gemm.c +184 -0
  11. data/ext/numo/linalg/blas/gemm.h +16 -0
  12. data/ext/numo/linalg/blas/gemv.c +161 -0
  13. data/ext/numo/linalg/blas/gemv.h +16 -0
  14. data/ext/numo/linalg/blas/nrm2.c +67 -0
  15. data/ext/numo/linalg/blas/nrm2.h +13 -0
  16. data/ext/numo/linalg/converter.c +67 -0
  17. data/ext/numo/linalg/converter.h +23 -0
  18. data/ext/numo/linalg/extconf.rb +99 -0
  19. data/ext/numo/linalg/lapack/geev.c +152 -0
  20. data/ext/numo/linalg/lapack/geev.h +15 -0
  21. data/ext/numo/linalg/lapack/gelsd.c +92 -0
  22. data/ext/numo/linalg/lapack/gelsd.h +15 -0
  23. data/ext/numo/linalg/lapack/geqrf.c +72 -0
  24. data/ext/numo/linalg/lapack/geqrf.h +15 -0
  25. data/ext/numo/linalg/lapack/gesdd.c +108 -0
  26. data/ext/numo/linalg/lapack/gesdd.h +15 -0
  27. data/ext/numo/linalg/lapack/gesv.c +99 -0
  28. data/ext/numo/linalg/lapack/gesv.h +15 -0
  29. data/ext/numo/linalg/lapack/gesvd.c +152 -0
  30. data/ext/numo/linalg/lapack/gesvd.h +15 -0
  31. data/ext/numo/linalg/lapack/getrf.c +71 -0
  32. data/ext/numo/linalg/lapack/getrf.h +15 -0
  33. data/ext/numo/linalg/lapack/getri.c +82 -0
  34. data/ext/numo/linalg/lapack/getri.h +15 -0
  35. data/ext/numo/linalg/lapack/getrs.c +110 -0
  36. data/ext/numo/linalg/lapack/getrs.h +15 -0
  37. data/ext/numo/linalg/lapack/heev.c +71 -0
  38. data/ext/numo/linalg/lapack/heev.h +15 -0
  39. data/ext/numo/linalg/lapack/heevd.c +71 -0
  40. data/ext/numo/linalg/lapack/heevd.h +15 -0
  41. data/ext/numo/linalg/lapack/heevr.c +111 -0
  42. data/ext/numo/linalg/lapack/heevr.h +15 -0
  43. data/ext/numo/linalg/lapack/hegv.c +94 -0
  44. data/ext/numo/linalg/lapack/hegv.h +15 -0
  45. data/ext/numo/linalg/lapack/hegvd.c +94 -0
  46. data/ext/numo/linalg/lapack/hegvd.h +15 -0
  47. data/ext/numo/linalg/lapack/hegvx.c +133 -0
  48. data/ext/numo/linalg/lapack/hegvx.h +15 -0
  49. data/ext/numo/linalg/lapack/hetrf.c +68 -0
  50. data/ext/numo/linalg/lapack/hetrf.h +15 -0
  51. data/ext/numo/linalg/lapack/lange.c +66 -0
  52. data/ext/numo/linalg/lapack/lange.h +15 -0
  53. data/ext/numo/linalg/lapack/orgqr.c +79 -0
  54. data/ext/numo/linalg/lapack/orgqr.h +15 -0
  55. data/ext/numo/linalg/lapack/potrf.c +70 -0
  56. data/ext/numo/linalg/lapack/potrf.h +15 -0
  57. data/ext/numo/linalg/lapack/potri.c +70 -0
  58. data/ext/numo/linalg/lapack/potri.h +15 -0
  59. data/ext/numo/linalg/lapack/potrs.c +94 -0
  60. data/ext/numo/linalg/lapack/potrs.h +15 -0
  61. data/ext/numo/linalg/lapack/syev.c +71 -0
  62. data/ext/numo/linalg/lapack/syev.h +15 -0
  63. data/ext/numo/linalg/lapack/syevd.c +71 -0
  64. data/ext/numo/linalg/lapack/syevd.h +15 -0
  65. data/ext/numo/linalg/lapack/syevr.c +111 -0
  66. data/ext/numo/linalg/lapack/syevr.h +15 -0
  67. data/ext/numo/linalg/lapack/sygv.c +93 -0
  68. data/ext/numo/linalg/lapack/sygv.h +15 -0
  69. data/ext/numo/linalg/lapack/sygvd.c +93 -0
  70. data/ext/numo/linalg/lapack/sygvd.h +15 -0
  71. data/ext/numo/linalg/lapack/sygvx.c +133 -0
  72. data/ext/numo/linalg/lapack/sygvx.h +15 -0
  73. data/ext/numo/linalg/lapack/sytrf.c +72 -0
  74. data/ext/numo/linalg/lapack/sytrf.h +15 -0
  75. data/ext/numo/linalg/lapack/trtrs.c +99 -0
  76. data/ext/numo/linalg/lapack/trtrs.h +15 -0
  77. data/ext/numo/linalg/lapack/ungqr.c +79 -0
  78. data/ext/numo/linalg/lapack/ungqr.h +15 -0
  79. data/ext/numo/linalg/linalg.c +290 -0
  80. data/ext/numo/linalg/linalg.h +85 -0
  81. data/ext/numo/linalg/util.c +95 -0
  82. data/ext/numo/linalg/util.h +17 -0
  83. data/lib/numo/linalg/version.rb +10 -0
  84. data/lib/numo/linalg.rb +1309 -0
  85. data/vendor/tmp/.gitkeep +0 -0
  86. metadata +146 -0
@@ -0,0 +1,92 @@
1
+ #include "gelsd.h"
2
+
3
+ struct _gelsd_option {
4
+ int matrix_layout;
5
+ double rcond;
6
+ };
7
+
8
+ #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc) \
9
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
10
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
11
+ tDType* b = (tDType*)NDL_PTR(lp, 1); \
12
+ tRtDType* s = (tRtDType*)NDL_PTR(lp, 2); \
13
+ int* rank = (int*)NDL_PTR(lp, 3); \
14
+ int* info = (int*)NDL_PTR(lp, 4); \
15
+ struct _gelsd_option* opt = (struct _gelsd_option*)(lp->opt_ptr); \
16
+ const lapack_int m = (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]); \
17
+ const lapack_int n = (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[1] : NDL_SHAPE(lp, 0)[0]); \
18
+ const lapack_int nrhs = lp->args[1].ndim == 1 ? 1 : (lapack_int)NDL_SHAPE(lp, 1)[1]; \
19
+ const lapack_int lda = n; \
20
+ const lapack_int ldb = nrhs; \
21
+ lapack_int r = 0; \
22
+ lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, m, n, nrhs, a, lda, b, ldb, s, (tRtDType)(opt->rcond), &r); \
23
+ *rank = (int)r; \
24
+ *info = (int)i; \
25
+ } \
26
+ \
27
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
28
+ VALUE a_vnary = Qnil; \
29
+ VALUE b_vnary = Qnil; \
30
+ VALUE kw_args = Qnil; \
31
+ rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
32
+ ID kw_table[2] = { rb_intern("matrix_layout"), rb_intern("rcond") }; \
33
+ VALUE kw_values[2] = { Qundef, Qundef }; \
34
+ rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
35
+ const int matrix_layout = kw_values[0] != Qundef && kw_values[0] != Qnil ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
36
+ const double rcond = kw_values[1] != Qundef && kw_values[1] != Qnil ? NUM2DBL(kw_values[1]) : -1.0; \
37
+ \
38
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
39
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
40
+ } \
41
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
42
+ a_vnary = nary_dup(a_vnary); \
43
+ } \
44
+ if (CLASS_OF(b_vnary) != tNAryClass) { \
45
+ b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
46
+ } \
47
+ if (!RTEST(nary_check_contiguous(b_vnary))) { \
48
+ b_vnary = nary_dup(b_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
+ narray_t* b_nary = NULL; \
59
+ GetNArray(b_vnary, b_nary); \
60
+ const int b_n_dims = NA_NDIM(b_nary); \
61
+ if (b_n_dims != 1 && b_n_dims != 2) { \
62
+ rb_raise(rb_eArgError, "input array b must be 1 or 2-dimensional"); \
63
+ return Qnil; \
64
+ } \
65
+ \
66
+ const size_t m = NA_SHAPE(a_nary)[0]; \
67
+ const size_t n = NA_SHAPE(a_nary)[1]; \
68
+ size_t shape_s[1] = { m < n ? m : n }; \
69
+ ndfunc_arg_in_t ain[2] = { { tNAryClass, 2 }, { OVERWRITE, b_n_dims } }; \
70
+ ndfunc_arg_out_t aout[3] = { { tRtNAryClass, 1, shape_s }, { numo_cInt32, 0 }, { numo_cInt32, 0 } }; \
71
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 3, ain, aout }; \
72
+ struct _gelsd_option opt = { matrix_layout, rcond }; \
73
+ VALUE ret = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
74
+ \
75
+ RB_GC_GUARD(a_vnary); \
76
+ RB_GC_GUARD(b_vnary); \
77
+ return ret; \
78
+ }
79
+
80
+ DEF_LINALG_FUNC(double, double, numo_cDFloat, numo_cDFloat, dgelsd)
81
+ DEF_LINALG_FUNC(float, float, numo_cSFloat, numo_cSFloat, sgelsd)
82
+ DEF_LINALG_FUNC(lapack_complex_double, double, numo_cDComplex, numo_cDFloat, zgelsd)
83
+ DEF_LINALG_FUNC(lapack_complex_float, float, numo_cSComplex, numo_cSFloat, cgelsd)
84
+
85
+ #undef DEF_LINALG_FUNC
86
+
87
+ void define_linalg_lapack_gelsd(VALUE mLapack) {
88
+ rb_define_module_function(mLapack, "dgelsd", RUBY_METHOD_FUNC(_linalg_lapack_dgelsd), -1);
89
+ rb_define_module_function(mLapack, "sgelsd", RUBY_METHOD_FUNC(_linalg_lapack_sgelsd), -1);
90
+ rb_define_module_function(mLapack, "zgelsd", RUBY_METHOD_FUNC(_linalg_lapack_zgelsd), -1);
91
+ rb_define_module_function(mLapack, "cgelsd", RUBY_METHOD_FUNC(_linalg_lapack_cgelsd), -1);
92
+ }
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GELSD_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GELSD_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_gelsd(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GELSD_H */
@@ -0,0 +1,72 @@
1
+ #include "geqrf.h"
2
+
3
+ struct _geqrf_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 _geqrf_option* opt = (struct _geqrf_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
+ const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, m, n, a, lda, tau); \
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_table[1] = { rb_intern("order") }; \
25
+ VALUE kw_values[1] = { Qundef }; \
26
+ rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
27
+ const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
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
+ const int n_dims = NA_NDIM(a_nary); \
39
+ if (n_dims != 2) { \
40
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
41
+ return Qnil; \
42
+ } \
43
+ \
44
+ size_t m = NA_SHAPE(a_nary)[0]; \
45
+ size_t n = NA_SHAPE(a_nary)[1]; \
46
+ size_t shape[1] = { m < n ? m : n }; \
47
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
48
+ ndfunc_arg_out_t aout[2] = { { tNAryClass, 1, shape }, { numo_cInt32, 0 } }; \
49
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 2, ain, aout }; \
50
+ struct _geqrf_option opt = { matrix_layout }; \
51
+ VALUE res = na_ndloop3(&ndf, &opt, 1, a_vnary); \
52
+ \
53
+ VALUE ret = rb_ary_concat(rb_ary_new3(1, a_vnary), res); \
54
+ \
55
+ RB_GC_GUARD(a_vnary); \
56
+ \
57
+ return ret; \
58
+ }
59
+
60
+ DEF_LINALG_FUNC(double, numo_cDFloat, dgeqrf)
61
+ DEF_LINALG_FUNC(float, numo_cSFloat, sgeqrf)
62
+ DEF_LINALG_FUNC(lapack_complex_double, numo_cDComplex, zgeqrf)
63
+ DEF_LINALG_FUNC(lapack_complex_float, numo_cSComplex, cgeqrf)
64
+
65
+ #undef DEF_LINALG_FUNC
66
+
67
+ void define_linalg_lapack_geqrf(VALUE mLapack) {
68
+ rb_define_module_function(mLapack, "dgeqrf", RUBY_METHOD_FUNC(_linalg_lapack_dgeqrf), -1);
69
+ rb_define_module_function(mLapack, "sgeqrf", RUBY_METHOD_FUNC(_linalg_lapack_sgeqrf), -1);
70
+ rb_define_module_function(mLapack, "zgeqrf", RUBY_METHOD_FUNC(_linalg_lapack_zgeqrf), -1);
71
+ rb_define_module_function(mLapack, "cgeqrf", RUBY_METHOD_FUNC(_linalg_lapack_cgeqrf), -1);
72
+ }
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GEQRF_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GEQRF_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_geqrf(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GEQRF_H */
@@ -0,0 +1,108 @@
1
+ #include "gesdd.h"
2
+
3
+ struct _gesdd_option {
4
+ int matrix_order;
5
+ char jobz;
6
+ };
7
+
8
+ #define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fLapackFunc) \
9
+ static void _iter_##fLapackFunc(na_loop_t* const lp) { \
10
+ tDType* a = (tDType*)NDL_PTR(lp, 0); \
11
+ tRtDType* s = (tRtDType*)NDL_PTR(lp, 1); \
12
+ tDType* u = (tDType*)NDL_PTR(lp, 2); \
13
+ tDType* vt = (tDType*)NDL_PTR(lp, 3); \
14
+ int* info = (int*)NDL_PTR(lp, 4); \
15
+ struct _gesdd_option* opt = (struct _gesdd_option*)(lp->opt_ptr); \
16
+ \
17
+ const lapack_int m = (lapack_int)(opt->matrix_order == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]); \
18
+ const lapack_int n = (lapack_int)(opt->matrix_order == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[1] : NDL_SHAPE(lp, 0)[0]); \
19
+ const lapack_int min_mn = m < n ? m : n; \
20
+ const lapack_int lda = n; \
21
+ const lapack_int ldu = opt->jobz == 'S' ? min_mn : m; \
22
+ const lapack_int ldvt = opt->jobz == 'S' ? min_mn : n; \
23
+ \
24
+ lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_order, opt->jobz, m, n, a, lda, s, u, ldu, vt, ldvt); \
25
+ *info = (int)i; \
26
+ } \
27
+ \
28
+ static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) { \
29
+ VALUE a_vnary = Qnil; \
30
+ VALUE kw_args = Qnil; \
31
+ \
32
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
33
+ \
34
+ ID kw_table[2] = { rb_intern("jobz"), rb_intern("order") }; \
35
+ VALUE kw_values[2] = { Qundef, Qundef }; \
36
+ \
37
+ rb_get_kwargs(kw_args, kw_table, 0, 2, kw_values); \
38
+ \
39
+ const char jobz = kw_values[0] == Qundef ? 'A' : StringValueCStr(kw_values[0])[0]; \
40
+ const char order = kw_values[1] == Qundef ? 'R' : StringValueCStr(kw_values[1])[0]; \
41
+ \
42
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
43
+ rb_raise(rb_eTypeError, "type of input array is invalid for overwriting"); \
44
+ return Qnil; \
45
+ } \
46
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
47
+ a_vnary = nary_dup(a_vnary); \
48
+ } \
49
+ \
50
+ narray_t* a_nary = NULL; \
51
+ GetNArray(a_vnary, a_nary); \
52
+ const int n_dims = NA_NDIM(a_nary); \
53
+ if (n_dims != 2) { \
54
+ rb_raise(rb_eArgError, "input array must be 2-dimensional"); \
55
+ return Qnil; \
56
+ } \
57
+ \
58
+ const int matrix_order = order == 'C' ? LAPACK_COL_MAJOR : LAPACK_ROW_MAJOR; \
59
+ const size_t m = matrix_order == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
60
+ const size_t n = matrix_order == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[1] : NA_SHAPE(a_nary)[0]; \
61
+ \
62
+ const size_t min_mn = m < n ? m : n; \
63
+ size_t shape_s[1] = { min_mn }; \
64
+ size_t shape_u[2] = { m, m }; \
65
+ size_t shape_vt[2] = { n, n }; \
66
+ \
67
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
68
+ ndfunc_arg_out_t aout[4] = { { tRtNAryClass, 1, shape_s }, { tNAryClass, 2, shape_u }, { tNAryClass, 2, shape_vt }, { numo_cInt32, 0 } }; \
69
+ \
70
+ switch (jobz) { \
71
+ case 'A': \
72
+ break; \
73
+ case 'S': \
74
+ shape_u[matrix_order == LAPACK_ROW_MAJOR ? 1 : 0] = min_mn; \
75
+ shape_vt[matrix_order == LAPACK_ROW_MAJOR ? 0 : 1] = min_mn; \
76
+ break; \
77
+ case 'O': \
78
+ break; \
79
+ case 'N': \
80
+ aout[1].dim = 0; \
81
+ aout[2].dim = 0; \
82
+ break; \
83
+ default: \
84
+ rb_raise(rb_eArgError, "jobz must be one of 'A', 'S', 'O', or 'N'"); \
85
+ return Qnil; \
86
+ } \
87
+ \
88
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout }; \
89
+ struct _gesdd_option opt = { matrix_order, jobz }; \
90
+ VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
91
+ \
92
+ RB_GC_GUARD(a_vnary); \
93
+ return ret; \
94
+ }
95
+
96
+ DEF_LINALG_FUNC(double, double, numo_cDFloat, numo_cDFloat, dgesdd)
97
+ DEF_LINALG_FUNC(float, float, numo_cSFloat, numo_cSFloat, sgesdd)
98
+ DEF_LINALG_FUNC(lapack_complex_double, double, numo_cDComplex, numo_cDFloat, zgesdd)
99
+ DEF_LINALG_FUNC(lapack_complex_float, float, numo_cSComplex, numo_cSFloat, cgesdd)
100
+
101
+ #undef DEF_LINALG_FUNC
102
+
103
+ void define_linalg_lapack_gesdd(VALUE mLapack) {
104
+ rb_define_module_function(mLapack, "dgesdd", RUBY_METHOD_FUNC(_linalg_lapack_dgesdd), -1);
105
+ rb_define_module_function(mLapack, "sgesdd", RUBY_METHOD_FUNC(_linalg_lapack_sgesdd), -1);
106
+ rb_define_module_function(mLapack, "zgesdd", RUBY_METHOD_FUNC(_linalg_lapack_zgesdd), -1);
107
+ rb_define_module_function(mLapack, "cgesdd", RUBY_METHOD_FUNC(_linalg_lapack_cgesdd), -1);
108
+ }
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GESDD_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GESDD_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_gesdd(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GESDD_H */
@@ -0,0 +1,99 @@
1
+ #include "gesv.h"
2
+
3
+ struct _gesv_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* b = (tDType*)NDL_PTR(lp, 1); \
11
+ int* ipiv = (int*)NDL_PTR(lp, 2); \
12
+ int* info = (int*)NDL_PTR(lp, 3); \
13
+ struct _gesv_option* opt = (struct _gesv_option*)(lp->opt_ptr); \
14
+ const lapack_int n = (lapack_int)NDL_SHAPE(lp, 0)[0]; \
15
+ const lapack_int nhrs = lp->args[1].ndim == 1 ? 1 : (lapack_int)NDL_SHAPE(lp, 1)[1]; \
16
+ const lapack_int lda = n; \
17
+ const lapack_int ldb = nhrs; \
18
+ const lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, n, nhrs, a, lda, ipiv, b, ldb); \
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 b_vnary = Qnil; \
25
+ VALUE kw_args = Qnil; \
26
+ \
27
+ rb_scan_args(argc, argv, "2:", &a_vnary, &b_vnary, &kw_args); \
28
+ \
29
+ ID kw_table[1] = { rb_intern("order") }; \
30
+ VALUE kw_values[1] = { Qundef }; \
31
+ \
32
+ rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values); \
33
+ \
34
+ const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR; \
35
+ \
36
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
37
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
38
+ } \
39
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
40
+ a_vnary = nary_dup(a_vnary); \
41
+ } \
42
+ if (CLASS_OF(b_vnary) != tNAryClass) { \
43
+ b_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, b_vnary); \
44
+ } \
45
+ if (!RTEST(nary_check_contiguous(b_vnary))) { \
46
+ b_vnary = nary_dup(b_vnary); \
47
+ } \
48
+ \
49
+ narray_t* a_nary = NULL; \
50
+ narray_t* b_nary = NULL; \
51
+ GetNArray(a_vnary, a_nary); \
52
+ GetNArray(b_vnary, b_nary); \
53
+ const int a_n_dims = NA_NDIM(a_nary); \
54
+ const int b_n_dims = NA_NDIM(b_nary); \
55
+ if (a_n_dims != 2) { \
56
+ rb_raise(rb_eArgError, "input array a must be 2-dimensional"); \
57
+ return Qnil; \
58
+ } \
59
+ if (b_n_dims != 1 && b_n_dims != 2) { \
60
+ rb_raise(rb_eArgError, "input array b must be 1- or 2-dimensional"); \
61
+ return Qnil; \
62
+ } \
63
+ \
64
+ lapack_int n = (lapack_int)NA_SHAPE(a_nary)[0]; \
65
+ lapack_int nb = (lapack_int)(b_n_dims == 1 ? NA_SHAPE(b_nary)[0] : NA_SHAPE(b_nary)[0]); \
66
+ if (n != nb) { \
67
+ rb_raise(nary_eShapeError, "shape1[1](=%d) != shape2[0](=%d)", n, nb); \
68
+ } \
69
+ \
70
+ lapack_int nhrs = b_n_dims == 1 ? 1 : (lapack_int)NA_SHAPE(b_nary)[1]; \
71
+ size_t shape[2] = { (size_t)n, (size_t)nhrs }; \
72
+ ndfunc_arg_in_t ain[2] = { { OVERWRITE, 2 }, { OVERWRITE, b_n_dims } }; \
73
+ ndfunc_arg_out_t aout[2] = { { numo_cInt32, 1, shape }, { numo_cInt32, 0 } }; \
74
+ \
75
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 2, 2, ain, aout }; \
76
+ struct _gesv_option opt = { matrix_layout }; \
77
+ VALUE res = na_ndloop3(&ndf, &opt, 2, a_vnary, b_vnary); \
78
+ \
79
+ VALUE ret = rb_ary_concat(rb_assoc_new(a_vnary, b_vnary), res); \
80
+ \
81
+ RB_GC_GUARD(a_vnary); \
82
+ RB_GC_GUARD(b_vnary); \
83
+ \
84
+ return ret; \
85
+ }
86
+
87
+ DEF_LINALG_FUNC(double, numo_cDFloat, dgesv)
88
+ DEF_LINALG_FUNC(float, numo_cSFloat, sgesv)
89
+ DEF_LINALG_FUNC(lapack_complex_double, numo_cDComplex, zgesv)
90
+ DEF_LINALG_FUNC(lapack_complex_float, numo_cSComplex, cgesv)
91
+
92
+ #undef DEF_LINALG_FUNC
93
+
94
+ void define_linalg_lapack_gesv(VALUE mLapack) {
95
+ rb_define_module_function(mLapack, "dgesv", RUBY_METHOD_FUNC(_linalg_lapack_dgesv), -1);
96
+ rb_define_module_function(mLapack, "sgesv", RUBY_METHOD_FUNC(_linalg_lapack_sgesv), -1);
97
+ rb_define_module_function(mLapack, "zgesv", RUBY_METHOD_FUNC(_linalg_lapack_zgesv), -1);
98
+ rb_define_module_function(mLapack, "cgesv", RUBY_METHOD_FUNC(_linalg_lapack_cgesv), -1);
99
+ }
@@ -0,0 +1,15 @@
1
+ #ifndef NUMO_LINALG_ALT_LAPACK_GESV_H
2
+ #define NUMO_LINALG_ALT_LAPACK_GESV_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_gesv(VALUE mLapack);
14
+
15
+ #endif /* NUMO_LINALG_ALT_LAPACK_GESV_H */
@@ -0,0 +1,152 @@
1
+ #include "gesvd.h"
2
+
3
+ struct _gesvd_option {
4
+ int matrix_order;
5
+ char jobu;
6
+ char jobvt;
7
+ };
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* s = (tRtDType*)NDL_PTR(lp, 1); \
13
+ tDType* u = (tDType*)NDL_PTR(lp, 2); \
14
+ tDType* vt = (tDType*)NDL_PTR(lp, 3); \
15
+ int* info = (int*)NDL_PTR(lp, 4); \
16
+ struct _gesvd_option* opt = (struct _gesvd_option*)(lp->opt_ptr); \
17
+ \
18
+ const lapack_int m = (lapack_int)(opt->matrix_order == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]); \
19
+ const lapack_int n = (lapack_int)(opt->matrix_order == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[1] : NDL_SHAPE(lp, 0)[0]); \
20
+ const lapack_int min_mn = m < n ? m : n; \
21
+ const lapack_int lda = n; \
22
+ const lapack_int ldu = opt->jobu == 'A' ? m : min_mn; \
23
+ const lapack_int ldvt = n; \
24
+ \
25
+ tRtDType* superb = (tRtDType*)ruby_xmalloc(min_mn * sizeof(tRtDType)); \
26
+ \
27
+ lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_order, opt->jobu, opt->jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, superb); \
28
+ *info = (int)i; \
29
+ \
30
+ ruby_xfree(superb); \
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
+ \
37
+ rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args); \
38
+ \
39
+ ID kw_table[3] = { rb_intern("jobu"), rb_intern("jobvt"), rb_intern("order") }; \
40
+ VALUE kw_values[3] = { Qundef, Qundef, Qundef }; \
41
+ \
42
+ rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values); \
43
+ \
44
+ const char jobu = kw_values[0] == Qundef ? 'A' : StringValueCStr(kw_values[0])[0]; \
45
+ const char jobvt = kw_values[1] == Qundef ? 'A' : StringValueCStr(kw_values[1])[0]; \
46
+ const char order = kw_values[2] == Qundef ? 'R' : StringValueCStr(kw_values[2])[0]; \
47
+ \
48
+ if (jobu == 'O' && jobvt == 'O') { \
49
+ rb_raise(rb_eArgError, "jobu and jobvt cannot be both 'O'"); \
50
+ return Qnil; \
51
+ } \
52
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
53
+ rb_raise(rb_eTypeError, "type of input array is invalid for overwriting"); \
54
+ return Qnil; \
55
+ } \
56
+ \
57
+ if (CLASS_OF(a_vnary) != tNAryClass) { \
58
+ a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary); \
59
+ } \
60
+ if (!RTEST(nary_check_contiguous(a_vnary))) { \
61
+ a_vnary = nary_dup(a_vnary); \
62
+ } \
63
+ \
64
+ narray_t* a_nary = NULL; \
65
+ GetNArray(a_vnary, a_nary); \
66
+ const int n_dims = NA_NDIM(a_nary); \
67
+ if (n_dims != 2) { \
68
+ rb_raise(rb_eArgError, "input array must be 2-dimensional"); \
69
+ return Qnil; \
70
+ } \
71
+ \
72
+ const int matrix_order = order == 'C' ? LAPACK_COL_MAJOR : LAPACK_ROW_MAJOR; \
73
+ const size_t m = matrix_order == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1]; \
74
+ const size_t n = matrix_order == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[1] : NA_SHAPE(a_nary)[0]; \
75
+ \
76
+ const size_t min_mn = m < n ? m : n; \
77
+ size_t shape_s[1] = { min_mn }; \
78
+ size_t shape_u[2] = { m, m }; \
79
+ size_t shape_vt[2] = { n, n }; \
80
+ \
81
+ ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } }; \
82
+ ndfunc_arg_out_t aout[4] = { { tRtNAryClass, 1, shape_s }, { tNAryClass, 2, shape_u }, { tNAryClass, 2, shape_vt }, { numo_cInt32, 0 } }; \
83
+ \
84
+ switch (jobu) { \
85
+ case 'A': \
86
+ break; \
87
+ case 'S': \
88
+ shape_u[matrix_order == LAPACK_ROW_MAJOR ? 1 : 0] = min_mn; \
89
+ break; \
90
+ case 'O': \
91
+ case 'N': \
92
+ aout[1].dim = 0; \
93
+ break; \
94
+ default: \
95
+ rb_raise(rb_eArgError, "jobu must be 'A', 'S', 'O', or 'N'"); \
96
+ return Qnil; \
97
+ } \
98
+ \
99
+ switch (jobvt) { \
100
+ case 'A': \
101
+ break; \
102
+ case 'S': \
103
+ shape_vt[matrix_order == LAPACK_ROW_MAJOR ? 0 : 1] = min_mn; \
104
+ break; \
105
+ case 'O': \
106
+ case 'N': \
107
+ aout[2].dim = 0; \
108
+ break; \
109
+ default: \
110
+ rb_raise(rb_eArgError, "jobvt must be 'A', 'S', 'O', or 'N'"); \
111
+ return Qnil; \
112
+ } \
113
+ \
114
+ ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout }; \
115
+ struct _gesvd_option opt = { matrix_order, jobu, jobvt }; \
116
+ VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary); \
117
+ \
118
+ switch (jobu) { \
119
+ case 'O': \
120
+ rb_ary_store(ret, 1, a_vnary); \
121
+ break; \
122
+ case 'N': \
123
+ rb_ary_store(ret, 1, Qnil); \
124
+ break; \
125
+ } \
126
+ \
127
+ switch (jobvt) { \
128
+ case 'O': \
129
+ rb_ary_store(ret, 2, a_vnary); \
130
+ break; \
131
+ case 'N': \
132
+ rb_ary_store(ret, 2, Qnil); \
133
+ break; \
134
+ } \
135
+ \
136
+ RB_GC_GUARD(a_vnary); \
137
+ return ret; \
138
+ }
139
+
140
+ DEF_LINALG_FUNC(double, double, numo_cDFloat, numo_cDFloat, dgesvd)
141
+ DEF_LINALG_FUNC(float, float, numo_cSFloat, numo_cSFloat, sgesvd)
142
+ DEF_LINALG_FUNC(lapack_complex_double, double, numo_cDComplex, numo_cDFloat, zgesvd)
143
+ DEF_LINALG_FUNC(lapack_complex_float, float, numo_cSComplex, numo_cSFloat, cgesvd)
144
+
145
+ #undef DEF_LINALG_FUNC
146
+
147
+ void define_linalg_lapack_gesvd(VALUE mLapack) {
148
+ rb_define_module_function(mLapack, "dgesvd", RUBY_METHOD_FUNC(_linalg_lapack_dgesvd), -1);
149
+ rb_define_module_function(mLapack, "sgesvd", RUBY_METHOD_FUNC(_linalg_lapack_sgesvd), -1);
150
+ rb_define_module_function(mLapack, "zgesvd", RUBY_METHOD_FUNC(_linalg_lapack_zgesvd), -1);
151
+ rb_define_module_function(mLapack, "cgesvd", RUBY_METHOD_FUNC(_linalg_lapack_cgesvd), -1);
152
+ }