scm2cpp-learn 0.18.0__py3-none-win_amd64.whl

scm2cpp_learn/_generated/nmf_cublas/nmf_cd.hpp

@@ -0,0 +1,136 @@
+
+#ifndef NMF_CD_HPP
+#define NMF_CD_HPP
+#define SCM2CPP_MINIMAL
+#include	"scm2cpp-cublas.hpp"
+#include	<vector>
+#include	"scm2cpp.hpp"
+
+double
+nmf_half( scm2cpp::cspan<double> x,  scm2cpp::span<double> w,  scm2cpp::cspan<double> ht,  int  n,  int  p,  int  k );
+SCM2CPP_FN int
+nmf( scm2cpp::cspan<double> x,  scm2cpp::cspan<double> xt,  scm2cpp::span<double> w,  scm2cpp::span<double> ht,  int  iters,  double  tol,  int  n,  int  p,  int  k );
+
+
+
+inline double
+nmf_half( scm2cpp::cspan<double> x,  scm2cpp::span<double> w,  scm2cpp::cspan<double> ht,  int  n,  int  p,  int  k )
+{   scm2cpp::device_matrix d24299 = scm2cpp::dmat_upload(ht, (p*k), 1);
+    if( k < p ) {
+        double violation = 0.0;
+        std::vector<double> b024287(k,0.0);
+        std::vector<double> g24286((k*k),0.0);
+        std::vector<double> c24285((n*k),0.0);
+        scm2cpp::device_matrix d24297 = scm2cpp::dmat_upload(ht, (p*k), 1);
+        scm2cpp::device_matrix d24298 = scm2cpp::dmat_upload(x, (n*p), 1);
+        scm2cpp::blas_syrk(g24286, d24297, 1.0, 0.0, 1, k, p)  ;
+        scm2cpp::blas_gemm(c24285, d24298, d24297, 1.0, 0.0, 0, 0, n, k, p)  ;
+        scm2cpp::blas_gemm(c24285, scm2cpp::dmat_upload(w, (n*k), 1), scm2cpp::dmat_upload(g24286, (k*k), 1), -1.0, 1.0, 0, 0, n, k, k)  ;
+        for( int t = 0 ; !(t == k) ; t = (t+1) ) {
+            double hess = ([&]() -> double { int i2053 = 0; double r2054 = 0.0; while (!(i2053 == p)) {
+            int i2053_next24303 = (i2053+1);
+                double r2054_next24304 = (r2054+(ht[((i2053*k)+t)]*ht[((i2053*k)+t)]));
+                i2053 = i2053_next24303;
+                r2054 = r2054_next24304;
+            } return r2054; })();
+            for( int i = 0 ; !(i == n) ; i = (i+1) ) {
+                double grad = 0.0;
+                double old = w[((i*k)+t)];
+                grad = (grad-c24285[((i*k)+t)])  ;
+                double pg = ( ( old == 0.0 ) ? (( ( grad < 0.0 ) ? (grad) : (0.0) )) : (grad) );
+                violation = (violation+( ( pg < 0.0 ) ? ((0.0-pg)) : (pg) ))  ;
+                ;
+                if( !(hess == 0.0) ) {
+                    double wnew = (old-(grad/hess));
+                    double wc = ( ( wnew < 0.0 ) ? (0.0) : (wnew) );
+                    w[ ((i*k)+t) ] = wc   ;
+                    if( !(wc == old) ) {
+                        for( int k24289 = 0 ; !(k24289 == k) ; k24289 = (k24289+1) ) {
+                            c24285[ ((i*k)+k24289) ] = (c24285[((i*k)+k24289)]-(g24286[((t*k)+k24289)]*(wc-old)))   ;
+                        }  ;
+                    } else {
+                        false  ;
+                    }  ;
+                    ;
+                    ;
+                } else {
+                    false  ;
+                }  ;
+                ;
+            }  ;
+            ;
+        }  ;
+        0  ;
+        ;
+        ;
+        return violation ;
+    }
+    else {
+        std::vector<double> r((n*p),0.0);
+        for( int i2052 = 0 ; !(i2052 == (n*p)) ; i2052 = (i2052+1) ) {
+            r[ i2052 ] = x[i2052]   ;
+        }  ;
+        scm2cpp::blas_gemm(r, scm2cpp::dmat_upload(w, (n*k), 1), d24299, -1.0, 1.0, 0, 1, n, p, k)  ;
+        double violation = 0.0;
+        for( int t = 0 ; !(t == k) ; t = (t+1) ) {
+            double hess = 0.0;
+            for( int j = 0 ; !(j == p) ; j = (j+1) ) {
+                hess = (hess+(ht[((j*k)+t)]*ht[((j*k)+t)]))  ;
+            }  ;
+            for( int i = 0 ; !(i == n) ; i = (i+1) ) {
+                double grad = 0.0;
+                double old = w[((i*k)+t)];
+                for( int j = 0 ; !(j == p) ; j = (j+1) ) {
+                    grad = (grad-(r[((i*p)+j)]*ht[((j*k)+t)]))  ;
+                }  ;
+                double pg = ( ( old == 0.0 ) ? (( ( grad < 0.0 ) ? (grad) : (0.0) )) : (grad) );
+                violation = (violation+( ( pg < 0.0 ) ? ((0.0-pg)) : (pg) ))  ;
+                ;
+                if( !(hess == 0.0) ) {
+                    double wnew = (old-(grad/hess));
+                    double wc = ( ( wnew < 0.0 ) ? (0.0) : (wnew) );
+                    w[ ((i*k)+t) ] = wc   ;
+                    if( !(wc == old) ) {
+                        for( int j = 0 ; !(j == p) ; j = (j+1) ) {
+                            r[ ((i*p)+j) ] = (r[((i*p)+j)]-(ht[((j*k)+t)]*(wc-old)))   ;
+                        }  ;
+                    } else {
+                        false  ;
+                    }  ;
+                    ;
+                    ;
+                } else {
+                    false  ;
+                }  ;
+                ;
+            }  ;
+            ;
+        }  ;
+        return violation ;
+    }
+}
+
+
+SCM2CPP_FN inline int
+nmf( scm2cpp::cspan<double> x,  scm2cpp::cspan<double> xt,  scm2cpp::span<double> w,  scm2cpp::span<double> ht,  int  iters,  double  tol,  int  n,  int  p,  int  k )
+{   double vinit = 0.0;
+    int stop = 0;
+    int it = 0;
+    for(  ; !((stop == 1 || it >= iters)) ;  ) {
+        it = (it+1)  ;
+        double v = (nmf_half(x,w,ht,n,p,k)+nmf_half(xt,ht,w,p,n,k));
+        if( it == 1 ) {
+            vinit = v  ;
+        } else {
+            0  ;
+        }  ;
+        if( (vinit == 0.0 || (v/vinit) <= tol) ) {
+            stop = 1  ;
+        } else {
+            0  ;
+        }  ;
+        ;
+    }  ;
+    return it ;
+}
+#endif // NMF_CD_HPP

