numo-linalg 0.0.1

data/ext/numo/linalg/lapack/tmpl/gqr.c

@@ -0,0 +1,121 @@
+/*<%
+%>*/
+<% %>
+#define args_t <%=func_name%>_args_t
+#define func_p <%=func_name%>_p
+
+typedef struct {
+    int order;
+} args_t;
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t * const lp)
+{
+    dtype *a;
+    dtype *tau;
+    int   *info;
+    int    m, n, k, lda, tmp;
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    tau = (dtype*)NDL_PTR(lp,1);
+    info = (int*)NDL_PTR(lp,2);
+    g = (args_t*)(lp->opt_ptr);
+
+    m = NDL_SHAPE(lp,0)[0];
+    n = NDL_SHAPE(lp,0)[1];
+    k = NDL_SHAPE(lp,1)[0];
+    SWAP_IFCOL(g->order,m,n);
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+
+    printf("order=%d m=%d n=%d k=%d lda=%d \n",g->order,m,n,k,lda);
+
+    *info = (*func_p)(g->order, m, n, k, a, lda, tau);
+    CHECK_ERROR(*info);
+}
+
+/*<%
+ args_v = [
+   "a",
+   "tau",
+ ].select{|x| x}.join(", ")
+
+ args_opt = [
+   "order:'R'",
+ ].select{|x| x}.join(", ")
+
+ params = [
+   mat("a",:inplace),
+   vec("tau"),
+   opt("order"),
+ ].select{|x| x}.join("\n  ")
+
+ return_type = [
+   class_name,
+   "Integer"
+ ].select{|x| x}.join(", ")
+
+ return_name = [
+   "a",
+   "info"
+ ].select{|x| x}.join(", ")
+%>
+  @overload <%=name%>(a, tau, order:'R')
+  <%=params%>
+  @return [[<%=return_name%>]] Array<<%=return_type%>>
+<%=outparam(return_name)%>
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE a, tau, ans;
+    int   m, n, k, tmp;
+    narray_t *na1, *na2;
+    ndfunc_arg_in_t ain[2] = {{OVERWRITE,2},{cT,1}};
+    ndfunc_arg_out_t aout[1] = {{cInt,0}};
+    ndfunc_t ndf = {&<%=c_iter%>, NO_LOOP|NDF_EXTRACT, 2,1, ain,aout};
+
+    args_t g = {0};
+    VALUE opts[1] = {Qundef};
+    VALUE kw_hash = Qnil;
+    ID kw_table[1] = {id_order};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "2:", &a, &tau, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 1, opts);
+    g.order = option_order(opts[0]);
+
+    COPY_OR_CAST_TO(a,cT);
+    GetNArray(a, na1);
+    CHECK_DIM_GE(na1, 2);
+    m = ROW_SIZE(na1);
+    n = COL_SIZE(na1);
+
+    GetNArray(tau, na2);
+    CHECK_DIM_GE(na2, 1);
+    k = COL_SIZE(na2);
+    if (m < n) {
+        rb_raise(nary_eShapeError,
+                 "a row length (m) must be >= a column length (n): m=%d n=%d",
+                 m,n);
+    }
+    if (n < k) {
+        rb_raise(nary_eShapeError,
+                 "a column length (n) must be >= tau length (k): n=%d, k=%d",
+                 k,n);
+    }
+    SWAP_IFCOL(g.order,m,n);
+
+    ans = na_ndloop3(&ndf, &g, 2, a, tau);
+
+    return rb_assoc_new(a, ans);
+}
+
+#undef args_t
+#undef func_p

data/ext/numo/linalg/lapack/tmpl/init_class.c

@@ -0,0 +1,20 @@
+    /*
+      Document-class: <%= full_class_name %>
+      <%= description %>
+    */
+    cT = rb_define_class_under(<%=ns_var%>, "<%=class_name%>", cNArray);
+
+  <% for x in class_alias %>
+    // alias of <%=class_name%>
+    rb_define_const(<%=ns_var%>, "<%=x%>", <%=type_var%>);
+  <% end %>
+
+    hCast = rb_hash_new();
+    rb_define_const(cT, "UPCAST", hCast);
+    rb_hash_aset(hCast, rb_cArray,   cT);
+    <% for x in upcast %>
+    <%= x %><% end %>
+
+    <% @children.each do |m| %>
+    <%= m.init_def %><% end %>
+    rb_define_singleton_method(cT, "[]", <%=find("cast").c_func%>, -2);

