nmatrix-gemv 0.0.3

data/ext/nmatrix_gemv/math/asum.h

@@ -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 - 2014, Ruby Science Foundation
+// NMatrix is Copyright (c) 2012 - 2014, John Woods and the 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
+//
+// == asum.h
+//
+// CBLAS asum function
+//
+
+/*
+ *             Automatically Tuned Linear Algebra Software v3.8.4
+ *                    (C) Copyright 1999 R. Clint Whaley
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *   1. Redistributions of source code must retain the above copyright
+ *      notice, this list of conditions and the following disclaimer.
+ *   2. Redistributions in binary form must reproduce the above copyright
+ *      notice, this list of conditions, and the following disclaimer in the
+ *      documentation and/or other materials provided with the distribution.
+ *   3. The name of the ATLAS group or the names of its contributers may
+ *      not be used to endorse or promote products derived from this
+ *      software without specific written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ATLAS GROUP OR ITS CONTRIBUTORS
+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#ifndef ASUM_H
+# define ASUM_H
+
+
+namespace nm { namespace math {
+
+/*
+ * Level 1 BLAS routine which sums the absolute values of a vector's contents. If the vector consists of complex values,
+ * the routine sums the absolute values of the real and imaginary components as well.
+ *
+ * So, based on input types, these are the valid return types:
+ *    int -> int
+ *    float -> float or double
+ *    double -> double
+ *    complex64 -> float or double
+ *    complex128 -> double
+ *    rational -> rational
+ */
+template <typename ReturnDType, typename DType>
+inline ReturnDType asum(const int N, const DType* X, const int incX) {
+  ReturnDType sum = 0;
+  if ((N > 0) && (incX > 0)) {
+    for (int i = 0; i < N; ++i) {
+      sum += std::abs(X[i*incX]);
+    }
+  }
+  return sum;
+}
+
+
+#if defined HAVE_CBLAS_H || defined HAVE_ATLAS_CBLAS_H
+template <>
+inline float asum(const int N, const float* X, const int incX) {
+  return cblas_sasum(N, X, incX);
+}
+
+template <>
+inline double asum(const int N, const double* X, const int incX) {
+  return cblas_dasum(N, X, incX);
+}
+
+template <>
+inline float asum(const int N, const Complex64* X, const int incX) {
+  return cblas_scasum(N, X, incX);
+}
+
+template <>
+inline double asum(const int N, const Complex128* X, const int incX) {
+  return cblas_dzasum(N, X, incX);
+}
+#else
+template <>
+inline float asum(const int N, const Complex64* X, const int incX) {
+  float sum = 0;
+  if ((N > 0) && (incX > 0)) {
+    for (int i = 0; i < N; ++i) {
+      sum += std::abs(X[i*incX].r) + std::abs(X[i*incX].i);
+    }
+  }
+  return sum;
+}
+
+template <>
+inline double asum(const int N, const Complex128* X, const int incX) {
+  double sum = 0;
+  if ((N > 0) && (incX > 0)) {
+    for (int i = 0; i < N; ++i) {
+      sum += std::abs(X[i*incX].r) + std::abs(X[i*incX].i);
+    }
+  }
+  return sum;
+}
+#endif
+
+
+template <typename ReturnDType, typename DType>
+inline void cblas_asum(const int N, const void* X, const int incX, void* sum) {
+  *reinterpret_cast<ReturnDType*>( sum ) = asum<ReturnDType, DType>( N, reinterpret_cast<const DType*>(X), incX );
+}
+
+
+
+}} // end of namespace nm::math
+
+#endif // NRM2_H

data/ext/nmatrix_gemv/math/geev.h