scm2cpp_learn/_generated/nmf_cublas/nmf_cd_capi.cpp

@@ -0,0 +1,19 @@
+// extern "C" wrappers over the translated functions, for Python and
+// any other caller that speaks the C ABI. Array parameters arrive as
+// element pointers: a view parameter takes the pointer as it is, so
+// the caller's buffer is read and written in place with no copy; a
+// fixed-extent one is reinterpreted as the std::array the function
+// expects. The caller guarantees the length either way.
+// Build (boost includes only if the generated header asks for them,
+// which a numeric kernel's does not):
+//   g++ -O2 -std=c++17 -shared -fPIC -I. -o libnmf_cd.so nmf_cd_capi.cpp
+#include "nmf_cd.hpp"
+#include <vector>
+#include <algorithm>
+
+extern "C" double scm2cpp_nmf_half(double* x, double* w, double* ht, int n, int p, int k) {
+  return nmf_half(x, w, ht, n, p, k);
+}
+extern "C" int scm2cpp_nmf(double* x, double* xt, double* w, double* ht, int iters, double tol, int n, int p, int k) {
+  return nmf(x, xt, w, ht, iters, tol, n, p, k);
+}

scm2cpp_learn/_generated/nmf_loops/nmf_cd.cpp

@@ -0,0 +1,5 @@
+
+#include "nmf_cd.hpp"
+// #include "scm2cpp.hpp"
+
+

scm2cpp_learn/_generated/nmf_loops/nmf_cd.hpp

