nmatrix 0.0.1

data/ext/nmatrix/dense/gemm.template.c

@@ -0,0 +1,159 @@
+
+int %%TYPE_ABBREV%%gemm(enum CBLAS_TRANSPOSE TransA, enum CBLAS_TRANSPOSE TransB,
+  const int M, const int N, const int K, const %%TYPE%% alpha,
+  const %%TYPE%%* A, const int lda,
+  const %%TYPE%%* B, const int ldb, const %%TYPE%% beta,
+  %%TYPE%%* C, const int ldc)
+{
+  int num_rows_a, /*num_cols_a,*/ num_rows_b; // nrowa, ncola, nrowb
+
+  // use longest possible type for intermediate value storage:
+  %%TYPE_LONG%% temp;
+  %%= if [:rational,:complex,:value].include?(dtype.type); "#{dtype.long_dtype.sizeof} temp1, temp2;"; end%%
+  int i, j, l;
+
+  if (TransA == CblasNoTrans) num_rows_a = M;
+  else                        num_rows_a = K;
+
+  if (TransB == CblasNoTrans) num_rows_b = K;
+  else                        num_rows_b = N;
+
+  // Test the input parameters
+  if (TransA < 111 || TransA > 113) {
+    fprintf(stderr, "GEMM: TransA must be CblasNoTrans, CblasTrans, or CblasConjTrans\n");
+    return 0;
+  } else if (TransB < 111 || TransB > 113) {
+    fprintf(stderr, "GEMM: TransB must be CblasNoTrans, CblasTrans, or CblasConjTrans\n");
+    return 0;
+  } else if (M < 0) {
+    fprintf(stderr, "GEMM: Expected M >= 0\n");
+    return 0;
+  } else if (N < 0) {
+    fprintf(stderr, "GEMM: Expected N >= 0\n");
+    return 0;
+  } else if (K < 0) {
+    fprintf(stderr, "GEMM: Expected K >= 0\n");
+    return 0;
+  } else if (lda < NM_MAX(1, num_rows_a)) {
+    fprintf(stderr, "GEMM: Expected lda >= max(1, num_rows_a), with num_rows_a = %d; got lda=%d\n", num_rows_a, lda);
+    return 0;
+  } else if (ldb < NM_MAX(1, num_rows_b)) {
+    fprintf(stderr, "GEMM: Expected ldb >= max(1, num_rows_b), with num_rows_b = %d; got ldb=%d\n", num_rows_b, ldb);
+    return 0;
+  } else if (ldc < NM_MAX(1,M)) {
+    fprintf(stderr, "GEMM: Expected ldc >= max(1,M) with M=%d; got ldc=%d\n", M, ldc);
+    return 0;
+  }
+
+  // Quick return if possible
+  if (!M || !N || (%%TYPE alpha == 0%% || !K) && %%TYPE beta == 1%%) return 0;
+
+  // For alpha = 0
+  if (%%TYPE alpha == 0%%) {
+    if (%%TYPE beta == 0%%) {
+      for (j = 0; j < N; ++j)
+        for (i = 0; i < M; ++i) {
+          %%TYPE C[i+j*ldc] = 0%%
+        }
+    } else {
+      for (j = 0; j < N; ++j)
+        for (i = 0; i < M; ++i) {
+          %%TYPE C[i+j*ldc] *= beta%%
+        }
+    }
+    return 0;
+  }
+
+  // Start the operations
+  if (TransB == CblasNoTrans) {
+    if (TransA == CblasNoTrans) {
+      // C = alpha*A*B+beta*C
+      for (j = 0; j < N; ++j) {
+        if (%%TYPE beta == 0%%) {
+          for (i = 0; i < M; ++i) {
+            %%TYPE C[i+j*ldc] = 0%%
+          }
+        } else if (%%TYPE beta != 1%%) {
+          for (i = 0; i < M; ++i) {
+            %%TYPE C[i+j*ldc] *= beta%%
+          }
+        }
+
+        for (l = 0; l < K; ++l) {
+          if (%%TYPE B[l+j*ldb] != 0%%) {
+            %%TYPE_LONG temp = alpha * B[l+j*ldb]%%
+            for (i = 0; i < M; ++i) {
+              %%TYPE C[i+j*ldc] += A[i+l*lda] * temp%%
+            }
+          }
+        }
+      }
+
+    } else {
+
+      // C = alpha*A**T*B + beta*C
+      for (j = 0; j < N; ++j) {
+        for (i = 0; i < M; ++i) {
+          %%TYPE temp = 0%%
+          for (l = 0; l < K; ++l) {
+            %%TYPE_LONG temp += A[l+i*lda] * B[l+j*ldb]%%
+          }
+
+          if (%%TYPE beta == 0%%) {
+            %%TYPE C[i+j*ldc] = alpha*temp%%
+          } else {
+            %%TYPE C[i+j*ldc] = alpha*temp + beta*C[i+j*ldc]%%
+          }
+        }
+      }
+
+    }
+
+  } else if (TransA == CblasNoTrans) {
+
+    // C = alpha*A*B**T + beta*C
+    for (j = 0; j < N; ++j) {
+      if (%%TYPE beta == 0%%) {
+        for (i = 0; i < M; ++i) {
+          %%TYPE C[i+j*ldc] = 0%%
+        }
+      } else if (%%TYPE beta != 1%%) {
+        for (i = 0; i < M; ++i) {
+          %%TYPE C[i+j*ldc] *= beta%%
+        }
+      }
+
+      for (l = 0; l < K; ++l) {
+        if (%%TYPE B[j+l*ldb] != 0%%) {
+          %%TYPE_LONG temp = alpha * B[j+l*ldb]%%
+          for (i = 0; i < M; ++i) {
+            %%TYPE C[i+j*ldc] += A[i+l*lda] * temp%%
+          }
+        }
+      }
+
+    }
+
+  } else {
+
+    // C = alpha*A**T*B**T + beta*C
+    for (j = 0; j < N; ++j) {
+      for (i = 0; i < M; ++i) {
+        %%TYPE temp = 0%%
+        for (l = 0; l < K; ++l) {
+          %%TYPE_LONG temp += A[l+i*lda] * B[j+l*ldb]%%
+        }
+
+        if (%%TYPE beta == 0%%) {
+          %%TYPE C[i+j*ldc] = alpha*temp%%
+        } else {
+          %%TYPE C[i+j*ldc] = alpha*temp + beta*C[i+j*ldc]%%
+        }
+      }
+    }
+
+  }
+
+  return 0;
+}
+

