numo-linalg-alt 0.2.0

data/ext/numo/linalg/blas/gemv.c

@@ -0,0 +1,161 @@
+#include "gemv.h"
+
+#define DEF_LINALG_OPTIONS(tDType) \
+  struct _gemv_options_##tDType {  \
+    tDType alpha;                  \
+    tDType beta;                   \
+    enum CBLAS_ORDER order;        \
+    enum CBLAS_TRANSPOSE trans;    \
+    blasint m;                     \
+    blasint n;                     \
+  };
+
+#define DEF_LINALG_ITER_FUNC(tDType, fBlasFunc)                                               \
+  static void _iter_##fBlasFunc(na_loop_t* const lp) {                                        \
+    const tDType* a = (tDType*)NDL_PTR(lp, 0);                                                \
+    const tDType* x = (tDType*)NDL_PTR(lp, 1);                                                \
+    tDType* y = (tDType*)NDL_PTR(lp, 2);                                                      \
+    const struct _gemv_options_##tDType* opt = (struct _gemv_options_##tDType*)(lp->opt_ptr); \
+    const blasint lda = opt->n;                                                               \
+    cblas_##fBlasFunc(opt->order, opt->trans, opt->m, opt->n,                                 \
+                      opt->alpha, a, lda, x, 1, opt->beta, y, 1);                             \
+  }
+
+#define DEF_LINALG_ITER_FUNC_COMPLEX(tDType, fBlasFunc)                                       \
+  static void _iter_##fBlasFunc(na_loop_t* const lp) {                                        \
+    const tDType* a = (tDType*)NDL_PTR(lp, 0);                                                \
+    const tDType* x = (tDType*)NDL_PTR(lp, 1);                                                \
+    tDType* y = (tDType*)NDL_PTR(lp, 2);                                                      \
+    const struct _gemv_options_##tDType* opt = (struct _gemv_options_##tDType*)(lp->opt_ptr); \
+    const blasint lda = opt->n;                                                               \
+    cblas_##fBlasFunc(opt->order, opt->trans, opt->m, opt->n,                                 \
+                      &opt->alpha, a, lda, x, 1, &opt->beta, y, 1);                           \
+  }
+
+#define DEF_LINALG_FUNC(tDType, tNAryClass, fBlasFunc)                                                  \
+  static VALUE _linalg_blas_##fBlasFunc(int argc, VALUE* argv, VALUE self) {                            \
+    VALUE a = Qnil;                                                                                     \
+    VALUE x = Qnil;                                                                                     \
+    VALUE y = Qnil;                                                                                     \
+    VALUE kw_args = Qnil;                                                                               \
+    rb_scan_args(argc, argv, "21:", &a, &x, &y, &kw_args);                                              \
+                                                                                                        \
+    ID kw_table[4] = { rb_intern("alpha"), rb_intern("beta"),                                           \
+                       rb_intern("order"), rb_intern("trans") };                                        \
+    VALUE kw_values[4] = { Qundef, Qundef, Qundef, Qundef };                                            \
+    rb_get_kwargs(kw_args, kw_table, 0, 4, kw_values);                                                  \
+                                                                                                        \
+    if (CLASS_OF(a) != tNAryClass) {                                                                    \
+      a = rb_funcall(tNAryClass, rb_intern("cast"), 1, a);                                              \
+    }                                                                                                   \
+    if (!RTEST(nary_check_contiguous(a))) {                                                             \
+      a = nary_dup(a);                                                                                  \
+    }                                                                                                   \
+    if (CLASS_OF(x) != tNAryClass) {                                                                    \
+      x = rb_funcall(tNAryClass, rb_intern("cast"), 1, x);                                              \
+    }                                                                                                   \
+    if (!RTEST(nary_check_contiguous(x))) {                                                             \
+      x = nary_dup(x);                                                                                  \
+    }                                                                                                   \
+    if (!NIL_P(y)) {                                                                                    \
+      if (CLASS_OF(y) != tNAryClass) {                                                                  \
+        y = rb_funcall(tNAryClass, rb_intern("cast"), 1, y);                                            \
+      }                                                                                                 \
+      if (!RTEST(nary_check_contiguous(y))) {                                                           \
+        y = nary_dup(y);                                                                                \
+      }                                                                                                 \
+    }                                                                                                   \
+                                                                                                        \
+    tDType alpha = kw_values[0] != Qundef ? conv_##tDType(kw_values[0]) : one_##tDType();               \
+    tDType beta = kw_values[1] != Qundef ? conv_##tDType(kw_values[1]) : zero_##tDType();               \
+    enum CBLAS_ORDER order = kw_values[2] != Qundef ? get_cblas_order(kw_values[2]) : CblasRowMajor;    \
+    enum CBLAS_TRANSPOSE trans = kw_values[3] != Qundef ? get_cblas_trans(kw_values[3]) : CblasNoTrans; \
+                                                                                                        \
+    narray_t* a_nary = NULL;                                                                            \
+    GetNArray(a, a_nary);                                                                               \
+    narray_t* x_nary = NULL;                                                                            \
+    GetNArray(x, x_nary);                                                                               \
+                                                                                                        \
+    if (NA_NDIM(a_nary) != 2) {                                                                         \
+      rb_raise(rb_eArgError, "a must be 2-dimensional");                                                \
+      return Qnil;                                                                                      \
+    }                                                                                                   \
+    if (NA_NDIM(x_nary) != 1) {                                                                         \
+      rb_raise(rb_eArgError, "x must be 1-dimensional");                                                \
+      return Qnil;                                                                                      \
+    }                                                                                                   \
+    if (NA_SIZE(a_nary) == 0) {                                                                         \
+      rb_raise(rb_eArgError, "a must not be empty");                                                    \
+      return Qnil;                                                                                      \
+    }                                                                                                   \
+    if (NA_SIZE(x_nary) == 0) {                                                                         \
+      rb_raise(rb_eArgError, "x must not be empty");                                                    \
+      return Qnil;                                                                                      \
+    }                                                                                                   \
+                                                                                                        \
+    const blasint ma = (blasint)NA_SHAPE(a_nary)[0];                                                    \
+    const blasint na = (blasint)NA_SHAPE(a_nary)[1];                                                    \
+    const blasint mx = (blasint)NA_SHAPE(x_nary)[0];                                                    \
+    const blasint m = trans == CblasNoTrans ? ma : na;                                                  \
+    const blasint n = trans == CblasNoTrans ? na : ma;                                                  \
+                                                                                                        \
+    if (n != mx) {                                                                                      \
+      rb_raise(nary_eShapeError, "shape1[1](=%d) != shape2[0](=%d)", n, mx);                            \
+      return Qnil;                                                                                      \
+    }                                                                                                   \
+                                                                                                        \
+    struct _gemv_options_##tDType opt = { alpha, beta, order, trans, ma, na };                          \
+    size_t shape_out[1] = { (size_t)(m) };                                                              \
+    ndfunc_arg_out_t aout[1] = { { tNAryClass, 1, shape_out } };                                        \
+    VALUE ret = Qnil;                                                                                   \
+                                                                                                        \
+    if (!NIL_P(y)) {                                                                                    \
+      narray_t* y_nary = NULL;                                                                          \
+      GetNArray(y, y_nary);                                                                             \
+      blasint my = (blasint)NA_SHAPE(y_nary)[0];                                                        \
+      if (m > my) {                                                                                     \
+        rb_raise(nary_eShapeError, "shape3[0](=%d) >= shape1[0]=%d", my, m);                            \
+        return Qnil;                                                                                    \
+      }                                                                                                 \
+      ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { tNAryClass, 1 }, { OVERWRITE, 1 } };              \
+      ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP, 3, 0, ain, aout };                                   \
+      na_ndloop3(&ndf, &opt, 3, a, x, y);                                                               \
+      ret = y;                                                                                          \
+    } else {                                                                                            \
+      y = INT2NUM(0);                                                                                   \
+      ndfunc_arg_in_t ain[3] = { { tNAryClass, 2 }, { tNAryClass, 1 }, { sym_init, 0 } };               \
+      ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP, 3, 1, ain, aout };                                   \
+      ret = na_ndloop3(&ndf, &opt, 3, a, x, y);                                                         \
+    }                                                                                                   \
+                                                                                                        \
+    RB_GC_GUARD(a);                                                                                     \
+    RB_GC_GUARD(x);                                                                                     \
+    RB_GC_GUARD(y);                                                                                     \
+                                                                                                        \
+    return ret;                                                                                         \
+  }
+
+DEF_LINALG_OPTIONS(double)
+DEF_LINALG_OPTIONS(float)
+DEF_LINALG_OPTIONS(dcomplex)
+DEF_LINALG_OPTIONS(scomplex)
+DEF_LINALG_ITER_FUNC(double, dgemv)
+DEF_LINALG_ITER_FUNC(float, sgemv)
+DEF_LINALG_ITER_FUNC_COMPLEX(dcomplex, zgemv)
+DEF_LINALG_ITER_FUNC_COMPLEX(scomplex, cgemv)
+DEF_LINALG_FUNC(double, numo_cDFloat, dgemv)
+DEF_LINALG_FUNC(float, numo_cSFloat, sgemv)
+DEF_LINALG_FUNC(dcomplex, numo_cDComplex, zgemv)
+DEF_LINALG_FUNC(scomplex, numo_cSComplex, cgemv)
+
+#undef DEF_LINALG_OPTIONS
+#undef DEF_LINALG_ITER_FUNC
+#undef DEF_LINALG_ITER_FUNC_COMPLEX
+#undef DEF_LINALG_FUNC
+
+void define_linalg_blas_gemv(VALUE mBlas) {
+  rb_define_module_function(mBlas, "dgemv", RUBY_METHOD_FUNC(_linalg_blas_dgemv), -1);
+  rb_define_module_function(mBlas, "sgemv", RUBY_METHOD_FUNC(_linalg_blas_sgemv), -1);
+  rb_define_module_function(mBlas, "zgemv", RUBY_METHOD_FUNC(_linalg_blas_zgemv), -1);
+  rb_define_module_function(mBlas, "cgemv", RUBY_METHOD_FUNC(_linalg_blas_cgemv), -1);
+}