@@ -0,0 +1,167 @@
+
+#ifndef NMF_CD_HPP
+#define NMF_CD_HPP
+#define SCM2CPP_MINIMAL
+#include	<vector>
+#include	"scm2cpp.hpp"
+
+double
+nmf_half( scm2cpp::cspan<double> x,  scm2cpp::span<double> w,  scm2cpp::cspan<double> ht,  int  n,  int  p,  int  k );
+SCM2CPP_FN int
+nmf( scm2cpp::cspan<double> x,  scm2cpp::cspan<double> xt,  scm2cpp::span<double> w,  scm2cpp::span<double> ht,  int  iters,  double  tol,  int  n,  int  p,  int  k );
+
+
+
+inline double
+nmf_half( scm2cpp::cspan<double> x,  scm2cpp::span<double> w,  scm2cpp::cspan<double> ht,  int  n,  int  p,  int  k )
+{   if( k < p ) {
+        double violation = 0.0;
+        std::vector<double> b024287(k,0.0);
+        std::vector<double> g24286((k*k),0.0);
+        std::vector<double> c24285((n*k),0.0);
+        for( int y2059 = 0 ; !(y2059 == k) ; y2059 = (y2059+1) ) {
+            for( int y2060 = 0 ; !(y2060 == k) ; y2060 = (y2060+1) ) {
+                g24286[ ((y2059*k)+y2060) ] = ([&]() -> double { int k2061 = 0; double sum2071 = 0.0; while (!(k2061 == p)) {
+                int k2061_next24297 = (k2061+1);
+                    double sum2071_next24298 = (sum2071+(ht[((k2061*k)+y2060)]*ht[((k2061*k)+y2059)]));
+                    k2061 = k2061_next24297;
+                    sum2071 = sum2071_next24298;
+                } return sum2071; })()   ;
+            }  ;
+        }  ;
+        for( int y2062 = 0 ; !(y2062 == n) ; y2062 = (y2062+1) ) {
+            for( int y2063 = 0 ; !(y2063 == k) ; y2063 = (y2063+1) ) {
+                c24285[ ((y2062*k)+y2063) ] = ([&]() -> double { int k2064 = 0; double sum2073 = 0.0; while (!(k2064 == p)) {
+                int k2064_next24299 = (k2064+1);
+                    double sum2073_next24300 = (sum2073+(x[((y2062*p)+k2064)]*ht[((k2064*k)+y2063)]));
+                    k2064 = k2064_next24299;
+                    sum2073 = sum2073_next24300;
+                } return sum2073; })()   ;
+            }  ;
+        }  ;
+        for( int y2065 = 0 ; !(y2065 == n) ; y2065 = (y2065+1) ) {
+            for( int y2066 = 0 ; !(y2066 == k) ; y2066 = (y2066+1) ) {
+                c24285[ ((y2065*k)+y2066) ] = (c24285[((y2065*k)+y2066)]-([&]() -> double { int k2067 = 0; double sum2075 = 0.0; while (!(k2067 == k)) {
+                int k2067_next24301 = (k2067+1);
+                    double sum2075_next24302 = (sum2075+(w[((y2065*k)+k2067)]*g24286[((k2067*k)+y2066)]));
+                    k2067 = k2067_next24301;
+                    sum2075 = sum2075_next24302;
+                } return sum2075; })())   ;
+            }  ;
+        }  ;
+        for( int t = 0 ; !(t == k) ; t = (t+1) ) {
+            double hess = ([&]() -> double { int i2068 = 0; double r2069 = 0.0; while (!(i2068 == p)) {
+            int i2068_next24303 = (i2068+1);
+                double r2069_next24304 = (r2069+(ht[((i2068*k)+t)]*ht[((i2068*k)+t)]));
+                i2068 = i2068_next24303;
+                r2069 = r2069_next24304;
+            } return r2069; })();
+            for( int i = 0 ; !(i == n) ; i = (i+1) ) {
+                double grad = 0.0;
+                double old = w[((i*k)+t)];
+                grad = (grad-c24285[((i*k)+t)])  ;
+                double pg = ( ( old == 0.0 ) ? (( ( grad < 0.0 ) ? (grad) : (0.0) )) : (grad) );
+                violation = (violation+( ( pg < 0.0 ) ? ((0.0-pg)) : (pg) ))  ;
+                ;
+                if( !(hess == 0.0) ) {
+                    double wnew = (old-(grad/hess));
+                    double wc = ( ( wnew < 0.0 ) ? (0.0) : (wnew) );
+                    w[ ((i*k)+t) ] = wc   ;
+                    if( !(wc == old) ) {
+                        for( int k24289 = 0 ; !(k24289 == k) ; k24289 = (k24289+1) ) {
+                            c24285[ ((i*k)+k24289) ] = (c24285[((i*k)+k24289)]-(g24286[((t*k)+k24289)]*(wc-old)))   ;
+                        }  ;
+                    } else {
+                        false  ;
+                    }  ;
+                    ;
+                    ;
+                } else {
+                    false  ;
+                }  ;
+                ;
+            }  ;
+            ;
+        }  ;
+        0  ;
+        ;
+        return violation ;
+    }
+    else {
+        std::vector<double> r((n*p),0.0);
+        for( int i2052 = 0 ; !(i2052 == (n*p)) ; i2052 = (i2052+1) ) {
+            r[ i2052 ] = x[i2052]   ;
+        }  ;
+        for( int k2053 = 0 ; !(k2053 == n) ; k2053 = (k2053+1) ) {
+            for( int k2054 = 0 ; !(k2054 == p) ; k2054 = (k2054+1) ) {
+                r[ ((k2053*p)+k2054) ] = (r[((k2053*p)+k2054)]-([&]() -> double { int i2056 = 0; double r2057 = 0.0; while (!(i2056 == k)) {
+                int i2056_next24305 = (i2056+1);
+                    double r2057_next24306 = (r2057+(w[((k2053*k)+i2056)]*ht[((k2054*k)+i2056)]));
+                    i2056 = i2056_next24305;
+                    r2057 = r2057_next24306;
+                } return r2057; })())   ;
+            }  ;
+        }  ;
+        double violation = 0.0;
+        for( int t = 0 ; !(t == k) ; t = (t+1) ) {
+            double hess = 0.0;
+            for( int j = 0 ; !(j == p) ; j = (j+1) ) {
+                hess = (hess+(ht[((j*k)+t)]*ht[((j*k)+t)]))  ;
+            }  ;
+            for( int i = 0 ; !(i == n) ; i = (i+1) ) {
+                double grad = 0.0;
+                double old = w[((i*k)+t)];
+                for( int j = 0 ; !(j == p) ; j = (j+1) ) {
+                    grad = (grad-(r[((i*p)+j)]*ht[((j*k)+t)]))  ;
+                }  ;
+                double pg = ( ( old == 0.0 ) ? (( ( grad < 0.0 ) ? (grad) : (0.0) )) : (grad) );
+                violation = (violation+( ( pg < 0.0 ) ? ((0.0-pg)) : (pg) ))  ;
+                ;
+                if( !(hess == 0.0) ) {
+                    double wnew = (old-(grad/hess));
+                    double wc = ( ( wnew < 0.0 ) ? (0.0) : (wnew) );
+                    w[ ((i*k)+t) ] = wc   ;
+                    if( !(wc == old) ) {
+                        for( int j = 0 ; !(j == p) ; j = (j+1) ) {
+                            r[ ((i*p)+j) ] = (r[((i*p)+j)]-(ht[((j*k)+t)]*(wc-old)))   ;
+                        }  ;
+                    } else {
+                        false  ;
+                    }  ;
+                    ;
+                    ;
+                } else {
+                    false  ;
+                }  ;
+                ;
+            }  ;
+            ;
+        }  ;
+        return violation ;
+    }
+}
+
+
+SCM2CPP_FN inline int
+nmf( scm2cpp::cspan<double> x,  scm2cpp::cspan<double> xt,  scm2cpp::span<double> w,  scm2cpp::span<double> ht,  int  iters,  double  tol,  int  n,  int  p,  int  k )
+{   double vinit = 0.0;
+    int stop = 0;
+    int it = 0;
+    for(  ; !((stop == 1 || it >= iters)) ;  ) {
+        it = (it+1)  ;
+        double v = (nmf_half(x,w,ht,n,p,k)+nmf_half(xt,ht,w,p,n,k));
+        if( it == 1 ) {
+            vinit = v  ;
+        } else {
+            0  ;
+        }  ;
+        if( (vinit == 0.0 || (v/vinit) <= tol) ) {
+            stop = 1  ;
+        } else {
+            0  ;
+        }  ;
+        ;
+    }  ;
+    return it ;
+}
+#endif // NMF_CD_HPP