data/ext/numo/linalg/lapack/tmpl/init_module.c

@@ -0,0 +1,12 @@
+    /*
+      Document-module: <%= full_module_name %>
+      <%= description %>
+    */
+    <%  if module_var != ns_var %>
+    <%=module_var%> = rb_define_module_under(<%=ns_var%>, "<%=module_name%>");
+    <%  end %>
+    <% @children.each do |m| %>
+    <%= m.init_def %><% end %>
+
+    //  how to do this?
+    //rb_extend_object(cT, mTM);

data/ext/numo/linalg/lapack/tmpl/lange.c

@@ -0,0 +1,79 @@
+#define args_t <%=func_name%>_args_t
+#define func_p <%=func_name%>_p
+
+typedef struct {
+    int   order;
+    char  norm;
+} args_t;
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t * const lp)
+{
+    dtype *a;
+    rtype *norm;
+    int    m, n, lda, tmp;
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    norm = (rtype*)NDL_PTR(lp,1);
+    g = (args_t*)(lp->opt_ptr);
+
+    m = NDL_SHAPE(lp,0)[0];
+    n = NDL_SHAPE(lp,0)[1];
+    SWAP_IFCOL(g->order,m,n);
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+
+    //printf("order=%d norm=%c m=%d n=%d lda=%d\n",g->order,g->norm,m,n,lda);
+
+    *norm = (*func_p)(g->order, g->norm, m, n, a, lda);
+}
+
+/*<%
+ params = [
+   mat("a"),
+   "@param [String]  norm  Kind of norm: 'M',('1','O'),'I',('F','E')",
+   opt("order"),
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>(a, norm, [order:'R'])
+  <%=params%>
+  @return [<%=real_class_name%>] returns <%=name%>.
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE a, norm, ans;
+    narray_t *na1;
+    ndfunc_arg_in_t ain[1] = {{cT,2}};
+    ndfunc_arg_out_t aout[1] = {{cRT,0}};
+    ndfunc_t ndf = {&<%=c_iter%>, NO_LOOP|NDF_EXTRACT, 1, 1, ain, aout};
+
+    args_t g;
+    VALUE opts[1] = {Qundef};
+    ID kw_table[1] = {id_order};
+    VALUE kw_hash = Qnil;
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "2:", &a, &norm, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 1, opts);
+    g.order = option_order(opts[0]);
+    g.norm  = option_job(norm,'F','F');
+    //reduce = nary_reduce_options(Qnil, &opts[1], 1, &a, &ndf);
+    //A is DOUBLE PRECISION array, dimension (LDA,N)
+    //On entry, the M-by-N matrix A.
+    //COPY_OR_CAST_TO(a,cT); // not overwrite
+    GetNArray(a, na1);
+    CHECK_DIM_GE(na1, 2);
+
+    ans = na_ndloop3(&ndf, &g, 1, a);
+    return ans;
+}
+
+#undef func_p
+#undef args_t

data/ext/numo/linalg/lapack/tmpl/lib.c

@@ -0,0 +1,40 @@
+/*
+  LAPACK wrapper for Ruby/Numo
+    (C) Copyright 2017 by Masahiro TANAKA
+
+  This program is free software.
+  NO WARRANTY.
+*/
+
+#include <assert.h>
+#include <ruby.h>
+#include "numo/narray.h"
+#include "numo/template.h"
+#include "numo_lapack.h"
+
+<% id_decl.each do |x| %>
+<%= x %>
+<% end %>
+
+<% include_files.each do |f| %>
+#include <<%=f%>>
+<% end %>
+
+<% children.each do |c|%>
+<%= c.result+"\n\n" %>
+<% end %>
+
+void
+Init_<%=lib_name%>(void)
+{
+    VALUE <%=ns_var%>;
+
+    <%=ns_var%> = rb_define_module("Numo");
+
+    <% id_assign.each do |x| %>
+    <%= x %><% end %>
+
+<% children.each do |c| %>
+<%= c.init_def %>
+<% end %>
+}

