numo-linalg 0.0.1

data/ext/numo/linalg/blas/tmpl/mm.c

@@ -0,0 +1,214 @@
+/*<%
+  is_ge = (/^.ge/ =~ name)
+  is_tr = (/^.tr/ =~ name)
+  is_tr = (/^.tr/ =~ name)
+%>*/
+<% %>
+#define GE <%= is_ge ? "1":"0" %>
+#define TR <%= is_tr ? "1":"0" %>
+#define args_t <%=name%>_args_t
+
+typedef struct {
+  enum CBLAS_ORDER order;
+  enum CBLAS_TRANSPOSE transa, transb;
+  enum CBLAS_SIDE side;
+  enum CBLAS_UPLO uplo;
+  enum CBLAS_DIAG diag;
+  dtype alpha, beta;
+  blasint m, n, k;
+} args_t;
+
+#define func_p <%=func_name%>_p
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    dtype *a, *b;
+    int    lda, ldb;
+#if !TR
+    dtype *c;
+    int    ldc;
+#endif
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    b = (dtype*)NDL_PTR(lp,1);
+#if !TR
+    c = (dtype*)NDL_PTR(lp,2);
+#endif
+    g = (args_t*)(lp->opt_ptr);
+
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+    ldb = NDL_STEP(lp,1) / sizeof(dtype);
+#if !TR
+    ldc = NDL_STEP(lp,2) / sizeof(dtype);
+#endif
+
+    //printf("m=%d n=%d k=%d\n",g->m,g->n,g->k);
+
+#if GE
+    (*func_p)( g->order, g->transa, g->transb, g->m, g->n, g->k,
+              DP(g->alpha), a, lda, b, ldb, DP(g->beta), c, ldc);
+#elif TR
+    (*func_p)( g->order, g->side, g->uplo, g->transa, g->diag, g->m, g->n,
+               DP(g->alpha), a, lda, b, ldb);
+#else // SY,HE
+    (*func_p)( g->order, g->side, g->uplo, g->m, g->n,
+               DP(g->alpha), a, lda, b, ldb, DP(g->beta), c, ldc);
+#endif
+}
+
+/*
+<%
+ args_v =
+  if is_ge
+   "a, b, [c, alpha:1, beta:0, transa:'N', transb:'N'"
+  elsif is_tr
+   "a, b, [alpha:1, side:'L', uplo:'U', transa:'N', diag:'U'"
+  else
+   "a, b, [c, alpha:1, beta:0, side:'L', uplo:'U'"
+  end + ", order:'R'"
+
+ params = [
+   mat("a"),
+   mat("b"),
+   !is_tr && mat("c","optional",:inplace),
+   opt("alpha"),
+   opt("beta"),
+   !is_ge && opt("side"),
+   !is_ge && opt("uplo"),
+   (is_ge || is_tr) && opt("transa"),
+   is_ge            && opt("transb"),
+   opt("order")
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>(<%=args_v%>)
+  <%=params%>
+  @return [<%=class_name%>] returns c = alpha\*op( A )\*op( B ) + beta\*C.
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     a, b, c=Qnil, alpha, beta;
+    narray_t *na1, *na2;
+    blasint   ma, ka, kb, nb, tmp;
+    size_t    shape[2];
+    ndfunc_arg_in_t ain[3] = {{cT,2},{cT,2},{OVERWRITE,2}};
+    ndfunc_arg_out_t aout[1] = {{cT,2,shape}};
+    ndfunc_t ndf = {<%=c_iter%>, NO_LOOP, 3, 0, ain, aout};
+
+    args_t g;
+    VALUE kw_hash = Qnil;
+#if GE
+    ID kw_table[5] = {id_alpha,id_beta,id_order,id_transa,id_transb};
+#elif TR
+    ID kw_table[7] = {id_alpha,id_beta,id_order,id_side,id_uplo,id_transa,id_diag};
+#else
+    ID kw_table[5] = {id_alpha,id_beta,id_order,id_side,id_uplo};
+#endif
+    VALUE opts[7] = {Qundef,Qundef,Qundef,Qundef,Qundef,Qundef,Qundef};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "21:", &a, &b, &c, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 5+TR*2, opts);
+    alpha    = option_value(opts[0],Qnil);
+    g.alpha  = RTEST(alpha) ? m_num_to_data(alpha) : m_one;
+    beta     = option_value(opts[1],Qnil);
+    g.beta   = RTEST(beta)  ? m_num_to_data(beta)  : m_zero;
+    g.order  = option_order(opts[2]);
+#if GE
+    g.transa = option_trans(opts[3]);
+    g.transb = option_trans(opts[4]);
+#else
+    g.side   = option_side(opts[3]);
+    g.uplo   = option_uplo(opts[4]);
+#endif
+#if TR
+    g.transa = option_trans(opts[5]);
+    g.diag   = option_diag(opts[6]);
+#endif
+
+    GetNArray(a,na1);
+    GetNArray(b,na2);
+    CHECK_DIM_GE(na1,2);
+    CHECK_DIM_GE(na2,2);
+    ma = ROW_SIZE(na1); // m
+    ka = COL_SIZE(na1); // k (lda)
+    kb = ROW_SIZE(na2); // k
+    nb = COL_SIZE(na2); // n (ldb)
+
+#if GE
+    SWAP_IFCOLTR(g.order,g.transa, ma,ka, tmp);
+    SWAP_IFCOLTR(g.order,g.transb, kb,nb, tmp);
+    CHECK_INT_EQ("ka",ka,"kb",kb);
+    g.m = ma;
+    g.n = nb;
+    g.k = ka;
+#else
+    CHECK_SQUARE("a",na1); // ma == ka
+    SWAP_IFCOL(g.order, kb,nb, tmp);
+    // row major             L    R
+    //ma = ROW_SIZE(na1); // m or n
+    //ka = COL_SIZE(na1); // m or n (lda)
+    g.m = kb; // m
+    g.n = nb; // n (ldb)
+    if (g.side == CblasLeft) {
+        CHECK_SIZE_EQ(ka, g.m);
+    } else {
+        CHECK_SIZE_EQ(ka, g.n);
+    }
+#endif
+
+    SWAP_IFROW(g.order, ma,nb, tmp);
+
+#if TR
+    if (c != Qnil) {
+        rb_raise(rb_eArgError,"wrong number of arguments (3 for 2)");
+    }
+    COPY_OR_CAST_TO(b,cT);
+    ndf.nin = 2;
+
+    na_ndloop3(&ndf, &g, 2, a, b);
+    return b;
+#else
+
+    if (c == Qnil) { // c is not given.
+        ndfunc_arg_in_t ain_init = {sym_init,0};
+        ain[2] = ain_init;
+        ndf.nout = 1;
+        c = INT2FIX(0);
+        shape[0] = nb;
+        shape[1] = ma;
+    } else {
+        narray_t *na3;
+        int nc;
+        COPY_OR_CAST_TO(c,cT);
+        GetNArray(c,na3);
+        CHECK_DIM_GE(na3,2);
+        nc = ROW_SIZE(na3);
+        if (nc < nb) {
+            rb_raise(nary_eShapeError,"nc=%d must be >= nb=%d",nc,nb);
+        }
+        //CHECK_LEADING_GE("ldc",g.ldc,"m",ma);
+    }
+    {
+        VALUE ans = na_ndloop3(&ndf, &g, 3, a, b, c);
+
+        if (ndf.nout == 1) { // c is not given.
+            return ans;
+        } else {
+            return c;
+        }
+    }
+#endif
+}
+
+#undef func_p
+#undef args_t
+#undef GE
+#undef TR

data/ext/numo/linalg/blas/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/blas/tmpl/mv.c

@@ -0,0 +1,194 @@
+/*<%
+  is_ge = (/^.ge/ =~ name)
+  is_tr = (/^.tr/ =~ name)
+%>*/
+<% %>
+#define GE <%= is_ge ? "1":"0" %>
+#define TR <%= is_tr ? "1":"0" %>
+#define args_t <%=name%>_args_t
+
+typedef struct {
+  enum CBLAS_ORDER order;
+  enum CBLAS_TRANSPOSE trans;
+  enum CBLAS_UPLO uplo;
+  enum CBLAS_DIAG diag;
+  dtype alpha, beta;
+  blasint m, n;
+} args_t;
+
+#define func_p <%=func_name%>_p
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    dtype *a;
+    char *p1;
+    ssize_t s1;
+#if !TR
+    char *p2;
+    ssize_t s2;
+#endif
+#if !GE
+    int n;
+#endif
+    int lda;
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    INIT_PTR(lp,1,p1,s1);
+#if !TR
+    INIT_PTR(lp,2,p2,s2);
+#endif
+    g = (args_t*)(lp->opt_ptr);
+
+#if !GE
+    n = NDL_SHAPE(lp,0)[1];
+#endif
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+
+#if GE
+    (*func_p)( g->order, g->trans, g->m, g->n,
+        DP(g->alpha), a, lda, (dtype*)p1, s1/sizeof(dtype),
+        DP(g->beta), (dtype*)p2, s2/sizeof(dtype) );
+#elif TR
+    (*func_p)( g->order, g->uplo, g->trans, g->diag, n, a, lda,
+        (dtype*)p1, s1/sizeof(dtype) );
+#else // SY,HE
+    (*func_p)( g->order, g->uplo, n,
+        DP(g->alpha), a, lda, (dtype*)p1, s1/sizeof(dtype),
+        DP(g->beta), (dtype*)p2, s2/sizeof(dtype) );
+#endif
+}
+
+/*<%
+ args_v =
+   if is_ge
+    "a, x, [y, alpha:1, beta:0, trans:'N'"
+   elsif is_tr
+    "a, x, [uplo:'U', trans:'N', diag:'U'"
+   else
+    "a, x, [y, alpha:1, beta:0, uplo:'U'"
+   end + ", order:'R'"
+ params = [
+   mat("a"),
+   vec("x"),
+   !is_tr && vec("y","optional",:inplace),
+   opt("alpha"),
+   opt("beta"),
+   !is_ge && opt("side"),
+   !is_ge && opt("uplo"),
+   is_ge || is_tr && opt("trans"),
+   opt("order")
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>(<%=args_v%>)
+  <%=params%>
+  @return [<%=class_name%>] returns y = alpha*op(A)\*x + beta\*y.
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     a, x, y=Qnil, alpha, beta;
+    narray_t *na1, *na2;
+    blasint   ma, na, nx;
+#if GE
+    blasint   tmp;
+#endif
+    size_t    shape[1];
+    ndfunc_arg_in_t ain[4] = {{cT,2},{cT,1},{OVERWRITE,1},{sym_init,0}};
+    ndfunc_arg_out_t aout[1] = {{cT,1,shape}};
+    ndfunc_t ndf = {<%=c_iter%>, NO_LOOP, 3, 0, ain, aout};
+
+    args_t g;
+    VALUE kw_hash = Qnil;
+#if GE
+    ID kw_table[4] = {id_alpha,id_beta,id_order,id_trans};
+#elif TR
+    ID kw_table[6] = {id_alpha,id_beta,id_order,id_uplo,id_trans,id_diag};
+#else
+    ID kw_table[4] = {id_alpha,id_beta,id_order,id_uplo};
+#endif
+    VALUE opts[6] = {Qundef,Qundef,Qundef,Qundef,Qundef,Qundef};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "21:", &a, &x, &y, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 4+2*TR, opts);
+    alpha   = option_value(opts[0],Qnil);
+    g.alpha = RTEST(alpha) ? m_num_to_data(alpha) : m_one;
+    beta    = option_value(opts[1],Qnil);
+    g.beta  = RTEST(beta)  ? m_num_to_data(beta)  : m_zero;
+    g.order = option_order(opts[2]);
+#if GE
+    g.trans = option_trans(opts[3]);
+#else
+    g.uplo  = option_uplo(opts[3]);
+#endif
+#if TR
+    g.trans = option_trans(opts[4]);
+    g.diag  = option_diag(opts[5]);
+#endif
+
+    GetNArray(a,na1);
+    CHECK_DIM_GE(na1,2);
+    ma = ROW_SIZE(na1);
+    na = COL_SIZE(na1);
+
+    GetNArray(x,na2);
+    CHECK_DIM_GE(na2,1);
+    nx = COL_SIZE(na2);
+#if GE
+    SWAP_IFCOLTR(g.order,g.trans, ma,na, tmp);
+    g.m = ma;
+    g.n = na;
+#else
+    CHECK_SQUARE("a",na1);
+#endif
+    CHECK_INT_EQ("na",na,"nx",nx);
+    shape[0] = ma;
+
+#if TR
+    if (y != Qnil) {
+        rb_raise(rb_eArgError,"wrong number of arguments (3 for 2)");
+    }
+    COPY_OR_CAST_TO(x,cT);
+    ndf.nin = 2;
+    na_ndloop3(&ndf, &g, 2, a, x);
+    return x;
+
+#else // GE,SY,HE
+
+    if (y == Qnil) { // c is not given.
+        ndf.nout = 1;
+        ain[2] = ain[3];
+        y = INT2FIX(0);
+        shape[0] = ma;
+    } else {
+        narray_t *na3;
+        COPY_OR_CAST_TO(y,cT);
+        GetNArray(y,na3);
+        CHECK_DIM_GE(na3,1);
+        CHECK_SIZE_GE(na3,nx);
+    }
+    {
+        VALUE ans;
+        ans = na_ndloop3(&ndf, &g, 3, a, x, y);
+
+        if (ndf.nout == 1) { // c is not given.
+            return ans;
+        } else {
+            return y;
+        }
+    }
+#endif
+}
+
+#undef func_p
+#undef args_t
+#undef GE
+#undef TR

data/ext/numo/linalg/blas/tmpl/nrm2.c

@@ -0,0 +1,79 @@
+#define func_p <%=func_name%>_p
+
+static <%=func_name%>_t func_p = 0;
+
+#undef result_dtype
+#define result_dtype <%=result_dtype%>
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    char *p1, *p2;
+    size_t n;
+    ssize_t s1;
+
+    INIT_PTR(lp,0,p1,s1);
+    p2 = NDL_PTR(lp,1);
+    n  = NDL_SHAPE(lp,0)[0];
+
+    *(result_dtype*)p2 = (*func_p)(n, (dtype*)p1, s1/sizeof(dtype));
+}
+
+/*
+<%
+ case name
+ when /^dz/
+   arg_class = "Numo::DComplex"
+   retT = "cRT"
+ when /^sc/
+   arg_class = "Numo::SComplex"
+   retT = "cRT"
+ else
+   arg_class = class_name
+   retT = "cT"
+ end
+ params = [
+   vec("x",type:arg_class),
+   opt("keepdims"),
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( x )
+  <%=params%>
+  @return [<%=class_name%>] euclidean norm of x
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     x, keepdims, ans;
+    narray_t *na1;
+    ndfunc_arg_in_t ain[1] = {{cT,1}};
+    ndfunc_arg_out_t aout[1] = {{<%=retT%>,0}};
+    ndfunc_t ndf = {<%=c_iter%>, NDF_EXTRACT, 1,1, ain,aout};
+
+    VALUE opts[1] = {Qundef};
+    ID    kw_table[1] = {id_keepdims};
+    VALUE kw_hash = Qnil;
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "1:", &x, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 1, opts);
+    keepdims = option_value(opts[0],Qfalse);
+
+    if (RTEST(keepdims)) {
+        ndf.flag |= NDF_KEEP_DIM;
+    }
+
+    GetNArray(x,na1);
+    CHECK_DIM_GE(na1,1);
+    CHECK_NON_EMPTY(na1);
+
+    ans = na_ndloop(&ndf, 1, x);
+
+    return ans;
+}
+
+#undef func_p