numo-linalg 0.0.1

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

@@ -0,0 +1,110 @@
+#define args_t <%=name%>_args_t
+
+typedef struct {
+    enum CBLAS_ORDER order;
+    enum CBLAS_UPLO uplo;
+    dtype alpha;
+} 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, *p2;
+    ssize_t s1, s2;
+    args_t *g;
+    blasint n, lda;
+
+    INIT_PTR(lp,0,p1,s1);
+    INIT_PTR(lp,1,p2,s2);
+    a = (dtype*)NDL_PTR(lp,2);
+    g = (args_t*)(lp->opt_ptr);
+
+    n = NDL_SHAPE(lp,0)[0];
+    lda = NDL_STEP(lp,2) / sizeof(dtype);
+
+    (*func_p)(g->order, g->uplo, n,
+              DP(g->alpha), (dtype*)p1, s1/sizeof(dtype),
+              (dtype*)p2, s2/sizeof(dtype), a, lda);
+}
+
+/*<%
+ params = [
+   vec("x"),
+   vec("y"),
+   mat("a",:inplace),
+   opt("alpha"),
+   opt("uplo"),
+   opt("order")
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( x, y, [a, alpha:1, uplo:'U', order:'R'] )
+  <%=params%>
+  @return [<%=class_name%>] returns a.
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     ans;
+    VALUE     x, y, a, alpha;
+    narray_t *na1, *na2, *na3;
+    blasint   nx, ny, na;
+    size_t    shape[2];
+    ndfunc_arg_in_t ain[4] = {{cT,1},{cT,1},{OVERWRITE,2},{sym_init,0}};
+    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;
+    ID kw_table[3] = {id_alpha,id_order,id_uplo};
+    VALUE opts[3] = {Qundef,Qundef,Qundef};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "21:", &x, &y, &a, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 3, opts);
+    alpha   = option_value(opts[0],Qnil);
+    g.alpha = RTEST(alpha) ? m_num_to_data(alpha) : m_one;
+    g.order = option_order(opts[1]);
+    g.uplo  = option_uplo(opts[2]);
+
+    GetNArray(x,na1);
+    GetNArray(y,na2);
+    CHECK_DIM_GE(na1,1);
+    CHECK_DIM_GE(na2,1);
+    nx = COL_SIZE(na1); // n
+    ny = COL_SIZE(na2); // n
+    CHECK_INT_EQ("nx",nx,"ny",ny);
+
+    if (a == Qnil) { // c is not given.
+        ndf.nout = 1;
+        ain[2] = ain[3];
+        a = INT2FIX(0);
+        shape[0] = shape[1] = nx;
+    } else {
+        COPY_OR_CAST_TO(a,cT);
+        GetNArray(a,na3);
+        CHECK_DIM_GE(na3,2);
+        CHECK_SQUARE("a",na3);
+        na = COL_SIZE(na3); // n (lda)
+        CHECK_SIZE_EQ(na,nx);
+    }
+
+    ans = na_ndloop3(&ndf, &g, 3, x, y, a);
+
+    if (ndf.nout == 1) { // a is not given.
+        return ans;
+    } else {
+        return a;
+    }
+}
+
+#undef func_p
+#undef args_t

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

@@ -0,0 +1,129 @@
+#define args_t <%=name%>_args_t
+
+typedef struct {
+    enum CBLAS_ORDER order;
+    enum CBLAS_UPLO uplo;
+    enum CBLAS_TRANSPOSE trans;
+    dtype alpha, beta;
+    blasint 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, *c;
+    blasint lda, ldb, ldc;
+    args_t *g;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    b = (dtype*)NDL_PTR(lp,1);
+    c = (dtype*)NDL_PTR(lp,2);
+    g = (args_t*)(lp->opt_ptr);
+
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+    ldb = NDL_STEP(lp,1) / sizeof(dtype);
+    ldc = NDL_STEP(lp,2) / sizeof(dtype);
+
+    (*func_p)(g->order, g->uplo, g->trans, g->n, g->k,
+              DP(g->alpha), a, lda, b, ldb, DP(g->beta), c, ldc);
+}
+
+/*<%
+ params = [
+   mat("a","n-by-k"),
+   mat("b","n-by-k"),
+   mat("c","n-by-n, optional",:inpace),
+   opt("alpha"),
+   opt("beta"),
+   opt("uplo"),
+   opt("trans"),
+   opt("order")
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( a, b, [c, alpha:1, beta:0, uplo:'U', trans:'N', order:'R'] )
+  <%=params%>
+  @return [<%=class_name%>] returns c.
+
+<%=description%>
+
+ */
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     ans;
+    VALUE     a, b, c=Qnil, alpha, beta;
+    narray_t *na1, *na2, *na3;
+    blasint   na, ka, kb, nb, nc, tmp;
+    size_t    shape[2];
+    ndfunc_arg_in_t ain[4] = {{cT,2},{cT,2},{OVERWRITE,2},{sym_init,0}};
+    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;
+    ID kw_table[5] = {id_alpha,id_beta,id_order,id_uplo,id_trans};
+    VALUE opts[5] = {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, 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]);
+    g.uplo   = option_uplo(opts[3]);
+    g.trans  = option_trans(opts[4]);
+
+    GetNArray(a,na1);
+    GetNArray(b,na2);
+    CHECK_DIM_GE(na1,2);
+    CHECK_DIM_GE(na2,2);
+
+    na = ROW_SIZE(na1); // n
+    ka = COL_SIZE(na1); // k (lda)
+    SWAP_IFCOLTR(g.order, g.trans, na, ka, tmp);
+
+    nb = ROW_SIZE(na2); // n
+    kb = COL_SIZE(na2); // k (ldb)
+    SWAP_IFCOLTR(g.order, g.trans, kb, nb, tmp);
+    CHECK_INT_EQ("na",na,"nb",nb);
+    CHECK_INT_EQ("ka",ka,"kb",kb);
+    g.n = nb;
+    g.k = kb;
+
+    SWAP_IFROW(g.order, na, nb, tmp);
+
+    if (c == Qnil) { // c is not given.
+        ndf.nout = 1;
+        ain[2] = ain[3];
+        c = INT2FIX(0);
+        shape[0] = nb;
+        shape[1] = na;
+    } else {
+        COPY_OR_CAST_TO(c,cT);
+        GetNArray(c,na3);
+        CHECK_DIM_GE(na3,2);
+        nc = ROW_SIZE(na3); // n
+        if (nc < nb) {
+            rb_raise(nary_eShapeError,"nc=%d must be >= nb=%d",nc,nb);
+        }
+        //CHECK_LEADING_GE("ldc",g.ldc,"n",na);
+    }
+
+    ans = na_ndloop3(&ndf, &g, 3, a, b, c);
+
+    if (ndf.nout = 1) { // c is not given.
+        return ans;
+    } else {
+        return c;
+    }
+}
+
+#undef func_p
+#undef args_t

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