@@ -0,0 +1,82 @@
+/////////////////////////////////////////////////////////////////////
+// = 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 - 2014, Ruby Science Foundation
+// NMatrix is Copyright (c) 2012 - 2014, John Woods and the 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
+//
+// == geev.h
+//
+// Header file for interface with LAPACK's xGEEV functions.
+//
+
+#ifndef GEEV_H
+# define GEEV_H
+
+extern "C" {
+  void sgeev_(char* jobvl, char* jobvr, int* n, float* a,          int* lda, float* wr,  float* wi,  float* vl,          int* ldvl, float* vr,          int* ldvr, float* work,          int* lwork,                int* info);
+  void dgeev_(char* jobvl, char* jobvr, int* n, double* a,         int* lda, double* wr, double* wi, double* vl,         int* ldvl, double* vr,         int* ldvr, double* work,         int* lwork,                int* info);
+  void cgeev_(char* jobvl, char* jobvr, int* n, nm::Complex64* a,  int* lda, nm::Complex64* w,       nm::Complex64* vl,  int* ldvl, nm::Complex64* vr,  int* ldvr, nm::Complex64* work,  int* lwork, float* rwork,  int* info);
+  void zgeev_(char* jobvl, char* jobvr, int* n, nm::Complex128* a, int* lda, nm::Complex128* w,      nm::Complex128* vl, int* ldvl, nm::Complex128* vr, int* ldvr, nm::Complex128* work, int* lwork, double* rwork, int* info);
+}
+
+namespace nm { namespace math {
+
+template <typename DType, typename CType>                         // wr
+inline int geev(char jobvl, char jobvr, int n, DType* a, int lda, DType* w, DType* wi, DType* vl, int ldvl, DType* vr, int ldvr, DType* work, int lwork, CType* rwork) {
+  rb_raise(rb_eNotImpError, "not yet implemented for non-BLAS dtypes");
+  return -1;
+}
+
+template <>
+inline int geev(char jobvl, char jobvr, int n, float* a, int lda, float* w, float* wi, float* vl, int ldvl, float* vr, int ldvr, float* work, int lwork, float* rwork) {
+  int info;
+  sgeev_(&jobvl, &jobvr, &n, a, &lda, w, wi, vl, &ldvl, vr, &ldvr, work, &lwork, &info);
+  return info;
+}
+
+template <>
+inline int geev(char jobvl, char jobvr, int n, double* a, int lda, double* w, double* wi, double* vl, int ldvl, double* vr, int ldvr, double* work, int lwork, double* rwork) {
+  int info;
+  dgeev_(&jobvl, &jobvr, &n, a, &lda, w, wi, vl, &ldvl, vr, &ldvr, work, &lwork, &info);
+  return info;
+}
+
+template <>
+inline int geev(char jobvl, char jobvr, int n, Complex64* a, int lda, Complex64* w, Complex64* wi, Complex64* vl, int ldvl, Complex64* vr, int ldvr, Complex64* work, int lwork, float* rwork) {
+  int info;
+  cgeev_(&jobvl, &jobvr, &n, a, &lda, w, vl, &ldvl, vr, &ldvr, work, &lwork, rwork, &info);
+  return info;
+}
+
+template <>
+inline int geev(char jobvl, char jobvr, int n, Complex128* a, int lda, Complex128* w, Complex128* wi, Complex128* vl, int ldvl, Complex128* vr, int ldvr, Complex128* work, int lwork, double* rwork) {
+  int info;
+  zgeev_(&jobvl, &jobvr, &n, a, &lda, w, vl, &ldvl, vr, &ldvr, work, &lwork, rwork, &info);
+  return info;
+}
+
+template <typename DType, typename CType>
+inline int lapack_geev(char jobvl, char jobvr, int n, void* a, int lda, void* w, void* wi, void* vl, int ldvl, void* vr, int ldvr, void* work, int lwork, void* rwork) {
+  return geev<DType,CType>(jobvl, jobvr, n, reinterpret_cast<DType*>(a), lda, reinterpret_cast<DType*>(w), reinterpret_cast<DType*>(wi), reinterpret_cast<DType*>(vl), ldvl, reinterpret_cast<DType*>(vr), ldvr, reinterpret_cast<DType*>(work), lwork, reinterpret_cast<CType*>(rwork));
+}
+
+}} // end nm::math
+
+#endif // GEEV_H

data/ext/nmatrix_gemv/math/gemm.h