data/ext/numo/linalg/blas/gemv.h

@@ -0,0 +1,16 @@
+#ifndef NUMO_LINALG_ALT_BLAS_GEMV_H
+#define NUMO_LINALG_ALT_BLAS_GEMV_H 1
+
+#include <ruby.h>
+
+#include <cblas.h>
+
+#include <numo/narray.h>
+#include <numo/template.h>
+
+#include "../converter.h"
+#include "../util.h"
+
+void define_linalg_blas_gemv(VALUE mBlas);
+
+#endif /* NUMO_LINALG_ALT_BLAS_GEMV_H */

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

@@ -0,0 +1,67 @@
+#include "nrm2.h"
+
+#define DEF_LINALG_FUNC(tDType, tRtDType, tNAryClass, tRtNAryClass, fBlasFunc)    \
+  static void _iter_##fBlasFunc(na_loop_t* const lp) {                            \
+    tDType* x = (tDType*)NDL_PTR(lp, 0);                                          \
+    tRtDType* d = (tRtDType*)NDL_PTR(lp, 1);                                      \
+    const blasint n = (blasint)NDL_SHAPE(lp, 0)[0];                               \
+    tRtDType ret = cblas_##fBlasFunc(n, x, 1);                                    \
+    *d = ret;                                                                     \
+  }                                                                               \
+                                                                                  \
+  static VALUE _linalg_blas_##fBlasFunc(int argc, VALUE* argv, VALUE self) {      \
+    VALUE x = Qnil;                                                               \
+    VALUE kw_args = Qnil;                                                         \
+    rb_scan_args(argc, argv, "1:", &x, &kw_args);                                 \
+                                                                                  \
+    ID kw_table[1] = { rb_intern("keepdims") };                                   \
+    VALUE kw_values[1] = { Qundef };                                              \
+    rb_get_kwargs(kw_args, kw_table, 0, 1, kw_values);                            \
+    const bool keepdims = kw_values[0] != Qundef ? RTEST(kw_values[0]) : false;   \
+                                                                                  \
+    if (CLASS_OF(x) != tNAryClass) {                                              \
+      x = rb_funcall(tNAryClass, rb_intern("cast"), 1, x);                        \
+    }                                                                             \
+    if (!RTEST(nary_check_contiguous(x))) {                                       \
+      x = nary_dup(x);                                                            \
+    }                                                                             \
+                                                                                  \
+    narray_t* x_nary = NULL;                                                      \
+    GetNArray(x, x_nary);                                                         \
+                                                                                  \
+    if (NA_NDIM(x_nary) != 1) {                                                   \
+      rb_raise(rb_eArgError, "x must be 1-dimensional");                          \
+      return Qnil;                                                                \
+    }                                                                             \
+    if (NA_SIZE(x_nary) == 0) {                                                   \
+      rb_raise(rb_eArgError, "x must not be empty");                              \
+      return Qnil;                                                                \
+    }                                                                             \
+                                                                                  \
+    ndfunc_arg_in_t ain[1] = { { tNAryClass, 1 } };                               \
+    size_t shape_out[1] = { 1 };                                                  \
+    ndfunc_arg_out_t aout[1] = { { tRtNAryClass, 0, shape_out } };                \
+    ndfunc_t ndf = { _iter_##fBlasFunc, NO_LOOP | NDF_EXTRACT, 1, 1, ain, aout }; \
+    if (keepdims) {                                                               \
+      ndf.flag |= NDF_KEEP_DIM;                                                   \
+    }                                                                             \
+                                                                                  \
+    VALUE ret = na_ndloop(&ndf, 1, x);                                            \
+                                                                                  \
+    RB_GC_GUARD(x);                                                               \
+    return ret;                                                                   \
+  }
+
+DEF_LINALG_FUNC(double, double, numo_cDFloat, numo_cDFloat, dnrm2)
+DEF_LINALG_FUNC(float, float, numo_cSFloat, numo_cSFloat, snrm2)
+DEF_LINALG_FUNC(dcomplex, double, numo_cDComplex, numo_cDFloat, dznrm2)
+DEF_LINALG_FUNC(scomplex, float, numo_cSComplex, numo_cSFloat, scnrm2)
+
+#undef DEF_LINALG_FUNC
+
+void define_linalg_blas_nrm2(VALUE mBlas) {
+  rb_define_module_function(mBlas, "dnrm2", RUBY_METHOD_FUNC(_linalg_blas_dnrm2), -1);
+  rb_define_module_function(mBlas, "snrm2", RUBY_METHOD_FUNC(_linalg_blas_snrm2), -1);
+  rb_define_module_function(mBlas, "dznrm2", RUBY_METHOD_FUNC(_linalg_blas_dznrm2), -1);
+  rb_define_module_function(mBlas, "scnrm2", RUBY_METHOD_FUNC(_linalg_blas_scnrm2), -1);
+}

