nmatrix-atlas 0.2.0

data/ext/nmatrix_atlas/math_atlas/cblas_templates_atlas.h

@@ -0,0 +1,72 @@
+/////////////////////////////////////////////////////////////////////
+// = 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
+//
+// == cblas_templaces_atlas.h
+//
+// Define template functions for calling CBLAS functions in the
+// nm::math::atlas namespace.
+//
+
+#ifndef CBLAS_TEMPLATES_ATLAS_H
+#define CBLAS_TEMPLATES_ATLAS_H
+
+//includes so we have access to internal implementations
+#include "math/rotg.h"
+#include "math/rot.h"
+#include "math/asum.h"
+#include "math/nrm2.h"
+#include "math/imax.h"
+#include "math/scal.h"
+#include "math/gemv.h"
+#include "math/gemm.h"
+#include "math/trsm.h"
+
+namespace nm { namespace math { namespace atlas {
+
+//Add cblas templates in the correct namespace
+#include "math/cblas_templates_core.h"
+
+//Add complex specializations for rot and rotg. These cblas functions are not
+//part of the the standard CBLAS and so need to be in an nmatrix-atlas header.
+template <>
+inline void rotg(Complex64* a, Complex64* b, Complex64* c, Complex64* s) {
+  cblas_crotg(a, b, c, s);
+}
+
+template <>
+inline void rotg(Complex128* a, Complex128* b, Complex128* c, Complex128* s) {
+  cblas_zrotg(a, b, c, s);
+}
+template <>
+inline void rot(const int N, Complex64* X, const int incX, Complex64* Y, const int incY, const float c, const float s) {
+  cblas_csrot(N, X, incX, Y, incY, c, s);
+}
+
+template <>
+inline void rot(const int N, Complex128* X, const int incX, Complex128* Y, const int incY, const double c, const double s) {
+  cblas_zdrot(N, X, incX, Y, incY, c, s);
+}
+
+}}} //nm::math::atlas
+
+#endif

data/ext/nmatrix_atlas/math_atlas/clapack_templates.h

