nmatrix-gemv 0.0.3

data/ext/nmatrix_gemv/math/nrm2.h

@@ -0,0 +1,181 @@
+/////////////////////////////////////////////////////////////////////
+// = 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
+//
+// == nrm2.h
+//
+// CBLAS nrm2 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 NRM2_H
+# define NRM2_H
+
+
+namespace nm { namespace math {
+
+/*
+ * Level 1 BLAS routine which returns the 2-norm of an n-vector x.
+ #
+ * 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>
+ReturnDType nrm2(const int N, const DType* X, const int incX) {
+  const DType ONE = 1, ZERO = 0;
+  typename LongDType<DType>::type scale = 0, ssq = 1, absxi, temp;
+
+
+  if ((N < 1) || (incX < 1))    return ZERO;
+  else if (N == 1)              return std::abs(X[0]);
+
+  for (int i = 0; i < N; ++i) {
+    absxi = std::abs(X[i*incX]);
+    if (scale < absxi) {
+      temp  = scale / absxi;
+      scale = absxi;
+      ssq   = ONE + ssq * (temp * temp);
+    } else {
+      temp = absxi / scale;
+      ssq += temp * temp;
+    }
+  }
+
+  return scale * std::sqrt( ssq );
+}
+
+
+#if defined HAVE_CBLAS_H || defined HAVE_ATLAS_CBLAS_H
+template <>
+inline float nrm2(const int N, const float* X, const int incX) {
+  return cblas_snrm2(N, X, incX);
+}
+
+template <>
+inline double nrm2(const int N, const double* X, const int incX) {
+  return cblas_dnrm2(N, X, incX);
+}
+
+template <>
+inline float nrm2(const int N, const Complex64* X, const int incX) {
+  return cblas_scnrm2(N, X, incX);
+}
+
+template <>
+inline double nrm2(const int N, const Complex128* X, const int incX) {
+  return cblas_dznrm2(N, X, incX);
+}
+#else
+template <typename FloatDType>
+static inline void nrm2_complex_helper(const FloatDType& xr, const FloatDType& xi, double& scale, double& ssq) {
+  double absx = std::abs(xr);
+  if (scale < absx) {
+    double temp  = scale / absx;
+    scale = absx;
+    ssq   = 1.0 + ssq * (temp * temp);
+  } else {
+    double temp = absx / scale;
+    ssq += temp * temp;
+  }
+
+  absx = std::abs(xi);
+  if (scale < absx) {
+    double temp  = scale / absx;
+    scale = absx;
+    ssq   = 1.0 + ssq * (temp * temp);
+  } else {
+    double temp = absx / scale;
+    ssq += temp * temp;
+  }
+}
+
+template <>
+float nrm2(const int N, const Complex64* X, const int incX) {
+  double scale = 0, ssq = 1, temp;
+
+  if ((N < 1) || (incX < 1))    return 0.0;
+
+  for (int i = 0; i < N; ++i) {
+    nrm2_complex_helper<float>(X[i*incX].r, X[i*incX].i, scale, temp);
+  }
+
+  return scale * std::sqrt( ssq );
+}
+
+template <>
+double nrm2(const int N, const Complex128* X, const int incX) {
+  double scale = 0, ssq = 1, temp;
+
+  if ((N < 1) || (incX < 1))    return 0.0;
+
+  for (int i = 0; i < N; ++i) {
+    nrm2_complex_helper<double>(X[i*incX].r, X[i*incX].i, scale, temp);
+  }
+
+  return scale * std::sqrt( ssq );
+}
+#endif
+
+template <typename ReturnDType, typename DType>
+inline void cblas_nrm2(const int N, const void* X, const int incX, void* result) {
+  *reinterpret_cast<ReturnDType*>( result ) = nrm2<ReturnDType, DType>( N, reinterpret_cast<const DType*>(X), incX );
+}
+
+
+
+}} // end of namespace nm::math
+
+#endif // NRM2_H

data/ext/nmatrix_gemv/math/potrs.h

@@ -0,0 +1,129 @@
+/////////////////////////////////////////////////////////////////////
+// = 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
+//
+// == getrs.h
+//
+// getrs function in native C++.
+//
+
+/*
+ *             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 POTRS_H
+#define POTRS_H
+
+extern "C" {
+#if defined HAVE_CBLAS_H
+  #include <cblas.h>
+#elif defined HAVE_ATLAS_CBLAS_H
+  #include <atlas/cblas.h>
+#endif
+}
+
+namespace nm { namespace math {
+
+/*
+ * Solves a system of linear equations A*X = B with a symmetric positive definite matrix A using the Cholesky factorization computed by POTRF.
+ *
+ * From ATLAS 3.8.0.
+ */
+template <typename DType, bool is_complex>
+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)
+{
+  // enum CBLAS_DIAG Lunit, Uunit; // These aren't used. Not sure why they're declared in ATLAS' src.
+
+  CBLAS_TRANSPOSE MyTrans = is_complex ? CblasConjTrans : CblasTrans;
+
+  if (!N || !NRHS) return 0;
+
+  const DType ONE = 1;
+
+  if (Order == CblasColMajor) {
+    if (Uplo == CblasUpper) {
+      nm::math::trsm<DType>(Order, CblasLeft, CblasUpper, MyTrans, CblasNonUnit, N, NRHS, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, N, NRHS, ONE, A, lda, B, ldb);
+    } else {
+      nm::math::trsm<DType>(Order, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, N, NRHS, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasLeft, CblasLower, MyTrans, CblasNonUnit, N, NRHS, ONE, A, lda, B, ldb);
+    }
+  } else {
+    // There's some kind of scaling operation that normally happens here in ATLAS. Not sure what it does, so we'll only
+    // worry if something breaks. It probably has to do with their non-templated code and doesn't apply to us.
+
+    if (Uplo == CblasUpper) {
+      nm::math::trsm<DType>(Order, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, NRHS, N, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasRight, CblasUpper, MyTrans, CblasNonUnit, NRHS, N, ONE, A, lda, B, ldb);
+    } else {
+      nm::math::trsm<DType>(Order, CblasRight, CblasLower, MyTrans, CblasNonUnit, NRHS, N, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, NRHS, N, ONE, A, lda, B, ldb);
+    }
+  }
+  return 0;
+}
+
+
+/*
+* Function signature conversion for calling LAPACK's potrs functions as directly as possible.
+*
+* For documentation: http://www.netlib.org/lapack/double/dpotrs.f
+*
+* This function should normally go in math.cpp, but we need it to be available to nmatrix.cpp.
+*/
+template <typename DType, bool is_complex>
+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,is_complex>(order, uplo, n, nrhs, reinterpret_cast<const DType*>(a), lda, reinterpret_cast<DType*>(b), ldb);
+}
+
+
+} } // end nm::math
+
+#endif // POTRS_H