scm2cpp_learn/_generated/nmf_loops/nmf_cd_capi.cpp

@@ -0,0 +1,19 @@
+// extern "C" wrappers over the translated functions, for Python and
+// any other caller that speaks the C ABI. Array parameters arrive as
+// element pointers: a view parameter takes the pointer as it is, so
+// the caller's buffer is read and written in place with no copy; a
+// fixed-extent one is reinterpreted as the std::array the function
+// expects. The caller guarantees the length either way.
+// Build (boost includes only if the generated header asks for them,
+// which a numeric kernel's does not):
+//   g++ -O2 -std=c++17 -shared -fPIC -I. -o libnmf_cd.so nmf_cd_capi.cpp
+#include "nmf_cd.hpp"
+#include <vector>
+#include <algorithm>
+
+extern "C" double scm2cpp_nmf_half(double* x, double* w, double* ht, int n, int p, int k) {
+  return nmf_half(x, w, ht, n, p, k);
+}
+extern "C" int scm2cpp_nmf(double* x, double* xt, double* w, double* ht, int iters, double tol, int n, int p, int k) {
+  return nmf(x, xt, w, ht, iters, tol, n, p, k);
+}

scm2cpp_learn/_generated/scm2cpp-blas.hpp

@@ -0,0 +1,158 @@
+// The contractions of the array algebra as cblas calls: what the ops
+// of bindings/cblas-binding.scm expand to under --blas.
+//
+// Every array is a flat row-major container of doubles (std::vector,
+// boost::array, anything with operator[] over contiguous storage).
+// A contraction whose summed axes sit at the front or the back of
+// each operand is one dgemm over the matrices the other axes flatten
+// to: ta says the left operand is stored k x m (op(a) = a^T) rather
+// than m x k, tb that the right one is stored n x k rather than k x n.
+// Link with -lopenblas or another cblas.
+#ifndef SCM2CPP_BLAS_HPP
+#define SCM2CPP_BLAS_HPP
+
+// SCM2CPP_MKL: Intel MKL's names for the same two interfaces (the
+// package's setup.py defines it when it links MKL)
+// MSVC's C++ has no C99 _Complex, which lapack.h falls back to; it
+// takes std::complex when lapack_complex_* are defined first (nothing
+// here calls a complex routine, so their layout never matters)
+#if defined(_MSC_VER) && !defined(lapack_complex_float)
+#include <complex>
+#define lapack_complex_float std::complex<float>
+#define lapack_complex_double std::complex<double>
+#endif
+#ifdef SCM2CPP_MKL
+#include <mkl_cblas.h>
+#include <mkl_lapacke.h>
+#else
+#include <cblas.h>
+#include <lapacke.h>
+#endif
+#include <cstddef>
+#include <vector>
+
+namespace scm2cpp {
+
+// y (m x n) = alpha op(a) op(b) + beta y.  A product whose m or n is 1
+// at run time (one class of a logistic regression, say) is a dgemv: the
+// vector operand is contiguous either way, and OpenBLAS's dgemm with a
+// unit dimension costs a third more than its dgemv.
+template <class Y, class A, class B>
+inline void blas_gemm(Y& y, const A& a, const B& b, double alpha, double beta,
+                      int ta, int tb, int m, int n, int k) {
+  if (n == 1)
+    cblas_dgemv(CblasRowMajor, ta ? CblasTrans : CblasNoTrans, ta ? k : m, ta ? m : k,
+                alpha, &a[0], ta ? m : k, &b[0], 1, beta, &y[0], 1);
+  else if (m == 1)
+    cblas_dgemv(CblasRowMajor, tb ? CblasNoTrans : CblasTrans, tb ? n : k, tb ? k : n,
+                alpha, &b[0], tb ? k : n, &a[0], 1, beta, &y[0], 1);
+  else
+    cblas_dgemm(CblasRowMajor, ta ? CblasTrans : CblasNoTrans,
+                tb ? CblasTrans : CblasNoTrans, m, n, k,
+                alpha, &a[0], ta ? m : k, &b[0], tb ? k : n, beta, &y[0], n);
+}
+
+// y (m) = alpha op(a) v + beta y   (v k)
+template <class Y, class A, class V>
+inline void blas_gemv(Y& y, const A& a, const V& v, double alpha, double beta,
+                      int ta, int m, int k) {
+  if (ta)
+    cblas_dgemv(CblasRowMajor, CblasTrans, k, m, alpha, &a[0], m, &v[0], 1,
+                beta, &y[0], 1);
+  else
+    cblas_dgemv(CblasRowMajor, CblasNoTrans, m, k, alpha, &a[0], k, &v[0], 1,
+                beta, &y[0], 1);
+}
+
+// batch slabs of the same: y[l] (m x n) = alpha op(a[l]) op(b[l]) +
+// beta y[l] for l below batch, the slabs contiguous (strides m*k,
+// k*n, m*n): a contraction whose leading labels are shared by both
+// operands and the result
+template <class Y, class A, class B>
+inline void blas_gemm_batched(Y& y, const A& a, const B& b, double alpha, double beta,
+                              int ta, int tb, int m, int n, int k, int batch) {
+  for (int l = 0; l < batch; ++l)
+    cblas_dgemm(CblasRowMajor, ta ? CblasTrans : CblasNoTrans,
+                tb ? CblasTrans : CblasNoTrans, m, n, k,
+                alpha, &a[(size_t)l * m * k], ta ? m : k,
+                &b[(size_t)l * k * n], tb ? k : n, beta, &y[(size_t)l * m * n], n);
+}
+
+// y (m x m) = alpha op(a) op(a)^T + beta y: the Gram matrix, one
+// triangle by dsyrk and the other mirrored
+template <class Y, class A>
+inline void blas_syrk(Y& y, const A& a, double alpha, double beta, int ta,
+                      int m, int k) {
+  cblas_dsyrk(CblasRowMajor, CblasUpper, ta ? CblasTrans : CblasNoTrans, m, k,
+              alpha, &a[0], ta ? m : k, beta, &y[0], m);
+  for (int i = 1; i < m; ++i)
+    for (int j = 0; j < i; ++j)
+      y[i * m + j] = y[j * m + i];
+}
+
+// The symmetric eigenproblem as sym-eigen.scm states it: A (m x m,
+// symmetric, row-major) is destroyed, V gets the eigenvectors as
+// columns (V[j m + c] is entry j of vector c), EV the eigenvalues
+// (ascending here; the callers order them themselves).  dsyevd, the
+// divide and conquer that numpy's eigh runs, leaves the vectors in A
+// in exactly that layout.  Returns 0, or LAPACK's info.
+template <class A, class V, class E>
+inline int lapack_syevd(A& a, V& v, E& ev, int m) {
+  int info = LAPACKE_dsyevd(LAPACK_ROW_MAJOR, 'V', 'U', m, &a[0], m, &ev[0]);
+  for (std::size_t t = 0; t < (std::size_t)m * m; ++t) v[t] = a[t];
+  return info;
+}
+
+// The K largest eigenpairs as sym-eigen.scm's sym-eigen-top states
+// them: A (m x m) destroyed, EV the values in decreasing order, V (m x
+// K) the vectors as columns.  dsyevr over the index range m-K+1..m (what
+// scipy's eigh with subset_by_index runs), which gives them increasing;
+// reversed here.  Returns LAPACK's info.
+template <class A, class V, class E>
+inline int lapack_syevr_top(A& a, V& v, E& ev, int m, int k) {
+  if (k <= 0) return 0;
+  std::vector<double> w(m), z((std::size_t)m * k);
+  std::vector<lapack_int> isuppz(2 * (std::size_t)k);
+  lapack_int found = 0;
+  int info = LAPACKE_dsyevr(LAPACK_ROW_MAJOR, 'V', 'I', 'U', m, &a[0], m, 0.0, 0.0,
+                            m - k + 1, m, 0.0, &found, w.data(), z.data(), k, isuppz.data());
+  for (int c = 0; c < k; ++c) {
+    ev[c] = w[k - 1 - c];
+    for (int j = 0; j < m; ++j) v[(std::size_t)j * k + c] = z[(std::size_t)j * k + (k - 1 - c)];
+  }
+  return info;
+}
+
+// A v = lam B v as sym-eigen.scm's sym-eigen-gen states it: A and B
+// (m x m) destroyed, V the vectors as columns with V'BV = I, EV the
+// values (increasing).  dsygvd, itype 1, what scipy's eigh(a, b) runs.
+// Returns LAPACK's info.
+template <class A, class B, class V, class E>
+inline int lapack_sygvd(A& a, B& b, V& v, E& ev, int m) {
+  int info = LAPACKE_dsygvd(LAPACK_ROW_MAJOR, 1, 'V', 'U', m, &a[0], m, &b[0], m, &ev[0]);
+  for (std::size_t t = 0; t < (std::size_t)m * m; ++t) v[t] = a[t];
+  return info;
+}
+
+// A W = B as gram.scm's spd-solve states it: A (m x m, positive
+// definite) destroyed, B (m x q, row-major) overwritten by W.  dposv,
+// what numpy's solve on a positive definite matrix and scipy's
+// cho_solve reach.  Returns LAPACK's info (> 0: not positive definite).
+template <class A, class B>
+inline int lapack_posv(A& a, B& b, int m, int q) {
+  return LAPACKE_dposv(LAPACK_ROW_MAJOR, 'U', m, q, &a[0], m, &b[0], q);
+}
+
+// The thin SVD as sym-svd.scm states it: A (m x n, row-major) is
+// destroyed, S gets the k = min(m, n) values in decreasing order, U the
+// m x k left vectors, VT the k x n right ones.  dgesdd, the divide and
+// conquer that numpy's svd runs, with jobz 'S'.  Returns LAPACK's info.
+template <class A, class U, class S, class VT>
+inline int lapack_gesdd(A& a, U& u, S& s, VT& vt, int m, int n) {
+  int k = m < n ? m : n;
+  return LAPACKE_dgesdd(LAPACK_ROW_MAJOR, 'S', m, n, &a[0], n, &s[0], &u[0], k, &vt[0], n);
+}
+
+}  // namespace scm2cpp
+
+#endif