data/ext/numo/linalg/blas/nrm2.h

@@ -0,0 +1,13 @@
+#ifndef NUMO_LINALG_ALT_BLAS_NRM2_H
+#define NUMO_LINALG_ALT_BLAS_NRM2_H 1
+
+#include <ruby.h>
+
+#include <cblas.h>
+
+#include <numo/narray.h>
+#include <numo/template.h>
+
+void define_linalg_blas_nrm2(VALUE mBlas);
+
+#endif /* NUMO_LINALG_ALT_BLAS_NRM2_H */

data/ext/numo/linalg/converter.c

@@ -0,0 +1,67 @@
+#include "converter.h"
+
+double conv_double(VALUE val) {
+  return NUM2DBL(val);
+}
+
+double one_double(void) {
+  return 1.0;
+}
+
+double zero_double(void) {
+  return 0.0;
+}
+
+float conv_float(VALUE val) {
+  return (float)NUM2DBL(val);
+}
+
+float one_float(void) {
+  return 1.0f;
+}
+
+float zero_float(void) {
+  return 0.0f;
+}
+
+dcomplex conv_dcomplex(VALUE val) {
+  dcomplex z;
+  REAL(z) = NUM2DBL(rb_funcall(val, rb_intern("real"), 0));
+  IMAG(z) = NUM2DBL(rb_funcall(val, rb_intern("imag"), 0));
+  return z;
+}
+
+dcomplex one_dcomplex(void) {
+  dcomplex z;
+  REAL(z) = 1.0;
+  IMAG(z) = 0.0;
+  return z;
+}
+
+dcomplex zero_dcomplex(void) {
+  dcomplex z;
+  REAL(z) = 0.0;
+  IMAG(z) = 0.0;
+  return z;
+}
+
+scomplex conv_scomplex(VALUE val) {
+  scomplex z;
+  REAL(z) = (float)NUM2DBL(rb_funcall(val, rb_intern("real"), 0));
+  IMAG(z) = (float)NUM2DBL(rb_funcall(val, rb_intern("imag"), 0));
+  return z;
+}
+
+scomplex one_scomplex(void) {
+  scomplex z;
+  REAL(z) = 1.0f;
+  IMAG(z) = 0.0f;
+  return z;
+}
+
+scomplex zero_scomplex(void) {
+  scomplex z;
+  REAL(z) = 0.0f;
+  IMAG(z) = 0.0f;
+  return z;
+}