@@ -0,0 +1,132 @@
+/*<%
+is_he = (/^.he/=~name)
+stype = is_he ? "rtype" : "dtype"
+%>*/
+<% if is_he %>
+#define P(a) (a)
+<% else %>
+#define P(a) DP(a)
+<% end %>
+
+#define args_t <%=name%>_args_t
+
+typedef struct {
+    enum CBLAS_ORDER order;
+    enum CBLAS_UPLO uplo;
+    enum CBLAS_TRANSPOSE trans;
+    <%=stype%> alpha, beta;
+    blasint 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, *c;
+    args_t *g;
+    blasint lda, ldc;
+
+    a = (dtype*)NDL_PTR(lp,0);
+    c = (dtype*)NDL_PTR(lp,1);
+    g = (args_t*)(lp->opt_ptr);
+
+    lda = NDL_STEP(lp,0) / sizeof(dtype);
+    ldc = NDL_STEP(lp,1) / sizeof(dtype);
+
+    (*func_p)(g->order, g->uplo, g->trans, g->n, g->k,
+              P(g->alpha), a, lda, P(g->beta), c, ldc);
+}
+
+/*<%
+ params = [
+   mat("a","n-by-k",:inpace),
+   mat("c","n-by-n, optional",:inpace),
+   opt("alpha"),
+   opt("beta"),
+   opt("uplo"),
+   opt("trans"),
+   opt("order")
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( a, [c, alpha:1, beta:0, uplo:'U', trans:'N', order:'R'] )
+  <%=params%>
+  @return [<%=class_name%>] returns c.
+
+<%=description%>
+
+ */
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     ans;
+    VALUE     a, c, alpha, beta;
+    narray_t *na1, *na3;
+    blasint   na, ka, nc, tmp;
+    size_t    shape[2];
+    ndfunc_arg_in_t ain[3] = {{cT,2},{OVERWRITE,2},{sym_init,0}};
+    ndfunc_arg_out_t aout[1] = {{cT,2,shape}};
+    ndfunc_t ndf = {<%=c_iter%>, NO_LOOP, 2, 0, ain, aout};
+
+    args_t g;
+    VALUE kw_hash = Qnil;
+    ID kw_table[5] = {id_alpha,id_beta,id_order,id_uplo,id_trans};
+    VALUE opts[5] = {Qundef,Qundef,Qundef,Qundef,Qundef};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "11:", &a, &c, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 5, opts);
+    alpha   = option_value(opts[0],Qnil);
+    beta    = option_value(opts[1],Qnil);
+<% if is_he %>
+    g.alpha = RTEST(alpha) ? DBL2NUM(alpha) : 1;
+    g.beta  = RTEST(beta)  ? DBL2NUM(beta)  : 0;
+<% else %>
+    g.alpha = RTEST(alpha) ? m_num_to_data(alpha) : m_one;
+    g.beta  = RTEST(beta)  ? m_num_to_data(beta)  : m_zero;
+<% end %>
+    g.order = option_order(opts[2]);
+    g.uplo  = option_uplo(opts[3]);
+    g.trans = option_trans(opts[4]);
+
+    GetNArray(a,na1);
+    CHECK_DIM_GE(na1,2);
+
+    na = ROW_SIZE(na1); // n
+    ka = COL_SIZE(na1); // k (lda)
+    SWAP_IFCOLTR(g.order,g.trans, na,ka, tmp);
+    g.n = na;
+    g.k = ka;
+
+    if (c == Qnil) { // c is not given.
+        ndf.nout = 1;
+        ain[1] = ain[2];
+        c = INT2FIX(0);
+        shape[0] = na;
+        shape[1] = na;
+    } else {
+        COPY_OR_CAST_TO(c,cT);
+        GetNArray(c,na3);
+        CHECK_DIM_GE(na3,2);
+        nc = ROW_SIZE(na3);
+        if (nc < na) {
+            rb_raise(nary_eShapeError,"nc=%d must be >= na=%d",nc,na);
+        }
+        //CHECK_LEADING_GE("ldc",g.ldc,"n",na);
+    }
+
+    ans = na_ndloop3(&ndf, &g, 2, a, c);
+
+    if (ndf.nout == 1) { // c is not given.
+        return ans;
+    } else {
+        return c;
+    }
+}
+
+#undef func_p
+#undef args_t
+#undef P