@@ -0,0 +1,332 @@
+/////////////////////////////////////////////////////////////////////
+// = 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
+//
+// == clapack_templates.h
+//
+// Collection of functions used to call ATLAS CLAPACK functions
+// directly.
+//
+
+#ifndef CLAPACK_TEMPLATES_H
+#define CLAPACK_TEMPLATES_H
+
+//needed to get access to internal implementations
+#include "math/getrf.h"
+#include "math/getrs.h"
+
+namespace nm { namespace math { namespace atlas {
+//The first group of functions are those for which we have internal implementations.
+//The internal implementations are defined in the ext/nmatrix/math directory
+//and are the non-specialized
+//forms of the template functions nm::math::whatever().
+//They are are called below for non-BLAS
+//types in the non-specialized form of the template nm::math::atlas::whatever().
+//The specialized forms call the appropriate clapack functions.
+
+//We also define the clapack_whatever() template
+//functions below, which just cast
+//their arguments to the appropriate types.
+
+
+//getrf
+template <typename DType>
+inline int getrf(const enum CBLAS_ORDER order, const int m, const int n, DType* a, const int lda, int* ipiv) {
+  return nm::math::getrf<DType>(order, m, n, a, lda, ipiv);
+}
+
+//Apparently CLAPACK isn't available on OS X, so we only define these
+//specializations if available,
+#if defined (HAVE_CLAPACK_H) || defined (HAVE_ATLAS_CLAPACK_H)
+template <>
+inline int getrf(const enum CBLAS_ORDER order, const int m, const int n, float* a, const int lda, int* ipiv) {
+  return clapack_sgetrf(order, m, n, a, lda, ipiv);
+}
+
+template <>
+inline int getrf(const enum CBLAS_ORDER order, const int m, const int n, double* a, const int lda, int* ipiv) {
+  return clapack_dgetrf(order, m, n, a, lda, ipiv);
+}
+
+template <>
+inline int getrf(const enum CBLAS_ORDER order, const int m, const int n, Complex64* a, const int lda, int* ipiv) {
+  return clapack_cgetrf(order, m, n, a, lda, ipiv);
+}
+
+template <>
+inline int getrf(const enum CBLAS_ORDER order, const int m, const int n, Complex128* a, const int lda, int* ipiv) {
+  return clapack_zgetrf(order, m, n, a, lda, ipiv);
+}
+#endif
+
+template <typename DType>
+inline int clapack_getrf(const enum CBLAS_ORDER order, const int m, const int n, void* a, const int lda, int* ipiv) {
+  return getrf<DType>(order, m, n, static_cast<DType*>(a), lda, ipiv);
+}
+
+//getrs
+/*
+ * Solves a system of linear equations A*X = B with a general NxN matrix A using the LU factorization computed by GETRF.
+ *
+ * From ATLAS 3.8.0.
+ */
+template <typename DType>
+inline int getrs(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE Trans, const int N, const int NRHS, const DType* A,
+           const int lda, const int* ipiv, DType* B, const int ldb)
+{
+  return nm::math::getrs<DType>(Order, Trans, N, NRHS, A, lda, ipiv, B, ldb);
+}
+
+#if defined (HAVE_CLAPACK_H) || defined (HAVE_ATLAS_CLAPACK_H)
+template <>
+inline int getrs(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE Trans, const int N, const int NRHS, const float* A,
+           const int lda, const int* ipiv, float* B, const int ldb)
+{
+  return clapack_sgetrs(Order, Trans, N, NRHS, A, lda, ipiv, B, ldb);
+}
+
+template <>
+inline int getrs(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE Trans, const int N, const int NRHS, const double* A,
+           const int lda, const int* ipiv, double* B, const int ldb)
+{
+  return clapack_dgetrs(Order, Trans, N, NRHS, A, lda, ipiv, B, ldb);
+}
+
+template <>
+inline int getrs(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE Trans, const int N, const int NRHS, const Complex64* A,
+           const int lda, const int* ipiv, Complex64* B, const int ldb)
+{
+  return clapack_cgetrs(Order, Trans, N, NRHS, A, lda, ipiv, static_cast<void*>(B), ldb);
+}
+
+template <>
+inline int getrs(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE Trans, const int N, const int NRHS, const Complex128* A,
+           const int lda, const int* ipiv, Complex128* B, const int ldb)
+{
+  return clapack_zgetrs(Order, Trans, N, NRHS, A, lda, ipiv, static_cast<void*>(B), ldb);
+}
+#endif
+
+template <typename DType>
+inline int clapack_getrs(const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE trans, const int n, const int nrhs,
+                         const void* a, const int lda, const int* ipiv, void* b, const int ldb) {
+  return getrs<DType>(order, trans, n, nrhs, static_cast<const DType*>(a), lda, ipiv, static_cast<DType*>(b), ldb);
+}
+
+
+//Functions without internal implementations below:
+
+//getri
+template <typename DType>
+inline int getri(const enum CBLAS_ORDER order, const int n, DType* a, const int lda, const int* ipiv) {
+  rb_raise(rb_eNotImpError, "getri not yet implemented for non-BLAS dtypes");
+  return 0;
+}
+
+#if defined (HAVE_CLAPACK_H) || defined (HAVE_ATLAS_CLAPACK_H)
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, float* a, const int lda, const int* ipiv) {
+  return clapack_sgetri(order, n, a, lda, ipiv);
+}
+
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, double* a, const int lda, const int* ipiv) {
+  return clapack_dgetri(order, n, a, lda, ipiv);
+}
+
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, Complex64* a, const int lda, const int* ipiv) {
+  return clapack_cgetri(order, n, a, lda, ipiv);
+}
+
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, Complex128* a, const int lda, const int* ipiv) {
+  return clapack_zgetri(order, n, a, lda, ipiv);
+}
+#endif
+
+template <typename DType>
+inline int clapack_getri(const enum CBLAS_ORDER order, const int n, void* a, const int lda, const int* ipiv) {
+  return getri<DType>(order, n, static_cast<DType*>(a), lda, ipiv);
+}
+
+//potrf
+/*
+ * From ATLAS 3.8.0:
+ *
+ * Computes one of two LU factorizations based on the setting of the Order
+ * parameter, as follows:
+ * ----------------------------------------------------------------------------
+ *                       Order == CblasColMajor
+ * Column-major factorization of form
+ *   A = P * L * U
+ * where P is a row-permutation matrix, L is lower triangular with unit
+ * diagonal elements (lower trapazoidal if M > N), and U is upper triangular
+ * (upper trapazoidal if M < N).
+ *
+ * ----------------------------------------------------------------------------
+ *                       Order == CblasRowMajor
+ * Row-major factorization of form
+ *   A = P * L * U
+ * where P is a column-permutation matrix, L is lower triangular (lower
+ * trapazoidal if M > N), and U is upper triangular with unit diagonals (upper
+ * trapazoidal if M < N).
+ *
+ * ============================================================================
+ * Let IERR be the return value of the function:
+ *    If IERR == 0, successful exit.
+ *    If (IERR < 0) the -IERR argument had an illegal value
+ *    If (IERR > 0 && Order == CblasColMajor)
+ *       U(i-1,i-1) is exactly zero.  The factorization has been completed,
+ *       but the factor U is exactly singular, and division by zero will
+ *       occur if it is used to solve a system of equations.
+ *    If (IERR > 0 && Order == CblasRowMajor)
+ *       L(i-1,i-1) is exactly zero.  The factorization has been completed,
+ *       but the factor L is exactly singular, and division by zero will
+ *       occur if it is used to solve a system of equations.
+ */
+template <typename DType>
+inline int potrf(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int N, DType* A, const int lda) {
+#if defined HAVE_CLAPACK_H || defined HAVE_ATLAS_CLAPACK_H
+  rb_raise(rb_eNotImpError, "not yet implemented for non-BLAS dtypes");
+#else
+  rb_raise(rb_eNotImpError, "only CLAPACK version implemented thus far");
+#endif
+  return 0;
+}
+
+#if defined HAVE_CLAPACK_H || defined HAVE_ATLAS_CLAPACK_H
+template <>
+inline int potrf(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int N, float* A, const int lda) {
+  return clapack_spotrf(order, uplo, N, A, lda);
+}
+
+template <>
+inline int potrf(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int N, double* A, const int lda) {
+  return clapack_dpotrf(order, uplo, N, A, lda);
+}
+
+template <>
+inline int potrf(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int N, Complex64* A, const int lda) {
+  return clapack_cpotrf(order, uplo, N, A, lda);
+}
+
+template <>
+inline int potrf(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int N, Complex128* A, const int lda) {
+  return clapack_zpotrf(order, uplo, N, A, lda);
+}
+#endif
+
+template <typename DType>
+inline int clapack_potrf(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, void* a, const int lda) {
+  return potrf<DType>(order, uplo, n, static_cast<DType*>(a), lda);
+}
+
+//potri
+template <typename DType>
+inline int potri(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, DType* a, const int lda) {
+  rb_raise(rb_eNotImpError, "potri not yet implemented for non-BLAS dtypes");
+  return 0;
+}
+
+
+#if defined HAVE_CLAPACK_H || defined HAVE_ATLAS_CLAPACK_H
+template <>
+inline int potri(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, float* a, const int lda) {
+  return clapack_spotri(order, uplo, n, a, lda);
+}
+
+template <>
+inline int potri(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, double* a, const int lda) {
+  return clapack_dpotri(order, uplo, n, a, lda);
+}
+
+template <>
+inline int potri(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, Complex64* a, const int lda) {
+  return clapack_cpotri(order, uplo, n, a, lda);
+}
+
+template <>
+inline int potri(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, Complex128* a, const int lda) {
+  return clapack_zpotri(order, uplo, n, a, lda);
+}
+#endif
+
+template <typename DType>
+inline int clapack_potri(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, void* a, const int lda) {
+  return potri<DType>(order, uplo, n, static_cast<DType*>(a), lda);
+}
+
+//potrs
+/*
+ * Solves a system of linear equations A*X = B with a symmetric positive definite matrix A using the Cholesky factorization computed by POTRF.
+ */
+template <typename DType>
+inline int potrs(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const int NRHS, const DType* A,
+           const int lda, DType* B, const int ldb)
+{
+#if defined HAVE_CLAPACK_H || defined HAVE_ATLAS_CLAPACK_H
+  rb_raise(rb_eNotImpError, "not yet implemented for non-BLAS dtypes");
+#else
+  rb_raise(rb_eNotImpError, "only CLAPACK version implemented thus far");
+#endif
+}
+
+#if defined (HAVE_CLAPACK_H) || defined (HAVE_ATLAS_CLAPACK_H)
+template <>
+inline int potrs<float> (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const int NRHS, const float* A,
+           const int lda, float* B, const int ldb)
+{
+  return clapack_spotrs(Order, Uplo, N, NRHS, A, lda, B, ldb);
+}
+
+template <>
+inline int potrs<double>(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const int NRHS, const double* A,
+           const int lda, double* B, const int ldb)
+{
+  return clapack_dpotrs(Order, Uplo, N, NRHS, A, lda, B, ldb);
+}
+
+template <>
+inline int potrs<Complex64>(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const int NRHS, const Complex64* A,
+           const int lda, Complex64* B, const int ldb)
+{
+  return clapack_cpotrs(Order, Uplo, N, NRHS, A, lda, static_cast<void *>(B), ldb);
+}
+
+template <>
+inline int potrs<Complex128>(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const int NRHS, const Complex128* A,
+           const int lda, Complex128* B, const int ldb)
+{
+  return clapack_zpotrs(Order, Uplo, N, NRHS, A, lda, static_cast<void *>(B), ldb);
+}
+#endif
+
+template <typename DType>
+inline int clapack_potrs(const enum CBLAS_ORDER order, const enum CBLAS_UPLO uplo, const int n, const int nrhs,
+                         const void* a, const int lda, void* b, const int ldb) {
+  return potrs<DType>(order, uplo, n, nrhs, static_cast<const DType*>(a), lda, static_cast<DType*>(b), ldb);
+}
+
+}}}
+
+#endif

data/ext/nmatrix_atlas/math_atlas/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 { namespace atlas {
+
+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::atlas
+
+#endif // GEEV_H