data/ext/numo/linalg/converter.h

@@ -0,0 +1,23 @@
+#ifndef NUMO_LINALG_ALT_CONVERTER_H
+#define NUMO_LINALG_ALT_CONVERTER_H 1
+
+#include <ruby.h>
+
+#include <cblas.h>
+
+#include <numo/narray.h>
+
+double conv_double(VALUE val);
+double one_double(void);
+double zero_double(void);
+float conv_float(VALUE val);
+float one_float(void);
+float zero_float(void);
+dcomplex conv_dcomplex(VALUE val);
+dcomplex one_dcomplex(void);
+dcomplex zero_dcomplex(void);
+scomplex conv_scomplex(VALUE val);
+scomplex one_scomplex(void);
+scomplex zero_scomplex(void);
+
+#endif /* NUMO_LINALG_ALT_CONVERTER_H */

data/ext/numo/linalg/extconf.rb

@@ -0,0 +1,99 @@
+# frozen_string_literal: true
+
+require 'mkmf'
+require 'numo/narray'
+require 'open-uri'
+require 'etc'
+require 'fileutils'
+require 'open3'
+require 'digest/md5'
+require 'rubygems/package'
+
+$LOAD_PATH.each do |lp|
+  if File.exist?(File.join(lp, 'numo/numo/narray.h'))
+    $INCFLAGS = "-I#{lp}/numo #{$INCFLAGS}"
+    break
+  end
+end
+
+abort 'numo/narray.h is not found' unless have_header('numo/narray.h')
+
+on_windows = RUBY_PLATFORM.match?(/mswin|cygwin|mingw/)
+
+if on_windows
+  $LOAD_PATH.each do |lp|
+    if File.exist?(File.join(lp, 'numo/libnarray.a'))
+      $LDFLAGS = "-L#{lp}/numo #{$LDFLAGS}"
+      break
+    end
+  end
+  abort 'libnarray.a is not found' unless have_library('narray', 'nary_new')
+end
+
+build_openblas = false
+unless find_library('openblas', 'LAPACKE_dsyevr')
+  build_openblas = true unless have_library('openblas')
+  build_openblas = true unless have_library('lapacke')
+end
+build_openblas = true unless have_header('cblas.h')
+build_openblas = true unless have_header('lapacke.h')
+build_openblas = true unless have_header('openblas_config.h')
+
+if build_openblas
+  warn 'BLAS and LAPACKE APIs are not found. Downloading and Building OpenBLAS...'
+
+  VENDOR_DIR = File.expand_path("#{__dir__}/../../../vendor")
+  LINALG_DIR = File.expand_path("#{__dir__}/../../../lib/numo/linalg")
+  OPENBLAS_VER = '0.3.30'
+  OPENBLAS_KEY = '8db3d57f4d4485c6ae3f21ea465660e7'
+  OPENBLAS_URI = "https://github.com/OpenMathLib/OpenBLAS/archive/v#{OPENBLAS_VER}.tar.gz"
+  OPENBLAS_TGZ = "#{VENDOR_DIR}/tmp/openblas.tgz"
+
+  unless File.exist?("#{VENDOR_DIR}/installed_#{OPENBLAS_VER}")
+    URI.parse(OPENBLAS_URI).open { |f| File.binwrite(OPENBLAS_TGZ, f.read) }
+    abort('MD5 digest of downloaded OpenBLAS does not match.') if Digest::MD5.file(OPENBLAS_TGZ).to_s != OPENBLAS_KEY
+
+    Gem::Package::TarReader.new(Zlib::GzipReader.open(OPENBLAS_TGZ)) do |tar|
+      tar.each do |entry|
+        next unless entry.file?
+
+        filename = "#{VENDOR_DIR}/tmp/#{entry.full_name}"
+        next if filename == File.dirname(filename)
+
+        FileUtils.mkdir_p("#{VENDOR_DIR}/tmp/#{File.dirname(entry.full_name)}")
+        File.binwrite(filename, entry.read)
+        File.chmod(entry.header.mode, filename)
+      end
+    end
+
+    Dir.chdir("#{VENDOR_DIR}/tmp/OpenBLAS-#{OPENBLAS_VER}") do
+      mkstdout, _mkstderr, mkstatus = Open3.capture3("make -j#{Etc.nprocessors} shared")
+      File.open("#{VENDOR_DIR}/tmp/openblas.log", 'w') { |f| f.puts(mkstdout) }
+      abort("Failed to build OpenBLAS. Check the openblas.log file for more details: #{VENDOR_DIR}/tmp/openblas.log") unless mkstatus.success?
+
+      insstdout, _insstderr, insstatus = Open3.capture3("make install PREFIX=#{VENDOR_DIR}")
+      File.open("#{VENDOR_DIR}/tmp/openblas.log", 'a') { |f| f.puts(insstdout) }
+      abort("Failed to install OpenBLAS. Check the openblas.log file for more details: #{VENDOR_DIR}/tmp/openblas.log") unless insstatus.success?
+
+      FileUtils.cp("#{VENDOR_DIR}/lib/libopenblas.a", LINALG_DIR) if on_windows
+
+      FileUtils.touch("#{VENDOR_DIR}/installed_#{OPENBLAS_VER}")
+    end
+  end
+
+  abort('libopenblas is not found.') unless find_library('openblas', nil, "#{VENDOR_DIR}/lib")
+  abort('openblas_config.h is not found.') unless find_header('openblas_config.h', nil, "#{VENDOR_DIR}/include")
+  abort('cblas.h is not found.') unless find_header('cblas.h', nil, "#{VENDOR_DIR}/include")
+  abort('lapacke.h is not found.') unless find_header('lapacke.h', nil, "#{VENDOR_DIR}/include")
+end
+
+if RUBY_PLATFORM.include?('darwin') && Gem::Version.new('3.1.0') <= Gem::Version.new(RUBY_VERSION) &&
+   try_link('int main(void){return 0;}', '-Wl,-undefined,dynamic_lookup')
+  $LDFLAGS << ' -Wl,-undefined,dynamic_lookup'
+end
+
+$srcs = Dir.glob("#{$srcdir}/**/*.c").map { |path| File.basename(path) }
+$VPATH << '$(srcdir)/blas'
+$VPATH << '$(srcdir)/lapack'
+
+create_makefile('numo/linalg/linalg')