data/ext/nmatrix/dense/gemv.template.c

@@ -0,0 +1,130 @@
+
+int %%TYPE_ABBREV%%gemv(enum CBLAS_TRANSPOSE Trans, const size_t M, const size_t N, const %%TYPE%% alpha,
+  const %%TYPE%%* A, const size_t lda, const %%TYPE%%* X, const int incX, const %%TYPE%% beta, %%TYPE%%* Y, const int incY)
+{
+  size_t lenX, lenY, i, j;
+  int kx, ky, iy, jx, jy, ix;
+  %%TYPE_LONG%% temp;
+  %%= if [:rational,:complex,:value].include?(dtype.type); "#{dtype.long_dtype.sizeof} temp1;"; end%%
+
+  // Test the input parameters
+  if (Trans < 111 || Trans > 113) {
+    fprintf(stderr, "IGEMV: TransA must be CblasNoTrans, CblasTrans, or CblasConjTrans\n");
+    return 0;
+  } else if (lda < NM_MAX(1, N)) {
+    fprintf(stderr, "IGEMV: Expected lda >= max(1, N), with N = %d; got lda=%d\n", N, lda);
+    return 0;
+  } else if (incX == 0) {
+    fprintf(stderr, "IGEMV: Expected incX != 0\n");
+    return 0;
+  } else if (incY == 0) {
+    fprintf(stderr, "IGEMV: Expected incY != 0\n");
+    return 0;
+  }
+
+  // Quick return if possible
+  if (!M || !N || %%TYPE alpha == 0%% && %%TYPE beta == 1%%) return 0;
+
+  if (Trans == CblasNoTrans) {
+    lenX = N;
+    lenY = M;
+  } else {
+    lenX = M;
+    lenY = N;
+  }
+
+  if (incX > 0) kx = 0;
+  else          kx = (lenX - 1) * -incX;
+
+  if (incY > 0) ky = 0;
+  else          ky =  (lenY - 1) * -incY;
+
+  // Start the operations. In this version, the elements of A are accessed sequentially with one pass through A.
+  if (%%TYPE beta != 1%%) {
+    if (incY == 1) {
+      if (%%TYPE beta == 0%%) {
+        for (i = 0; i < lenY; ++i) {
+          %%TYPE Y[i] = 0%%
+        }
+      } else {
+        for (i = 0; i < lenY; ++i) {
+          %%TYPE Y[i] *= beta%%
+        }
+      }
+    } else {
+      iy = ky;
+      if (%%TYPE beta == 0%%) {
+        for (i = 0; i < lenY; ++i) {
+          %%TYPE Y[iy] = 0%%
+          iy += incY;
+        }
+      } else {
+        for (i = 0; i < lenY; ++i) {
+          %%TYPE Y[iy] *= beta%%
+          iy += incY;
+        }
+      }
+    }
+  }
+
+  if (%%TYPE alpha == 0%%) return 0;
+
+  if (Trans == CblasNoTrans) {
+
+    // Form  y := alpha*A*x + y.
+    jx = kx;
+    if (incY == 1) {
+      for (j = 0; j < N; ++j) {
+        if (%%TYPE X[jx] != 0%%) {
+          %%TYPE_LONG temp = alpha * X[jx]%%
+          for (i = 0; i < M; ++i) {
+            %%TYPE Y[i] += A[j+i*lda] * temp%%
+          }
+        }
+        jx += incX;
+      }
+    } else {
+      for (j = 0; j < N; ++j) {
+        if (%%TYPE X[jx] != 0%%) {
+          %%TYPE_LONG temp = alpha * X[jx]%%
+          iy = ky;
+          for (i = 0; i < M; ++i) {
+            %%TYPE Y[iy] += A[j+i*lda] * temp%%
+            iy += incY;
+          }
+        }
+        jx += incX;
+      }
+    }
+
+  } else { // TODO: Check that indices are correct! They're switched for C.
+
+    // Form  y := alpha*A**T*x + y.
+    jy = ky;
+
+    if (incX == 1) {
+      for (j = 0; j < N; ++j) {
+        %%TYPE temp = 0%%
+        for (i = 0; i < M; ++i) {
+          %%TYPE_LONG temp += A[j+i*lda]*X[j]%%
+        }
+        %%TYPE Y[jy] += alpha * temp%%
+        jy += incY;
+      }
+    } else {
+      for (j = 0; j < N; ++j) {
+        %%TYPE temp = 0%%
+        ix = kx;
+        for (i = 0; i < M; ++i) {
+          %%TYPE_LONG temp += A[j+i*lda] * X[ix]%%
+          ix += incX;
+        }
+
+        %%TYPE Y[jy] += alpha * temp%%
+        jy += incY;
+      }
+    }
+  }
+
+  return 0;
+}  // end of GEMV