@@ -0,0 +1,271 @@
+/////////////////////////////////////////////////////////////////////
+// = 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 - 2014, Ruby Science Foundation
+// NMatrix is Copyright (c) 2012 - 2014, John Woods and the 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
+//
+// == gemm.h
+//
+// Header file for interface with ATLAS's CBLAS gemm functions and
+// native templated version of LAPACK's gemm function.
+//
+
+#ifndef GEMM_H
+# define GEMM_H
+
+extern "C" { // These need to be in an extern "C" block or you'll get all kinds of undefined symbol errors.
+#if defined HAVE_CBLAS_H
+  #include <cblas.h>
+#elif defined HAVE_ATLAS_CBLAS_H
+  #include <atlas/cblas.h>
+#endif
+}
+
+
+namespace nm { namespace math {
+/*
+ * GEneral Matrix Multiplication: based on dgemm.f from Netlib.
+ *
+ * This is an extremely inefficient algorithm. Recommend using ATLAS' version instead.
+ *
+ * Template parameters: LT -- long version of type T. Type T is the matrix dtype.
+ *
+ * This version throws no errors. Use gemm<DType> instead for error checking.
+ */
+template <typename DType>
+inline void gemm_nothrow(const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K,
+                 const DType* alpha, const DType* A, const int lda, const DType* B, const int ldb, const DType* beta, DType* C, const int ldc)
+{
+
+  typename LongDType<DType>::type temp;
+
+  // Quick return if possible
+  if (!M or !N or ((*alpha == 0 or !K) and *beta == 1)) return;
+
+  // For alpha = 0
+  if (*alpha == 0) {
+    if (*beta == 0) {
+      for (int j = 0; j < N; ++j)
+        for (int i = 0; i < M; ++i) {
+          C[i+j*ldc] = 0;
+        }
+    } else {
+      for (int j = 0; j < N; ++j)
+        for (int i = 0; i < M; ++i) {
+          C[i+j*ldc] *= *beta;
+        }
+    }
+    return;
+  }
+
+  // Start the operations
+  if (TransB == CblasNoTrans) {
+    if (TransA == CblasNoTrans) {
+      // C = alpha*A*B+beta*C
+      for (int j = 0; j < N; ++j) {
+        if (*beta == 0) {
+          for (int i = 0; i < M; ++i) {
+            C[i+j*ldc] = 0;
+          }
+        } else if (*beta != 1) {
+          for (int i = 0; i < M; ++i) {
+            C[i+j*ldc] *= *beta;
+          }
+        }
+
+        for (int l = 0; l < K; ++l) {
+          if (B[l+j*ldb] != 0) {
+            temp = *alpha * B[l+j*ldb];
+            for (int i = 0; i < M; ++i) {
+              C[i+j*ldc] += A[i+l*lda] * temp;
+            }
+          }
+        }
+      }
+
+    } else {
+
+      // C = alpha*A**DType*B + beta*C
+      for (int j = 0; j < N; ++j) {
+        for (int i = 0; i < M; ++i) {
+          temp = 0;
+          for (int l = 0; l < K; ++l) {
+            temp += A[l+i*lda] * B[l+j*ldb];
+          }
+
+          if (*beta == 0) {
+            C[i+j*ldc] = *alpha*temp;
+          } else {
+            C[i+j*ldc] = *alpha*temp + *beta*C[i+j*ldc];
+          }
+        }
+      }
+
+    }
+
+  } else if (TransA == CblasNoTrans) {
+
+    // C = alpha*A*B**T + beta*C
+    for (int j = 0; j < N; ++j) {
+      if (*beta == 0) {
+        for (int i = 0; i < M; ++i) {
+          C[i+j*ldc] = 0;
+        }
+      } else if (*beta != 1) {
+        for (int i = 0; i < M; ++i) {
+          C[i+j*ldc] *= *beta;
+        }
+      }
+
+      for (int l = 0; l < K; ++l) {
+        if (B[j+l*ldb] != 0) {
+          temp = *alpha * B[j+l*ldb];
+          for (int i = 0; i < M; ++i) {
+            C[i+j*ldc] += A[i+l*lda] * temp;
+          }
+        }
+      }
+
+    }
+
+  } else {
+
+    // C = alpha*A**DType*B**T + beta*C
+    for (int j = 0; j < N; ++j) {
+      for (int i = 0; i < M; ++i) {
+        temp = 0;
+        for (int l = 0; l < K; ++l) {
+          temp += A[l+i*lda] * B[j+l*ldb];
+        }
+
+        if (*beta == 0) {
+          C[i+j*ldc] = *alpha*temp;
+        } else {
+          C[i+j*ldc] = *alpha*temp + *beta*C[i+j*ldc];
+        }
+      }
+    }
+
+  }
+
+  return;
+}
+
+
+
+template <typename DType>
+inline void gemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K,
+                 const DType* alpha, const DType* A, const int lda, const DType* B, const int ldb, const DType* beta, DType* C, const int ldc)
+{
+  if (Order == CblasRowMajor) {
+    if (TransA == CblasNoTrans) {
+      if (lda < std::max(K,1)) {
+        rb_raise(rb_eArgError, "lda must be >= MAX(K,1): lda=%d K=%d", lda, K);
+      }
+    } else {
+      if (lda < std::max(M,1)) { // && TransA == CblasTrans
+        rb_raise(rb_eArgError, "lda must be >= MAX(M,1): lda=%d M=%d", lda, M);
+      }
+    }
+
+    if (TransB == CblasNoTrans) {
+      if (ldb < std::max(N,1)) {
+        rb_raise(rb_eArgError, "ldb must be >= MAX(N,1): ldb=%d N=%d", ldb, N);
+      }
+    } else {
+      if (ldb < std::max(K,1)) {
+        rb_raise(rb_eArgError, "ldb must be >= MAX(K,1): ldb=%d K=%d", ldb, K);
+      }
+    }
+
+    if (ldc < std::max(N,1)) {
+      rb_raise(rb_eArgError, "ldc must be >= MAX(N,1): ldc=%d N=%d", ldc, N);
+    }
+  } else { // CblasColMajor
+    if (TransA == CblasNoTrans) {
+      if (lda < std::max(M,1)) {
+        rb_raise(rb_eArgError, "lda must be >= MAX(M,1): lda=%d M=%d", lda, M);
+      }
+    } else {
+      if (lda < std::max(K,1)) { // && TransA == CblasTrans
+        rb_raise(rb_eArgError, "lda must be >= MAX(K,1): lda=%d K=%d", lda, K);
+      }
+    }
+
+    if (TransB == CblasNoTrans) {
+      if (ldb < std::max(K,1)) {
+        rb_raise(rb_eArgError, "ldb must be >= MAX(K,1): ldb=%d N=%d", ldb, K);
+      }
+    } else {
+      if (ldb < std::max(N,1)) { // NOTE: This error message is actually wrong in the ATLAS source currently. Or are we wrong?
+        rb_raise(rb_eArgError, "ldb must be >= MAX(N,1): ldb=%d N=%d", ldb, N);
+      }
+    }
+
+    if (ldc < std::max(M,1)) {
+      rb_raise(rb_eArgError, "ldc must be >= MAX(M,1): ldc=%d N=%d", ldc, M);
+    }
+  }
+
+  /*
+   * Call SYRK when that's what the user is actually asking for; just handle beta=0, because beta=X requires
+   * we copy C and then subtract to preserve asymmetry.
+   */
+
+  if (A == B && M == N && TransA != TransB && lda == ldb && beta == 0) {
+    rb_raise(rb_eNotImpError, "syrk and syreflect not implemented");
+    /*syrk<DType>(CblasUpper, (Order == CblasColMajor) ? TransA : TransB, N, K, alpha, A, lda, beta, C, ldc);
+    syreflect(CblasUpper, N, C, ldc);
+    */
+  }
+
+  if (Order == CblasRowMajor)    gemm_nothrow<DType>(TransB, TransA, N, M, K, alpha, B, ldb, A, lda, beta, C, ldc);
+  else                           gemm_nothrow<DType>(TransA, TransB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
+
+}
+
+
+template <>
+inline void gemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K,
+          const float* alpha, const float* A, const int lda, const float* B, const int ldb, const float* beta, float* C, const int ldc) {
+  cblas_sgemm(Order, TransA, TransB, M, N, K, *alpha, A, lda, B, ldb, *beta, C, ldc);
+}
+
+template <>
+inline void gemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K,
+          const double* alpha, const double* A, const int lda, const double* B, const int ldb, const double* beta, double* C, const int ldc) {
+  cblas_dgemm(Order, TransA, TransB, M, N, K, *alpha, A, lda, B, ldb, *beta, C, ldc);
+}
+
+template <>
+inline void gemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K,
+          const Complex64* alpha, const Complex64* A, const int lda, const Complex64* B, const int ldb, const Complex64* beta, Complex64* C, const int ldc) {
+  cblas_cgemm(Order, TransA, TransB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
+}
+
+template <>
+inline void gemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K,
+          const Complex128* alpha, const Complex128* A, const int lda, const Complex128* B, const int ldb, const Complex128* beta, Complex128* C, const int ldc) {
+  cblas_zgemm(Order, TransA, TransB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
+}
+
+}} // end of namespace nm::math
+
+#endif // GEMM_H