data/ext/numo/linalg/lapack/geev.c

@@ -0,0 +1,152 @@
+#include "geev.h"
+
+struct _geev_option {
+  int matrix_layout;
+  char jobvl;
+  char jobvr;
+};
+
+char _get_jobvl(VALUE val) {
+  const char jobvl = NUM2CHR(val);
+  if (jobvl != 'N' && jobvl != 'V') {
+    rb_raise(rb_eArgError, "jobvl must be 'N' or 'V'");
+  }
+  return jobvl;
+}
+
+char _get_jobvr(VALUE val) {
+  const char jobvr = NUM2CHR(val);
+  if (jobvr != 'N' && jobvr != 'V') {
+    rb_raise(rb_eArgError, "jobvr must be 'N' or 'V'");
+  }
+  return jobvr;
+}
+
+#define DEF_LINALG_FUNC(tDType, tNAryClass, fLapackFunc)                                                                                                                   \
+  static void _iter_##fLapackFunc(na_loop_t* const lp) {                                                                                                                   \
+    tDType* a = (tDType*)NDL_PTR(lp, 0);                                                                                                                                   \
+    tDType* wr = (tDType*)NDL_PTR(lp, 1);                                                                                                                                  \
+    tDType* wi = (tDType*)NDL_PTR(lp, 2);                                                                                                                                  \
+    tDType* vl = (tDType*)NDL_PTR(lp, 3);                                                                                                                                  \
+    tDType* vr = (tDType*)NDL_PTR(lp, 4);                                                                                                                                  \
+    int* info = (int*)NDL_PTR(lp, 5);                                                                                                                                      \
+    struct _geev_option* opt = (struct _geev_option*)(lp->opt_ptr);                                                                                                        \
+    const lapack_int n = (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]);                                                 \
+    const lapack_int lda = n;                                                                                                                                              \
+    const lapack_int ldvl = (opt->jobvl == 'N') ? 1 : n;                                                                                                                   \
+    const lapack_int ldvr = (opt->jobvr == 'N') ? 1 : n;                                                                                                                   \
+    lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->jobvl, opt->jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr);                                               \
+    *info = (int)i;                                                                                                                                                        \
+  }                                                                                                                                                                        \
+                                                                                                                                                                           \
+  static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) {                                                                                           \
+    VALUE a_vnary = Qnil;                                                                                                                                                  \
+    VALUE kw_args = Qnil;                                                                                                                                                  \
+    rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args);                                                                                                                    \
+    ID kw_table[3] = { rb_intern("order"), rb_intern("jobvl"), rb_intern("jobvr") };                                                                                       \
+    VALUE kw_values[3] = { Qundef, Qundef, Qundef };                                                                                                                       \
+    rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values);                                                                                                                     \
+    const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR;                                                                 \
+    const char jobvl = kw_values[1] != Qundef ? _get_jobvl(kw_values[1]) : 'V';                                                                                            \
+    const char jobvr = kw_values[2] != Qundef ? _get_jobvr(kw_values[2]) : 'V';                                                                                            \
+                                                                                                                                                                           \
+    if (CLASS_OF(a_vnary) != tNAryClass) {                                                                                                                                 \
+      a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary);                                                                                                     \
+    }                                                                                                                                                                      \
+    if (!RTEST(nary_check_contiguous(a_vnary))) {                                                                                                                          \
+      a_vnary = nary_dup(a_vnary);                                                                                                                                         \
+    }                                                                                                                                                                      \
+                                                                                                                                                                           \
+    narray_t* a_nary = NULL;                                                                                                                                               \
+    GetNArray(a_vnary, a_nary);                                                                                                                                            \
+    const int n_dims = NA_NDIM(a_nary);                                                                                                                                    \
+    if (n_dims != 2) {                                                                                                                                                     \
+      rb_raise(rb_eArgError, "input array a must be 2-dimensional");                                                                                                       \
+      return Qnil;                                                                                                                                                         \
+    }                                                                                                                                                                      \
+                                                                                                                                                                           \
+    size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1];                                                                              \
+    size_t shape_wr[1] = { n };                                                                                                                                            \
+    size_t shape_wi[1] = { n };                                                                                                                                            \
+    size_t shape_vl[2] = { n, (jobvl == 'N') ? 1 : n };                                                                                                                    \
+    size_t shape_vr[2] = { n, (jobvr == 'N') ? 1 : n };                                                                                                                    \
+    ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } };                                                                                                                         \
+    ndfunc_arg_out_t aout[5] = { { tNAryClass, 1, shape_wr }, { tNAryClass, 1, shape_wi }, { tNAryClass, 2, shape_vl }, { tNAryClass, 2, shape_vr }, { numo_cInt32, 0 } }; \
+    ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 5, ain, aout };                                                                                        \
+    struct _geev_option opt = { matrix_layout, jobvl, jobvr };                                                                                                             \
+    VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary);                                                                                                                        \
+                                                                                                                                                                           \
+    RB_GC_GUARD(a_vnary);                                                                                                                                                  \
+    return ret;                                                                                                                                                            \
+  }
+
+#define DEF_LINALG_FUNC_COMPLEX(tDType, tNAryClass, fLapackFunc)                                                                             \
+  static void _iter_##fLapackFunc(na_loop_t* const lp) {                                                                                     \
+    tDType* a = (tDType*)NDL_PTR(lp, 0);                                                                                                     \
+    tDType* w = (tDType*)NDL_PTR(lp, 1);                                                                                                     \
+    tDType* vl = (tDType*)NDL_PTR(lp, 2);                                                                                                    \
+    tDType* vr = (tDType*)NDL_PTR(lp, 3);                                                                                                    \
+    int* info = (int*)NDL_PTR(lp, 4);                                                                                                        \
+    struct _geev_option* opt = (struct _geev_option*)(lp->opt_ptr);                                                                          \
+    const lapack_int n = (lapack_int)(opt->matrix_layout == LAPACK_ROW_MAJOR ? NDL_SHAPE(lp, 0)[0] : NDL_SHAPE(lp, 0)[1]);                   \
+    const lapack_int lda = n;                                                                                                                \
+    const lapack_int ldvl = (opt->jobvl == 'N') ? 1 : n;                                                                                     \
+    const lapack_int ldvr = (opt->jobvr == 'N') ? 1 : n;                                                                                     \
+    lapack_int i = LAPACKE_##fLapackFunc(opt->matrix_layout, opt->jobvl, opt->jobvr, n, a, lda, w, vl, ldvl, vr, ldvr);                      \
+    *info = (int)i;                                                                                                                          \
+  }                                                                                                                                          \
+                                                                                                                                             \
+  static VALUE _linalg_lapack_##fLapackFunc(int argc, VALUE* argv, VALUE self) {                                                             \
+    VALUE a_vnary = Qnil;                                                                                                                    \
+    VALUE kw_args = Qnil;                                                                                                                    \
+    rb_scan_args(argc, argv, "1:", &a_vnary, &kw_args);                                                                                      \
+    ID kw_table[3] = { rb_intern("order"), rb_intern("jobvl"), rb_intern("jobvr") };                                                         \
+    VALUE kw_values[3] = { Qundef, Qundef, Qundef };                                                                                         \
+    rb_get_kwargs(kw_args, kw_table, 0, 3, kw_values);                                                                                       \
+    const int matrix_layout = kw_values[0] != Qundef ? get_matrix_layout(kw_values[0]) : LAPACK_ROW_MAJOR;                                   \
+    const char jobvl = kw_values[1] != Qundef ? _get_jobvl(kw_values[1]) : 'V';                                                              \
+    const char jobvr = kw_values[2] != Qundef ? _get_jobvr(kw_values[2]) : 'V';                                                              \
+                                                                                                                                             \
+    if (CLASS_OF(a_vnary) != tNAryClass) {                                                                                                   \
+      a_vnary = rb_funcall(tNAryClass, rb_intern("cast"), 1, a_vnary);                                                                       \
+    }                                                                                                                                        \
+    if (!RTEST(nary_check_contiguous(a_vnary))) {                                                                                            \
+      a_vnary = nary_dup(a_vnary);                                                                                                           \
+    }                                                                                                                                        \
+                                                                                                                                             \
+    narray_t* a_nary = NULL;                                                                                                                 \
+    GetNArray(a_vnary, a_nary);                                                                                                              \
+    const int n_dims = NA_NDIM(a_nary);                                                                                                      \
+    if (n_dims != 2) {                                                                                                                       \
+      rb_raise(rb_eArgError, "input array a must be 2-dimensional");                                                                         \
+      return Qnil;                                                                                                                           \
+    }                                                                                                                                        \
+                                                                                                                                             \
+    size_t n = matrix_layout == LAPACK_ROW_MAJOR ? NA_SHAPE(a_nary)[0] : NA_SHAPE(a_nary)[1];                                                \
+    size_t shape_w[1] = { n };                                                                                                               \
+    size_t shape_vl[2] = { n, (jobvl == 'N') ? 1 : n };                                                                                      \
+    size_t shape_vr[2] = { n, (jobvr == 'N') ? 1 : n };                                                                                      \
+    ndfunc_arg_in_t ain[1] = { { OVERWRITE, 2 } };                                                                                           \
+    ndfunc_arg_out_t aout[4] = { { tNAryClass, 1, shape_w }, { tNAryClass, 2, shape_vl }, { tNAryClass, 2, shape_vr }, { numo_cInt32, 0 } }; \
+    ndfunc_t ndf = { _iter_##fLapackFunc, NO_LOOP | NDF_EXTRACT, 1, 4, ain, aout };                                                          \
+    struct _geev_option opt = { matrix_layout, jobvl, jobvr };                                                                               \
+    VALUE ret = na_ndloop3(&ndf, &opt, 1, a_vnary);                                                                                          \
+                                                                                                                                             \
+    RB_GC_GUARD(a_vnary);                                                                                                                    \
+    return ret;                                                                                                                              \
+  }
+
+DEF_LINALG_FUNC(double, numo_cDFloat, dgeev)
+DEF_LINALG_FUNC(float, numo_cSFloat, sgeev)
+DEF_LINALG_FUNC_COMPLEX(lapack_complex_double, numo_cDComplex, zgeev)
+DEF_LINALG_FUNC_COMPLEX(lapack_complex_float, numo_cSComplex, cgeev)
+
+#undef DEF_LINALG_FUNC
+#undef DEF_LINALG_FUNC_COMPLEX
+
+void define_linalg_lapack_geev(VALUE mLapack) {
+  rb_define_module_function(mLapack, "dgeev", RUBY_METHOD_FUNC(_linalg_lapack_dgeev), -1);
+  rb_define_module_function(mLapack, "sgeev", RUBY_METHOD_FUNC(_linalg_lapack_sgeev), -1);
+  rb_define_module_function(mLapack, "zgeev", RUBY_METHOD_FUNC(_linalg_lapack_zgeev), -1);
+  rb_define_module_function(mLapack, "cgeev", RUBY_METHOD_FUNC(_linalg_lapack_cgeev), -1);
+}

data/ext/numo/linalg/lapack/geev.h

@@ -0,0 +1,15 @@
+#ifndef NUMO_LINALG_ALT_LAPACK_GEEV_H
+#define NUMO_LINALG_ALT_LAPACK_GEEV_H 1
+
+#include <lapacke.h>
+
+#include <ruby.h>
+
+#include <numo/narray.h>
+#include <numo/template.h>
+
+#include "../util.h"
+
+void define_linalg_lapack_geev(VALUE mLapack);
+
+#endif /* NUMO_LINALG_ALT_LAPACK_GEEV_H */