data/ext/nmatrix/dense/rationalmath.template.c

@@ -0,0 +1,68 @@
+
+inline %%TYPE%% BOOL2%%= dtype.id.to_s.upcase%%(bool expr) {
+  %%TYPE%% result;
+  result.n = expr;
+  result.d = 1;
+  return result;
+}
+
+inline %%TYPE%% %%TYPE_ABBREV%%_bang(%%= dtype.sym == :rational128 ? "int64_t n, int64_t d" : (dtype.sym == :rational64 ? "int32_t n, int32_t d" : "int16_t n, int16_t d")%%)
+{
+  %%TYPE%% result = {!n, 1};
+  return result;
+}
+
+inline %%TYPE%% %%TYPE_ABBREV%%_negate(%%= dtype.sym == :rational128 ? "int64_t n, int64_t d" : (dtype.sym == :rational64 ? "int32_t n, int32_t d" : "int16_t n, int16_t d")%%)
+{
+  %%TYPE%% result = {-n, -d};
+  return result;
+}
+
+inline %%TYPE%% %%TYPE_ABBREV%%_muldiv(int64_t anum, int64_t aden, int64_t bnum, int64_t bden, char k) {
+  %%TYPE%% result;
+  int64_t t, g1, g2;
+
+  if (k == '/') { // Switch numerator and denominator for division (and move sign)
+    if (bnum < 0) {
+      anum = -anum;
+      bnum = -bnum;
+    }
+    t = bnum;
+    bnum = bden;
+    bden = t;
+  }
+
+  g1 = nmrb_gcd(anum, bden);
+  g2 = nmrb_gcd(aden, bnum);
+
+  result.n = (anum / g1) * (bnum / g2);
+  result.d = (aden / g2) * (bden / g1);
+
+  return result;
+}
+
+inline %%TYPE%% %%TYPE_ABBREV%%_addsub(int64_t anum, int64_t aden, int64_t bnum, int64_t bden, char k) {
+  %%TYPE%% result;
+
+  int64_t ig = nmrb_gcd(aden, bden);
+  int64_t a  = anum * (bden / ig);
+  int64_t b  = bnum * (aden / ig);
+  int64_t c;
+
+  if (k == '+') c=a+b;
+  else          c=a-b;
+
+  b        = aden / ig;
+  ig       = nmrb_gcd(aden, ig);
+  result.n = c / ig;
+  a        = bden / ig;
+  result.d = a*b;
+
+  return result;
+}
+
+inline %%TYPE%% %%TYPE_ABBREV%%_mod(%%= dtype.sym == :rational128 ? "int64_t anum, int64_t aden, int64_t bnum, int64_t bden" : (dtype.sym == :rational64 ? "int32_t anum, int32_t aden, int32_t bnum, int32_t bden" : "int16_t anum, int16_t aden, int16_t bnum, int16_t bden")%%)
+{
+  // a - (b * int(a/b))
+  return %%TYPE_ABBREV%%_addsub(anum, aden, bnum*((int64_t)((anum * bden) / (aden * bnum))), bden, '-');
+}