data/ext/numo/linalg/lapack/tmpl/module.c

@@ -0,0 +1,9 @@
+/*
+  module definition: <%= full_module_name %>
+*/
+
+<%  if module_var != ns_var %>
+static VALUE <%=module_var%>;
+<%  end %>
+
+<%= method_code %>

data/ext/numo/linalg/lapack/tmpl/syev.c

@@ -0,0 +1,91 @@
+#define args_t <%=func_name%>_args_t
+#define func_p <%=func_name%>_p
+
+typedef struct {
+    int order;
+    char jobz, uplo;
+} args_t;
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t * const lp)
+{
+    dtype *a;
+    rtype *w;
+    int   *info;
+    int    n, lda;
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    w = (rtype*)NDL_PTR(lp,1);
+    info = (int*)NDL_PTR(lp,2);
+    g = (args_t*)(lp->opt_ptr);
+
+    n = NDL_SHAPE(lp,0)[1];
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+
+    //printf("order=%d jobz=%c uplo=%c n=%d lda=%d\n",g->order,g->jobz,g->uplo,n,lda);
+
+    *info = (*func_p)( g->order, g->jobz, g->uplo, n, a, lda, w );
+    CHECK_ERROR(*info);
+}
+
+/*<%
+ params = [
+   mat("a",:inplace),
+   jobe("jobz"),
+   opt("uplo"),
+   opt("order"),
+ ].select{|x| x}.join("\n  ")
+ return_name = "a, w, info"
+%>
+  @overload <%=name%>(a, [jobz:'V', uplo:'U', order:'R'])
+  <%=params%>
+  @return [[<%=return_name%>]]  Array<<%=real_class_name%>,<%=real_class_name%>,Integer>
+<%=outparam(return_name)%>
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE a, ans;
+    int   m, n;
+    narray_t *na1;
+    size_t shape[1];
+    ndfunc_arg_in_t ain[1] = {{OVERWRITE,2}};
+    ndfunc_arg_out_t aout[2] = {{cRT,1,shape},{cInt,0}};
+    ndfunc_t ndf = {&<%=c_iter%>, NO_LOOP|NDF_EXTRACT, 1, 2, ain, aout};
+
+    args_t g = {0,0,0};
+    VALUE opts[3] = {Qundef,Qundef,Qundef};
+    VALUE kw_hash = Qnil;
+    ID kw_table[3] = {id_order,id_jobz,id_uplo};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "1:", &a, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 3, opts);
+    g.order = option_order(opts[0]);
+    g.jobz = option_job(opts[1],'V','N');
+    g.uplo = option_uplo(opts[2]);
+
+    COPY_OR_CAST_TO(a,cT);
+    GetNArray(a, na1);
+    CHECK_DIM_GE(na1, 2);
+    m = ROW_SIZE(na1);
+    n = COL_SIZE(na1);
+    if (m != n) {
+        rb_raise(nary_eShapeError,"matrix must be square");
+    }
+    shape[0] = n;
+
+    ans = na_ndloop3(&ndf, &g, 1, a);
+
+    return rb_ary_new3(3, a, RARRAY_AREF(ans,0), RARRAY_AREF(ans,1));
+}
+
+#undef args_t
+#undef func_p

data/ext/numo/linalg/lapack/tmpl/sygv.c

@@ -0,0 +1,104 @@
+#define args_t <%=func_name%>_args_t
+#define func_p <%=func_name%>_p
+
+typedef struct {
+    int order;
+    int itype;
+    char jobz, uplo;
+} args_t;
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t * const lp)
+{
+    dtype *a, *b;
+    rtype *w;
+    int   *info;
+    int    n, lda, ldb;
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    b = (dtype*)NDL_PTR(lp,1);
+    w = (rtype*)NDL_PTR(lp,2);
+    info = (int*)NDL_PTR(lp,3);
+    g = (args_t*)(lp->opt_ptr);
+
+    n = NDL_SHAPE(lp,0)[1];
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+    ldb = NDL_STEP(lp,1) / sizeof(dtype);
+
+    //printf("order=%d itype=%d jobz=%c uplo=%c n=%d lda=%d ldb=%d\n",g->order,g->itype,g->jobz,g->uplo,n,lda,ldb);
+
+    *info = (*func_p)( g->order, g->itype, g->jobz, g->uplo, n, a, lda, b, ldb, w );
+    CHECK_ERROR(*info);
+}
+
+/*<%
+ params = [
+   mat("a",:inplace),
+   mat("b",:inplace),
+   "@param [Integer] itype Specifies the problem type to be solved. If 1:  A*x = (lambda)*B*x, If 2:  A*B*x = (lambda)*x, If 3:  B*A*x = (lambda)*x.",
+   jobe("jobz"),
+   opt("uplo"),
+   opt("order"),
+ ].select{|x| x}.join("\n  ")
+return_name="a, b, w, info"
+%>
+  @overload <%=name%>(a, b, [itype:1, jobz:'V', uplo:'U', order:'R'])
+  <%=params%>
+  @return [[<%=return_name%>]] Array<<%=real_class_name%>,<%=real_class_name%>,Integer>
+<%=outparam(return_name)%>
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE a, b, ans;
+    int   n, nb;
+    narray_t *na1, *na2;
+    size_t shape[1];
+    ndfunc_arg_in_t ain[2] = {{OVERWRITE,2},{OVERWRITE,2}};
+    ndfunc_arg_out_t aout[2] = {{cRT,1,shape},{cInt,0}};
+    ndfunc_t ndf = {&<%=c_iter%>, NO_LOOP|NDF_EXTRACT, 2, 2, ain, aout};
+
+    args_t g;
+    VALUE opts[4] = {Qundef,Qundef,Qundef,Qundef};
+    VALUE kw_hash = Qnil;
+    ID kw_table[4] = {id_order,id_jobz,id_uplo,id_itype};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "2:", &a, &b, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 4, opts);
+    g.order = option_order(opts[0]);
+    g.jobz = option_job(opts[1],'V','N');
+    g.uplo = option_uplo(opts[2]);
+    g.itype = NUM2INT(option_value(opts[3],INT2FIX(1)));
+
+    COPY_OR_CAST_TO(a,cT);
+    GetNArray(a, na1);
+    CHECK_DIM_GE(na1, 2);
+
+    COPY_OR_CAST_TO(b,cT);
+    GetNArray(b, na2);
+    CHECK_DIM_GE(na2, 2);
+
+    CHECK_SQUARE("matrix a",na1);
+    n  = COL_SIZE(na1);
+    CHECK_SQUARE("matrix b",na2);
+    nb = COL_SIZE(na2);
+    if (n != nb) {
+        rb_raise(nary_eShapeError,"matrix a and b must have same size");
+    }
+    shape[0] = n;
+
+    ans = na_ndloop3(&ndf, &g, 2, a, b);
+
+    return rb_ary_new3(4, a, b, RARRAY_AREF(ans,0), RARRAY_AREF(ans,1));
+}
+
+#undef args_t
+#undef func_p