scm2cpp_learn/_generated/scm2cpp-cublas.hpp

@@ -0,0 +1,155 @@
+// The contractions of the array algebra as cuBLAS calls: what the
+// ops of bindings/cublas-binding.scm expand to under --cublas.
+//
+// The matrix operand of every product is a device_matrix, the copy
+// of a row-major p x n host matrix that dmat_upload takes once at the
+// entry of the scope using it; the vector operands are host
+// containers, copied over per call and the result copied back.  A
+// row-major p x n host matrix is the column-major n x p matrix cuBLAS
+// reads (leading dimension n), so nothing is ever transposed in
+// memory.  The one cuBLAS handle is created on first use.
+// Compile with -I<cuda>/include, link with -lcublas -lcudart.
+#ifndef SCM2CPP_CUBLAS_HPP
+#define SCM2CPP_CUBLAS_HPP
+
+#include <cublas_v2.h>
+#include <cuda_runtime.h>
+#include <cstdio>
+#include <cstdlib>
+#include <memory>
+
+namespace scm2cpp {
+
+inline void cuda_check(cudaError_t e, const char* what) {
+  if (e != cudaSuccess) {
+    std::fprintf(stderr, "scm2cpp-cublas: %s: %s\n", what, cudaGetErrorString(e));
+    std::abort();
+  }
+}
+inline void cublas_check(cublasStatus_t s, const char* what) {
+  if (s != CUBLAS_STATUS_SUCCESS) {
+    std::fprintf(stderr, "scm2cpp-cublas: %s: status %d\n", what, (int)s);
+    std::abort();
+  }
+}
+
+inline cublasHandle_t cublas_handle() {
+  static cublasHandle_t h = 0;
+  if (!h) cublas_check(cublasCreate(&h), "cublasCreate");
+  return h;
+}
+
+// A device copy of len doubles, freed with the last handle to it.
+struct device_buffer {
+  std::shared_ptr<double> d;
+  size_t len;
+  device_buffer() : len(0) {}
+  explicit device_buffer(size_t n) : len(n) {
+    double* p = 0;
+    cuda_check(cudaMalloc((void**)&p, n * sizeof(double)), "cudaMalloc");
+    d.reset(p, cudaFree);
+  }
+  double* get() const { return d.get(); }
+  template <class V>
+  void upload(const V& v) {
+    cuda_check(cudaMemcpy(get(), &v[0], len * sizeof(double), cudaMemcpyHostToDevice),
+               "cudaMemcpy H2D");
+  }
+  template <class V>
+  void download(V& v) const {
+    cuda_check(cudaMemcpy(&v[0], get(), len * sizeof(double), cudaMemcpyDeviceToHost),
+               "cudaMemcpy D2H");
+  }
+};
+
+template <class V>
+inline device_buffer to_device(const V& v, size_t n) {
+  device_buffer b(n);
+  b.upload(v);
+  return b;
+}
+
+// A row-major p x n matrix on the device.
+struct device_matrix {
+  device_buffer buf;
+  int p, n;
+  device_matrix() : p(0), n(0) {}
+  device_matrix(const device_buffer& b, int p_, int n_) : buf(b), p(p_), n(n_) {}
+  double* get() const { return buf.get(); }
+};
+
+template <class X>
+inline device_matrix dmat_upload(const X& x, int p, int n) {
+  return device_matrix(to_device(x, (size_t)p * n), p, n);
+}
+
+// y (m x n host) = alpha op(a) op(b) + beta y, a and b on the device.
+// A row-major m x n array is the column-major n x m array of the same
+// buffer, so the row-major product is the column-major product of the
+// operands swapped: C^T = op(b)^T op(a)^T.
+template <class Y>
+inline void blas_gemm(Y& y, const device_matrix& a, const device_matrix& b,
+                      double alpha, double beta, int ta, int tb, int m, int n, int k) {
+  device_buffer dy = beta != 0.0 ? to_device(y, (size_t)m * n)
+                                 : device_buffer((size_t)m * n);
+  cublas_check(cublasDgemm(cublas_handle(), tb ? CUBLAS_OP_T : CUBLAS_OP_N,
+                           ta ? CUBLAS_OP_T : CUBLAS_OP_N, n, m, k,
+                           &alpha, b.get(), tb ? k : n, a.get(), ta ? m : k,
+                           &beta, dy.get(), n),
+               "cublasDgemm");
+  dy.download(y);
+}
+
+// batch slabs of the same in one call: y[l] (m x n) = alpha op(a[l])
+// op(b[l]) + beta y[l], the slabs contiguous (strides m*k, k*n, m*n)
+template <class Y>
+inline void blas_gemm_batched(Y& y, const device_matrix& a, const device_matrix& b,
+                              double alpha, double beta, int ta, int tb,
+                              int m, int n, int k, int batch) {
+  const size_t total = (size_t)m * n * batch;
+  device_buffer dy = beta != 0.0 ? to_device(y, total) : device_buffer(total);
+  cublas_check(cublasDgemmStridedBatched(
+                   cublas_handle(), tb ? CUBLAS_OP_T : CUBLAS_OP_N,
+                   ta ? CUBLAS_OP_T : CUBLAS_OP_N, n, m, k,
+                   &alpha, b.get(), tb ? k : n, (long long)k * n,
+                   a.get(), ta ? m : k, (long long)m * k,
+                   &beta, dy.get(), n, (long long)m * n, batch),
+               "cublasDgemmStridedBatched");
+  dy.download(y);
+}
+
+// y (m host) = alpha op(a) v + beta y   (a device, v k host)
+template <class Y, class V>
+inline void blas_gemv(Y& y, const device_matrix& a, const V& v, double alpha,
+                      double beta, int ta, int m, int k) {
+  device_buffer dv = to_device(v, k);
+  device_buffer dy = beta != 0.0 ? to_device(y, m) : device_buffer(m);
+  if (ta)
+    cublas_check(cublasDgemv(cublas_handle(), CUBLAS_OP_N, m, k, &alpha, a.get(), m,
+                             dv.get(), 1, &beta, dy.get(), 1), "cublasDgemv");
+  else
+    cublas_check(cublasDgemv(cublas_handle(), CUBLAS_OP_T, k, m, &alpha, a.get(), k,
+                             dv.get(), 1, &beta, dy.get(), 1), "cublasDgemv");
+  dy.download(y);
+}
+
+// y (m x m host) = alpha op(a) op(a)^T + beta y: one triangle by dsyrk
+// over the column-major reading, the other mirrored on the host
+template <class Y>
+inline void blas_syrk(Y& y, const device_matrix& a, double alpha, double beta,
+                      int ta, int m, int k) {
+  device_buffer dy = beta != 0.0 ? to_device(y, (size_t)m * m)
+                                 : device_buffer((size_t)m * m);
+  cublas_check(cublasDsyrk(cublas_handle(), CUBLAS_FILL_MODE_UPPER,
+                           ta ? CUBLAS_OP_N : CUBLAS_OP_T, m, k, &alpha, a.get(),
+                           ta ? m : k, &beta, dy.get(), m),
+               "cublasDsyrk");
+  dy.download(y);
+  for (int i = 0; i < m; ++i)
+    for (int j = i + 1; j < m; ++j)
+      y[i * m + j] = y[j * m + i];
+}
+
+}  // namespace scm2cpp
+
+#endif