data/ext/nmatrix/depend

@@ -0,0 +1,18 @@
+dtypes.h dtypes.c smmp1.c smmp2.c blas.c: generator.rb
+	$(RUBY) -I$(srcdir) $(srcdir)/generator.rb
+
+blas.o: blas.c
+
+smmp2.o: smmp1.c smmp2.c nmatrix.h yale/smmp2_header.template.c yale/symbmm.template.c yale/transp.template.c yale/numbmm.template.c
+
+smmp1.o: smmp1.c nmatrix_config.h nmatrix.h yale/smmp1_header.template.c
+
+dfuncs.o: dfuncs.c $(hdrdir)/ruby.h
+
+$(DLLIB): dtypes.h dtypes.c dfuncs.c $(OBJS) Makefile
+	# $(ECHO) linking shared-object $(DLLIB)
+	@-$(RM) $(@)
+	$(Q) $(LDSHARED) -o $@ $(OBJS) $(LIBPATH) $(DLDFLAGS) $(LOCAL_LIBS) $(LIBS)
+
+soclean:
+	@-$(RM) *.so *.o *.bundle

data/ext/nmatrix/extconf.rb

@@ -0,0 +1,143 @@
+# = NMatrix
+#
+# A linear algebra library for scientific computation in Ruby.
+# NMatrix is part of SciRuby.
+#
+# NMatrix was originally inspired by and derived from NArray, by
+# Masahiro Tanaka: http://narray.rubyforge.org
+#
+# == Copyright Information
+#
+# SciRuby is Copyright (c) 2010 - 2012, Ruby Science Foundation
+# NMatrix is Copyright (c) 2012, Ruby Science Foundation
+#
+# Please see LICENSE.txt for additional copyright notices.
+#
+# == Contributing
+#
+# By contributing source code to SciRuby, you agree to be bound by
+# our Contributor Agreement:
+#
+# * https://github.com/SciRuby/sciruby/wiki/Contributor-Agreement
+#
+# == extconf.rb
+#
+# This file mostly derived from NArray.
+
+require "mkmf"
+
+
+def have_type(type, header=nil)
+  printf "checking for %s... ", type
+  STDOUT.flush
+
+  src = <<"SRC"
+#include <ruby.h>
+SRC
+
+
+  src << <<"SRC" unless header.nil?
+#include <#{header}>
+SRC
+
+  r = try_link(src + <<"SRC")
+  int main() { return 0; }
+  int t() { #{type} a; return 0; }
+SRC
+
+  unless r
+    print "no\n"
+    return false
+  end
+
+  $defs.push(format("-DHAVE_%s", type.upcase))
+
+  print "yes\n"
+
+  return true
+end
+
+def create_conf_h(file)
+  print "creating #{file}\n"
+  hfile = open(file, "w")
+  for line in $defs
+    line =~ /^-D(.*)/
+    hfile.printf "#define %s 1\n", $1
+  end
+  hfile.close
+end
+
+if RUBY_VERSION < '1.9'
+  raise(NotImplementedError, "Sorry, you need Ruby 1.9!")
+else
+  $INSTALLFILES = [['nmatrix.h', '$(archdir)'], ['nmatrix_config.h', '$(archdir)']]
+  if /cygwin|mingw/ =~ RUBY_PLATFORM
+	 $INSTALLFILES << ['libnmatrix.a', '$(archdir)']
+  end
+end
+
+if /cygwin|mingw/ =~ RUBY_PLATFORM
+  CONFIG["DLDFLAGS"] << " --output-lib libnmatrix.a"
+end
+
+$DEBUG = true
+$CFLAGS = ["-Wall ",$CFLAGS].join(" ") #-BENCHMARK for comparing transp
+
+srcs = %w(
+nmatrix
+list
+dense
+yale
+dfuncs
+smmp1
+smmp2
+cblas
+blas
+rational
+)
+# add smmp in to get generic transp; remove smmp2 to eliminate funcptr transp
+
+header = "stdint.h"
+unless have_header(header)
+  header = "sys/types.h"
+  unless have_header(header)
+    header = nil
+  end
+end
+
+have_type("u_int8_t", header)
+have_type("uint8_t", header)
+have_type("u_int16_t", header)
+have_type("uint16_t", header)
+have_type("int16_t", header)
+have_type("int32_t", header)
+have_type("u_int32_t", header)
+have_type("uint32_t", header)
+have_type("int64_t", header)
+have_type("u_int64_t", header)
+have_type("uint64_t", header)
+
+unless have_type("size_t", header)
+  have_type("size_t", "stddef.h")
+end
+
+# dir_config("cblas")
+# dir_config("atlas")
+
+find_library("cblas", "cblas_dgemm", "/usr/local/lib", "/usr/local/atlas/lib")
+find_library("atlas", "ATL_dgemmNN", "/usr/local/lib", "/usr/local/atlas/lib", "/usr/lib")
+find_header("cblas.h", "/usr/local/include", "/usr/local/atlas/include")
+
+have_library("f2c")
+have_header("f2c.h")
+
+
+$libs += " -lcblas -latlas "
+
+$objs = srcs.collect{|i| i+".o" }
+
+$CFLAGS += " -O0"
+
+create_conf_h("nmatrix_config.h")
+create_makefile("nmatrix")
+