data/ext/nmatrix_gemv/math/rot.h

@@ -0,0 +1,141 @@
+/////////////////////////////////////////////////////////////////////
+// = 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
+//
+// == rot.h
+//
+// BLAS rot function in native C++.
+//
+
+/*
+ *             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 ROT_H
+# define ROT_H
+
+namespace nm { namespace math {
+
+// FIXME: This is not working properly for rational numbers. Do we need some kind of symbolic
+// type to handle square roots?
+
+
+// TODO: Test this to see if it works properly on complex. ATLAS has a separate algorithm for complex, which looks like
+// TODO: it may actually be the same one.
+//
+// This function is called ATL_rot in ATLAS 3.8.4.
+template <typename DType>
+inline void rot_helper(const int N, DType* X, const int incX, DType* Y, const int incY, const DType c, const DType s) {
+  if (c != 1 || s != 0) {
+    if (incX == 1 && incY == 1) {
+      for (int i = 0; i != N; ++i) {
+        DType tmp = X[i] * c + Y[i] * s;
+        Y[i]      = Y[i] * c - X[i] * s;
+        X[i]      = tmp;
+      }
+    } else {
+      for (int i = N; i > 0; --i, Y += incY, X += incX) {
+        DType tmp = *X * c + *Y * s;
+        *Y  = *Y * c - *X * s;
+        *X  = tmp;
+      }
+    }
+  }
+}
+
+
+/* Applies a plane rotation. From ATLAS 3.8.4. */
+template <typename DType, typename CSDType>
+inline void rot(const int N, DType* X, const int incX, DType* Y, const int incY, const CSDType c, const CSDType s) {
+  int incx = incX, incy = incY;
+  DType *x = X, *y = Y;
+
+  if (N > 0) {
+    if (incX < 0) {
+      if (incY < 0) { incx = -incx; incy = -incy; }
+      else x += -incX * (N-1);
+    } else if (incY < 0) {
+      incy = -incy;
+      incx = -incx;
+      x += (N-1) * incX;
+    }
+    rot_helper<DType>(N, x, incx, y, incy, c, s);
+  }
+}
+
+template <>
+inline void rot(const int N, float* X, const int incX, float* Y, const int incY, const float c, const float s) {
+  cblas_srot(N, X, incX, Y, incY, (float)c, (float)s);
+}
+
+template <>
+inline void rot(const int N, double* X, const int incX, double* Y, const int incY, const double c, const double s) {
+  cblas_drot(N, X, incX, Y, incY, 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);
+}
+
+
+template <typename DType, typename CSDType>
+inline void cblas_rot(const int N, void* X, const int incX, void* Y, const int incY, const void* c, const void* s) {
+  rot<DType,CSDType>(N, reinterpret_cast<DType*>(X), incX, reinterpret_cast<DType*>(Y), incY,
+                       *reinterpret_cast<const CSDType*>(c), *reinterpret_cast<const CSDType*>(s));
+}
+
+
+} } //nm::math
+
+#endif // ROT_H