data/ext/numo/linalg/lapack/depend.erb

@@ -0,0 +1,23 @@
+COGEN=ruby gen/cogen.rb -l
+GENDEPS=gen/*.rb tmpl/*.c
+
+<%
+srcs = %w[s d c z].map{|c| [c, "lapack_#{c}.c"]}
+srcs.each do |c,s|
+%>
+<%=s%>: $(GENDEPS)
+	$(COGEN) -o $@ <%=c%>
+<% end %>
+
+GENSRC=<%= srcs.map{|x| x[1]}.join(" ") %>
+
+src : lapack.c $(GENSRC)
+
+doc : $(GENSRC)
+	yard doc -m markdown $(GENSRC)
+
+clean: cleansrc cleandoc
+cleansrc:
+	-$(Q)$(RM) $(GENSRC)
+cleandoc:
+	-$(Q)$(RM_RF) doc .yardoc

data/ext/numo/linalg/lapack/extconf.rb

@@ -0,0 +1,45 @@
+require 'mkmf'
+require 'numo/narray'
+require 'erb'
+
+$LOAD_PATH.each do |x|
+  if File.exist? File.join(x,'numo/numo/narray.h')
+    $INCFLAGS = "-I#{x}/numo " + $INCFLAGS
+    break
+  end
+end
+
+srcs = %w(
+lapack
+lapack_s
+lapack_d
+lapack_c
+lapack_z
+)
+$objs = srcs.collect{|i| i+".o"}
+
+if !have_header('numo/narray.h')
+  puts "
+  Header numo/narray.h was not found. Give pathname as follows:
+  % ruby extconf.rb --with-narray-include=narray_h_dir"
+  exit(1)
+end
+
+if have_header("dlfcn.h")
+  exit(1) unless have_library("dl")
+  exit(1) unless have_func("dlopen")
+elsif have_header("windows.h")
+  exit(1) unless have_func("LoadLibrary")
+end
+
+dep_path = File.join(__dir__, "depend")
+File.open(dep_path, "w") do |dep|
+  dep_erb_path = File.join(__dir__, "depend.erb")
+  File.open(dep_erb_path, "r") do |dep_erb|
+    erb = ERB.new(dep_erb.read)
+    erb.filename = dep_erb_path
+    dep.print(erb.result)
+  end
+end
+
+create_makefile('numo/linalg/lapack')

data/ext/numo/linalg/lapack/gen/cogen.rb

@@ -0,0 +1,74 @@
+#! /usr/bin/env ruby
+
+pwd = File.dirname(__FILE__)
+#libpath = File.absolute_path(File.dirname(__FILE__))+"/../../../../lib"
+#$LOAD_PATH.unshift libpath
+
+require_relative "../../blas/gen/decl"
+
+while true
+  if ARGV[0] == "-l"
+    require "erbpp/line_number"
+    ARGV.shift
+  elsif ARGV[0] == "-o"
+    ARGV.shift
+    $output = ARGV.shift
+    require "fileutils"
+    FileUtils.rm_f($output)
+  else
+    break
+  end
+end
+
+if ARGV.size != 1
+  puts "usage:\n  ruby #{$0} [-l] blas_char"
+  exit 1
+end
+
+blas_char = ARGV[0]
+
+erb_dir = ["../tmpl"]
+erb_dir.map!{|d| File.join(pwd,d)}
+
+code = DefLib.new do
+  set erb_dir: erb_dir
+  set erb_suffix: ".c"
+  set ns_var: "mN"
+
+  set file_name: $output || ""
+  #set include_files: ["numo/types/#{type_name}.h"]
+  set lib_name: "numo_linalg_lapack_"+blas_char
+
+  def_module do
+    mname = "Linalg"
+    mbase = mname.downcase
+    set name: mbase
+    set module_name: mname
+    set module_var: "m"+mname
+    set full_module_name: "Numo::"+mname
+
+    def_module do
+      extend Decl
+      name = "Lapack"
+      base = name.downcase
+      set ns_var: "m"+mname
+      set name: base
+      set module_name: name
+      set module_var: "m"+name
+      set full_module_name: "Numo::Linalg::"+name
+      set module_desc: eval(File.read(File.join(pwd,"desc.rb")))
+
+      DefError.new(self,"LapackError","rb_eStandardError");
+
+      ErbPP.new(self,"def_"+blas_char)
+      set blas_char: blas_char
+      eval File.read(File.join(pwd,"spec.rb")), binding, "spec.rb"
+    end
+  end
+end.result
+
+if $output
+  open($output,"w").write(code)
+else
+  $stdout.write(code)
+end