scm2cpp-learn 0.18.0__py3-none-win_amd64.whl

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (72) hide show
  1. scm2cpp_learn/__init__.py +3836 -0
  2. scm2cpp_learn/_classifiers.cp312-win_amd64.pyd +0 -0
  3. scm2cpp_learn/_compat.py +284 -0
  4. scm2cpp_learn/_generated/__init__.py +0 -0
  5. scm2cpp_learn/_generated/_loader.py +41 -0
  6. scm2cpp_learn/_generated/_loader_accel_cublas.py +173 -0
  7. scm2cpp_learn/_generated/_loader_classifiers.py +308 -0
  8. scm2cpp_learn/_generated/_loader_derived_blas.py +29 -0
  9. scm2cpp_learn/_generated/_loader_derived_cublas.py +29 -0
  10. scm2cpp_learn/_generated/_loader_derived_loops.py +29 -0
  11. scm2cpp_learn/_generated/_loader_gpu_cuda.py +313 -0
  12. scm2cpp_learn/_generated/_loader_gramops_blas.py +692 -0
  13. scm2cpp_learn/_generated/_loader_gramops_loops.py +711 -0
  14. scm2cpp_learn/_generated/_loader_nmf_blas.py +29 -0
  15. scm2cpp_learn/_generated/_loader_nmf_cublas.py +29 -0
  16. scm2cpp_learn/_generated/_loader_nmf_loops.py +29 -0
  17. scm2cpp_learn/_generated/accel_cublas/accel.cpp +24 -0
  18. scm2cpp_learn/_generated/accel_cublas/accel.hpp +1178 -0
  19. scm2cpp_learn/_generated/accel_cublas/accel_capi.cpp +76 -0
  20. scm2cpp_learn/_generated/classifiers.cpp +37 -0
  21. scm2cpp_learn/_generated/classifiers.hpp +3745 -0
  22. scm2cpp_learn/_generated/classifiers_capi.cpp +115 -0
  23. scm2cpp_learn/_generated/derived_blas/lasso_design.cpp +5 -0
  24. scm2cpp_learn/_generated/derived_blas/lasso_design.hpp +156 -0
  25. scm2cpp_learn/_generated/derived_blas/lasso_design_capi.cpp +19 -0
  26. scm2cpp_learn/_generated/derived_cublas/lasso_design.cpp +5 -0
  27. scm2cpp_learn/_generated/derived_cublas/lasso_design.hpp +158 -0
  28. scm2cpp_learn/_generated/derived_cublas/lasso_design_capi.cpp +19 -0
  29. scm2cpp_learn/_generated/derived_loops/lasso_design.cpp +5 -0
  30. scm2cpp_learn/_generated/derived_loops/lasso_design.hpp +179 -0
  31. scm2cpp_learn/_generated/derived_loops/lasso_design_capi.cpp +19 -0
  32. scm2cpp_learn/_generated/gpu_cuda/gpu.cpp +37 -0
  33. scm2cpp_learn/_generated/gpu_cuda/gpu.hpp +3846 -0
  34. scm2cpp_learn/_generated/gpu_cuda/gpu_capi.cpp +308 -0
  35. scm2cpp_learn/_generated/gramops_blas/gramops.cpp +82 -0
  36. scm2cpp_learn/_generated/gramops_blas/gramops.hpp +5411 -0
  37. scm2cpp_learn/_generated/gramops_blas/gramops_capi.cpp +244 -0
  38. scm2cpp_learn/_generated/gramops_loops/gramops.cpp +82 -0
  39. scm2cpp_learn/_generated/gramops_loops/gramops.hpp +6395 -0
  40. scm2cpp_learn/_generated/gramops_loops/gramops_capi.cpp +250 -0
  41. scm2cpp_learn/_generated/lasso_cov.cpp +7 -0
  42. scm2cpp_learn/_generated/lasso_cov.hpp +152 -0
  43. scm2cpp_learn/_generated/lasso_cov_capi.cpp +25 -0
  44. scm2cpp_learn/_generated/nmf_blas/nmf_cd.cpp +5 -0
  45. scm2cpp_learn/_generated/nmf_blas/nmf_cd.hpp +132 -0
  46. scm2cpp_learn/_generated/nmf_blas/nmf_cd_capi.cpp +19 -0
  47. scm2cpp_learn/_generated/nmf_cublas/nmf_cd.cpp +5 -0
  48. scm2cpp_learn/_generated/nmf_cublas/nmf_cd.hpp +136 -0
  49. scm2cpp_learn/_generated/nmf_cublas/nmf_cd_capi.cpp +19 -0
  50. scm2cpp_learn/_generated/nmf_loops/nmf_cd.cpp +5 -0
  51. scm2cpp_learn/_generated/nmf_loops/nmf_cd.hpp +167 -0
  52. scm2cpp_learn/_generated/nmf_loops/nmf_cd_capi.cpp +19 -0
  53. scm2cpp_learn/_generated/scm2cpp-blas.hpp +158 -0
  54. scm2cpp_learn/_generated/scm2cpp-cublas.hpp +155 -0
  55. scm2cpp_learn/_generated/scm2cpp-cuda.hpp +285 -0
  56. scm2cpp_learn/_generated/scm2cpp.hpp +1627 -0
  57. scm2cpp_learn/_gramops_blas.cp312-win_amd64.pyd +0 -0
  58. scm2cpp_learn/_lasso_cov.cp312-win_amd64.pyd +0 -0
  59. scm2cpp_learn/_lasso_derived_blas.cp312-win_amd64.pyd +0 -0
  60. scm2cpp_learn/_libfind.py +153 -0
  61. scm2cpp_learn/_nmf_blas.cp312-win_amd64.pyd +0 -0
  62. scm2cpp_learn/batch_capi.cu +428 -0
  63. scm2cpp_learn-0.18.0.dist-info/DELVEWHEEL +2 -0
  64. scm2cpp_learn-0.18.0.dist-info/METADATA +1171 -0
  65. scm2cpp_learn-0.18.0.dist-info/RECORD +72 -0
  66. scm2cpp_learn-0.18.0.dist-info/WHEEL +5 -0
  67. scm2cpp_learn-0.18.0.dist-info/top_level.txt +1 -0
  68. scm2cpp_learn.libs/.load-order-scm2cpp_learn-0.18.0 +4 -0
  69. scm2cpp_learn.libs/libopenblas-0486735c359a67419d8832e3c40e2837.dll +4 -0
  70. scm2cpp_learn.libs/msvcp140-73438573e87f9a2fd944b01def13566d.dll +0 -0
  71. scm2cpp_learn.libs/vcruntime140-052ad6a20d375957e82aa6a3c441ea54.dll +0 -0
  72. scm2cpp_learn.libs/vcruntime140_1-a198370e11c6e7469d1cf0ef5b3f433d.dll +0 -0
@@ -0,0 +1,1178 @@
1
+
2
+ #ifndef ACCEL_HPP
3
+ #define ACCEL_HPP
4
+ #define SCM2CPP_MINIMAL
5
+ #include <cmath>
6
+ #include "scm2cpp-cublas.hpp"
7
+ #include <math.h>
8
+ #include <vector>
9
+ #include "scm2cpp.hpp"
10
+
11
+ int
12
+ f_regression( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> r, scm2cpp::span<double> f, int center, int n, int p, int q );
13
+ int
14
+ f_classif( scm2cpp::cspan<double> x, scm2cpp::cspan<int> lab, scm2cpp::span<double> f, int n, int p, int k );
15
+ SCM2CPP_FN double
16
+ min_pos( scm2cpp::cspan<double> v, int m );
17
+ SCM2CPP_FN double
18
+ round_even( double y );
19
+ SCM2CPP_FN int
20
+ cholesky_delete( scm2cpp::span<double> l, int go, int n, int k );
21
+ SCM2CPP_FN int
22
+ swap_rc( scm2cpp::span<double> g, int a, int b, int p );
23
+ int
24
+ lars( scm2cpp::span<double> g, scm2cpp::cspan<double> cov, scm2cpp::span<double> coef, scm2cpp::span<double> path, scm2cpp::span<double> alphas, int rec, double nsamples, double alphamin, int method, int maxiter, double eps, int p );
25
+ SCM2CPP_FN int
26
+ rfe_chol( scm2cpp::cspan<double> g, scm2cpp::cspan<int> idx, scm2cpp::span<double> l, double alpha, int k, int p );
27
+ SCM2CPP_FN int
28
+ rfe_solve( scm2cpp::cspan<double> c, scm2cpp::cspan<int> idx, scm2cpp::span<double> w, scm2cpp::cspan<double> l, int k, int p );
29
+ int
30
+ rfe( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<int> support, scm2cpp::span<int> ranking, double alpha, int nsel, int step, int n, int p );
31
+ SCM2CPP_FN double
32
+ eig_hypot( double a, double b );
33
+ SCM2CPP_FN int
34
+ sym_eigen( scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m );
35
+ SCM2CPP_FN double
36
+ eig_abs( double a );
37
+ SCM2CPP_FN int
38
+ eig_order( scm2cpp::cspan<double> ev, scm2cpp::span<int> ord, int m );
39
+ int
40
+ sym_eigen_top( scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m, int k );
41
+ SCM2CPP_FN int
42
+ sym_eigen_gen( scm2cpp::span<double> a, scm2cpp::span<double> b, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m );
43
+ int
44
+ pca( scm2cpp::cspan<double> x, scm2cpp::span<double> comps, scm2cpp::span<double> ev, scm2cpp::span<double> sv, scm2cpp::span<double> mean, int n, int p );
45
+ SCM2CPP_FN int
46
+ gram_xx( scm2cpp::cspan<double> x, scm2cpp::span<double> g, int n, int p );
47
+ SCM2CPP_FN int
48
+ gram_xy( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> c, int n, int p, int q );
49
+ SCM2CPP_FN int
50
+ spd_solve( scm2cpp::span<double> a, scm2cpp::span<double> b, int m, int q );
51
+ int
52
+ gram_ridge_solve( scm2cpp::cspan<double> g, scm2cpp::span<double> c, double alpha, int m, int q );
53
+
54
+
55
+
56
+ inline int
57
+ f_regression( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> r, scm2cpp::span<double> f, int center, int n, int p, int q )
58
+ { std::vector<double> mx(p,0.0);
59
+ std::vector<double> sx(p,0.0);
60
+ std::vector<double> yc((n*q),0.0);
61
+ std::vector<double> yn(q,0.0);
62
+ double dof = double((n-( ( center == 1 ) ? (2) : (1) )));
63
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
64
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
65
+ double v = x[((i*p)+j)];
66
+ mx[ j ] = (mx[j]+v) ;
67
+ sx[ j ] = (sx[j]+(v*v)) ;
68
+ ;
69
+ } ;
70
+ } ;
71
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
72
+ mx[ j ] = (mx[j]/double(n)) ;
73
+ } ;
74
+ for( int t = 0 ; !(t == q) ; t = (t+1) ) {
75
+ double m = 0.0;
76
+ double s = 0.0;
77
+ if( center == 1 ) {
78
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
79
+ m = (m+y[((i*q)+t)]) ;
80
+ } ;
81
+ m = (m/double(n)) ;
82
+ } else {
83
+ 0 ;
84
+ } ;
85
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
86
+ double v = (y[((i*q)+t)]-m);
87
+ yc[ ((i*q)+t) ] = v ;
88
+ s = (s+(v*v)) ;
89
+ ;
90
+ } ;
91
+ yn[ t ] = sqrt(s) ;
92
+ ;
93
+ } ;
94
+ scm2cpp::device_matrix d6085 = scm2cpp::dmat_upload(x, (n*p), 1);
95
+ scm2cpp::device_matrix d6086 = scm2cpp::dmat_upload(yc, (n*q), 1);
96
+ scm2cpp::blas_gemm(r, d6085, d6086, 1.0, 0.0, 1, 0, p, q, n) ;
97
+ ;
98
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
99
+ double xn = sqrt(( ( center == 1 ) ? ((sx[j]-(double(n)*(mx[j]*mx[j])))) : (sx[j]) ));
100
+ for( int t = 0 ; !(t == q) ; t = (t+1) ) {
101
+ double rr = ((r[((j*q)+t)]/xn)/yn[t]);
102
+ r[ ((j*q)+t) ] = rr ;
103
+ f[ ((j*q)+t) ] = (((rr*rr)/(1.0-(rr*rr)))*dof) ;
104
+ ;
105
+ } ;
106
+ ;
107
+ } ;
108
+ return 0 ;
109
+ }
110
+
111
+
112
+ inline int
113
+ f_classif( scm2cpp::cspan<double> x, scm2cpp::cspan<int> lab, scm2cpp::span<double> f, int n, int p, int k )
114
+ { std::vector<double> oh((n*k),0.0);
115
+ std::vector<double> cs((k*p),0.0);
116
+ std::vector<double> cnt(k,0.0);
117
+ std::vector<double> ss(p,0.0);
118
+ std::vector<double> tot(p,0.0);
119
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
120
+ int c = lab[i];
121
+ oh[ ((i*k)+c) ] = 1.0 ;
122
+ cnt[ c ] = (cnt[c]+1.0) ;
123
+ ;
124
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
125
+ double v = x[((i*p)+j)];
126
+ ss[ j ] = (ss[j]+(v*v)) ;
127
+ ;
128
+ } ;
129
+ } ;
130
+ scm2cpp::device_matrix d6087 = scm2cpp::dmat_upload(oh, (n*k), 1);
131
+ scm2cpp::device_matrix d6088 = scm2cpp::dmat_upload(x, (n*p), 1);
132
+ scm2cpp::blas_gemm(cs, d6087, d6088, 1.0, 0.0, 1, 0, k, p, n) ;
133
+ ;
134
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
135
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
136
+ tot[ j ] = (tot[j]+cs[((c*p)+j)]) ;
137
+ } ;
138
+ } ;
139
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
140
+ double sq = ((tot[j]*tot[j])/double(n));
141
+ double ssbn = 0.0;
142
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
143
+ ssbn = (ssbn+((cs[((c*p)+j)]*cs[((c*p)+j)])/cnt[c])) ;
144
+ } ;
145
+ ssbn = (ssbn-sq) ;
146
+ double sswn = ((ss[j]-sq)-ssbn);
147
+ f[ j ] = ((ssbn/double((k-1)))/(sswn/double((n-k)))) ;
148
+ ;
149
+ ;
150
+ } ;
151
+ return 0 ;
152
+ }
153
+
154
+
155
+ SCM2CPP_FN inline double
156
+ min_pos( scm2cpp::cspan<double> v, int m )
157
+ { double r = 1.7976931348623157e+308;
158
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
159
+ double x = v[i];
160
+ if( (x > 0.0 && x < r) ) {
161
+ r = x ;
162
+ } else {
163
+ 0 ;
164
+ } ;
165
+ ;
166
+ } ;
167
+ return r ;
168
+ }
169
+
170
+
171
+ SCM2CPP_FN inline double
172
+ round_even( double y )
173
+ {
174
+ double r = std::floor(y);
175
+ double d = (y-r);
176
+ if( d > 0.5 ) {
177
+ return (r+1.0) ;
178
+ }
179
+ else {
180
+ if( d < 0.5 ) {
181
+ return r ;
182
+ }
183
+ else {
184
+ if( (2.0*std::floor((0.5*r))) == r ) {
185
+ return r ;
186
+ }
187
+ else {
188
+ return (r+1.0) ;
189
+ }
190
+ }
191
+ }
192
+ }
193
+
194
+
195
+ SCM2CPP_FN inline int
196
+ cholesky_delete( scm2cpp::span<double> l, int go, int n, int k )
197
+ { for( int i = go ; !(i >= (n-1)) ; i = (i+1) ) {
198
+ for( int j = 0 ; !(j == (i+2)) ; j = (j+1) ) {
199
+ l[ ((i*k)+j) ] = l[(((i+1)*k)+j)] ;
200
+ } ;
201
+ } ;
202
+ for( int i = go ; !(i >= (n-1)) ; i = (i+1) ) {
203
+ double a = l[((i*k)+i)];
204
+ double b = l[((i*k)+(i+1))];
205
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
206
+ double ab = ( ( b < 0.0 ) ? ((0.0-b)) : (b) );
207
+ double roe = ( ( aa > ab ) ? (a) : (b) );
208
+ double scale = (aa+ab);
209
+ double r = ( ( scale == 0.0 ) ? (0.0) : ((( ( roe < 0.0 ) ? (-1.0) : (1.0) )*(scale*sqrt((((a/scale)*(a/scale))+((b/scale)*(b/scale))))))) );
210
+ double c = ( ( scale == 0.0 ) ? (1.0) : ((a/r)) );
211
+ double s = ( ( scale == 0.0 ) ? (0.0) : ((b/r)) );
212
+ double cc = ( ( r < 0.0 ) ? ((0.0-c)) : (c) );
213
+ double ss = ( ( r < 0.0 ) ? ((0.0-s)) : (s) );
214
+ l[ ((i*k)+i) ] = ( ( r < 0.0 ) ? ((0.0-r)) : (r) ) ;
215
+ l[ ((i*k)+(i+1)) ] = 0.0 ;
216
+ for( int t = (i+1) ; !(t >= n) ; t = (t+1) ) {
217
+ double x = l[((t*k)+i)];
218
+ double y = l[((t*k)+(i+1))];
219
+ l[ ((t*k)+i) ] = ((cc*x)+(ss*y)) ;
220
+ l[ ((t*k)+(i+1)) ] = ((cc*y)-(ss*x)) ;
221
+ ;
222
+ } ;
223
+ ;
224
+ ;
225
+ ;
226
+ ;
227
+ ;
228
+ ;
229
+ } ;
230
+ return 0 ;
231
+ }
232
+
233
+
234
+ SCM2CPP_FN inline int
235
+ swap_rc( scm2cpp::span<double> g, int a, int b, int p )
236
+ { for( int j = 0 ; !(j == p) ; j = (j+1) ) {
237
+ double rv = g[((a*p)+j)];
238
+ g[ ((a*p)+j) ] = g[((b*p)+j)] ;
239
+ g[ ((b*p)+j) ] = rv ;
240
+ ;
241
+ } ;
242
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
243
+ double cv = g[((j*p)+a)];
244
+ g[ ((j*p)+a) ] = g[((j*p)+b)] ;
245
+ g[ ((j*p)+b) ] = cv ;
246
+ ;
247
+ } ;
248
+ return 0 ;
249
+ }
250
+
251
+
252
+ inline int
253
+ lars( scm2cpp::span<double> g, scm2cpp::cspan<double> cov, scm2cpp::span<double> coef, scm2cpp::span<double> path, scm2cpp::span<double> alphas, int rec, double nsamples, double alphamin, int method, int maxiter, double eps, int p )
254
+ { std::vector<double> g0((p*p),0.0);
255
+ std::vector<double> cov0(p,0.0);
256
+ std::vector<double> cbuf(p,0.0);
257
+ std::vector<int> index(p,0);
258
+ std::vector<int> active(p,0);
259
+ std::vector<double> sign(p,0.0);
260
+ int kmax = ( ( maxiter < p ) ? (maxiter) : (p) );
261
+ std::vector<double> prev(p,0.0);
262
+ std::vector<double> dir(p,0.0);
263
+ std::vector<double> ls(p,0.0);
264
+ std::vector<double> zz(p,0.0);
265
+ std::vector<double> ratio(p,0.0);
266
+ std::vector<int> idx(p,0);
267
+ std::vector<int> dropv(p,0);
268
+ int cs = 0;
269
+ int na = 0;
270
+ int niter = 0;
271
+ int drop = 0;
272
+ int done = 0;
273
+ double alpha = 0.0;
274
+ double prevalpha = 0.0;
275
+ double tiny32 = 1.1754943508222875e-38;
276
+ double eqtol = 1.1920928955078125e-7;
277
+ std::vector<double> l((kmax*kmax),0.0);
278
+ for( int t = 0 ; !(t == (p*p)) ; t = (t+1) ) {
279
+ g0[ t ] = g[t] ;
280
+ } ;
281
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
282
+ cov0[ j ] = cov[j] ;
283
+ cbuf[ j ] = cov[j] ;
284
+ index[ j ] = j ;
285
+ coef[ j ] = 0.0 ;
286
+ if( rec == 1 ) {
287
+ path[ j ] = 0.0 ;
288
+ } else {
289
+ 0 ;
290
+ } ;
291
+ } ;
292
+ for( ; !(done == 1) ; ) {
293
+ int clen = (p-cs);
294
+ int cidx = 0;
295
+ double cval = 0.0;
296
+ double cabs = 0.0;
297
+ for( int t = 0 ; !(t == clen) ; t = (t+1) ) {
298
+ double v = cbuf[(cs+t)];
299
+ double av = ( ( v < 0.0 ) ? ((0.0-v)) : (v) );
300
+ if( av > cabs ) {
301
+ cabs = av ;
302
+ cidx = t ;
303
+ cval = v ;
304
+ } else {
305
+ 0 ;
306
+ } ;
307
+ ;
308
+ ;
309
+ } ;
310
+ alpha = (cabs/(1.0*nsamples)) ;
311
+ if( rec == 1 ) {
312
+ alphas[ niter ] = alpha ;
313
+ } else {
314
+ 0 ;
315
+ } ;
316
+ if( alpha <= (alphamin+eqtol) ) {
317
+ if( ( ( (alpha-alphamin) < 0.0 ) ? ((alphamin-alpha)) : ((alpha-alphamin)) ) > eqtol ) {
318
+ if( niter > 0 ) {
319
+ double ss = ((prevalpha-alphamin)/(prevalpha-alpha));
320
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
321
+ coef[ j ] = (prev[j]+(ss*(coef[j]-prev[j]))) ;
322
+ } ;
323
+ ;
324
+ } else {
325
+ 0 ;
326
+ } ;
327
+ alpha = alphamin ;
328
+ if( rec == 1 ) {
329
+ alphas[ niter ] = alphamin ;
330
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
331
+ path[ ((niter*p)+j) ] = coef[j] ;
332
+ } ;
333
+ } else {
334
+ 0 ;
335
+ } ;
336
+ } else {
337
+ 0 ;
338
+ } ;
339
+ done = 1 ;
340
+ } else {
341
+ if( (niter >= maxiter || na >= p) ) {
342
+ done = 1 ;
343
+ } else {
344
+ int degenerate = 0;
345
+ if( drop == 0 ) {
346
+ int m = na;
347
+ int nn = (cidx+na);
348
+ sign[ na ] = ( ( cval > 0.0 ) ? (1.0) : (( ( cval < 0.0 ) ? (-1.0) : (0.0) )) ) ;
349
+ double tc = cbuf[(cs+cidx)];
350
+ cbuf[ (cs+cidx) ] = cbuf[cs] ;
351
+ cbuf[ cs ] = tc ;
352
+ ;
353
+ int ti = index[nn];
354
+ index[ nn ] = index[m] ;
355
+ index[ m ] = ti ;
356
+ ;
357
+ cs = (cs+1) ;
358
+ swap_rc(g,m,nn,p) ;
359
+ double c = g[((na*p)+na)];
360
+ double v = 0.0;
361
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
362
+ double t = g[((na*p)+i)];
363
+ for( int s = 0 ; !(s == i) ; s = (s+1) ) {
364
+ t = (t-(l[((i*kmax)+s)]*l[((na*kmax)+s)])) ;
365
+ } ;
366
+ double li = (t/l[((i*kmax)+i)]);
367
+ l[ ((na*kmax)+i) ] = li ;
368
+ v = (v+(li*li)) ;
369
+ ;
370
+ ;
371
+ } ;
372
+ double dd = sqrt(( ( (c-v) < 0.0 ) ? ((v-c)) : ((c-v)) ));
373
+ double dg = ( ( dd > (1.0*eps) ) ? (dd) : ((1.0*eps)) );
374
+ l[ ((na*kmax)+na) ] = dg ;
375
+ if( dg < 1e-7 ) {
376
+ cs = (cs-1) ;
377
+ cbuf[ cs ] = 0.0 ;
378
+ double tc = cbuf[(cs+cidx)];
379
+ cbuf[ (cs+cidx) ] = cbuf[cs] ;
380
+ cbuf[ cs ] = tc ;
381
+ ;
382
+ degenerate = 1 ;
383
+ } else {
384
+ active[ na ] = index[na] ;
385
+ na = (na+1) ;
386
+ } ;
387
+ ;
388
+ ;
389
+ ;
390
+ ;
391
+ } else {
392
+ false ;
393
+ } ;
394
+ if( degenerate == 0 ) {
395
+ if( (method == 1 && niter > 0 && prevalpha < alpha) ) {
396
+ done = 1 ;
397
+ } else {
398
+ double aa = 0.0;
399
+ int clen2 = (p-cs);
400
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
401
+ double t = sign[i];
402
+ for( int s = 0 ; !(s == i) ; s = (s+1) ) {
403
+ t = (t-(l[((i*kmax)+s)]*zz[s])) ;
404
+ } ;
405
+ zz[ i ] = (t/l[((i*kmax)+i)]) ;
406
+ ;
407
+ } ;
408
+ for( int ii = 0 ; !(ii == na) ; ii = (ii+1) ) {
409
+ int i = ((na-1)-ii);
410
+ double t = zz[i];
411
+ for( int s = (i+1) ; !(s >= na) ; s = (s+1) ) {
412
+ t = (t-(l[((s*kmax)+i)]*ls[s])) ;
413
+ } ;
414
+ ls[ i ] = (t/l[((i*kmax)+i)]) ;
415
+ ;
416
+ ;
417
+ } ;
418
+ if( (na == 1 && ls[0] == 0.0) ) {
419
+ ls[ 0 ] = 1.0 ;
420
+ aa = 1.0 ;
421
+ } else {
422
+ double sm = 0.0;
423
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
424
+ sm = (sm+(ls[i]*sign[i])) ;
425
+ } ;
426
+ aa = (1.0/sqrt(sm)) ;
427
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
428
+ ls[ i ] = (aa*ls[i]) ;
429
+ } ;
430
+ ;
431
+ } ;
432
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
433
+ double acc = 0.0;
434
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
435
+ acc = (acc+(g[((i*p)+(na+t))]*ls[i])) ;
436
+ } ;
437
+ dir[ t ] = (round_even(double((acc*1e+15)))/1e+15) ;
438
+ ;
439
+ } ;
440
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
441
+ ratio[ t ] = ((cabs-cbuf[(cs+t)])/((aa-dir[t])+tiny32)) ;
442
+ } ;
443
+ double gfirst = min_pos(ratio,clen2);
444
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
445
+ ratio[ t ] = ((cabs+cbuf[(cs+t)])/((aa+dir[t])+tiny32)) ;
446
+ } ;
447
+ double gsecond = min_pos(ratio,clen2);
448
+ double gam = ( ( ( ( gfirst < gsecond ) ? (gfirst) : (gsecond) ) < (cabs/aa) ) ? (( ( gfirst < gsecond ) ? (gfirst) : (gsecond) )) : ((cabs/aa)) );
449
+ int nidx = 0;
450
+ drop = 0 ;
451
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
452
+ zz[ i ] = ((0.0-coef[active[i]])/(ls[i]+tiny32)) ;
453
+ } ;
454
+ double zpos = min_pos(zz,na);
455
+ if( zpos < gam ) {
456
+ for( int ii = 0 ; !(ii == na) ; ii = (ii+1) ) {
457
+ int i = ((na-1)-ii);
458
+ if( zz[i] == zpos ) {
459
+ idx[ nidx ] = i ;
460
+ nidx = (nidx+1) ;
461
+ } else {
462
+ 0 ;
463
+ } ;
464
+ ;
465
+ } ;
466
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
467
+ int i = idx[r];
468
+ sign[ i ] = (0.0-sign[i]) ;
469
+ ;
470
+ } ;
471
+ if( method == 1 ) {
472
+ gam = zpos ;
473
+ } else {
474
+ 0 ;
475
+ } ;
476
+ drop = 1 ;
477
+ } else {
478
+ 0 ;
479
+ } ;
480
+ ;
481
+ niter = (niter+1) ;
482
+ prevalpha = alpha ;
483
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
484
+ prev[ j ] = coef[j] ;
485
+ coef[ j ] = 0.0 ;
486
+ } ;
487
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
488
+ int a = active[i];
489
+ coef[ a ] = (prev[a]+(gam*ls[i])) ;
490
+ ;
491
+ } ;
492
+ if( rec == 1 ) {
493
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
494
+ path[ ((niter*p)+j) ] = coef[j] ;
495
+ } ;
496
+ } else {
497
+ 0 ;
498
+ } ;
499
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
500
+ cbuf[ (cs+t) ] = (cbuf[(cs+t)]-(gam*dir[t])) ;
501
+ } ;
502
+ if( (drop == 1 && method == 1) ) {
503
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
504
+ cholesky_delete(l,idx[r],na,kmax) ;
505
+ } ;
506
+ na = (na-1) ;
507
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
508
+ int ii = idx[r];
509
+ int dropped = active[ii];
510
+ for( int i = ii ; !(i >= na) ; i = (i+1) ) {
511
+ active[ i ] = active[(i+1)] ;
512
+ } ;
513
+ dropv[ r ] = dropped ;
514
+ ;
515
+ ;
516
+ } ;
517
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
518
+ int ii = idx[r];
519
+ for( int i = ii ; !(i >= na) ; i = (i+1) ) {
520
+ int ti = index[i];
521
+ index[ i ] = index[(i+1)] ;
522
+ index[ (i+1) ] = ti ;
523
+ ;
524
+ swap_rc(g,i,int((i+1)),p) ;
525
+ } ;
526
+ ;
527
+ } ;
528
+ for( int rr = 0 ; !(rr == nidx) ; rr = (rr+1) ) {
529
+ int r = ((nidx-1)-rr);
530
+ int d = dropv[r];
531
+ double t = cov0[d];
532
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
533
+ t = (t-(g0[((d*p)+j)]*coef[j])) ;
534
+ } ;
535
+ cs = (cs-1) ;
536
+ cbuf[ cs ] = t ;
537
+ ;
538
+ ;
539
+ ;
540
+ } ;
541
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
542
+ int ii = idx[r];
543
+ for( int i = ii ; !(i >= (p-1)) ; i = (i+1) ) {
544
+ sign[ i ] = sign[(i+1)] ;
545
+ } ;
546
+ sign[ (p-1) ] = 0.0 ;
547
+ ;
548
+ } ;
549
+ } else {
550
+ 0 ;
551
+ } ;
552
+ ;
553
+ ;
554
+ ;
555
+ ;
556
+ } ;
557
+ } else {
558
+ 0 ;
559
+ } ;
560
+ ;
561
+ } ;
562
+ } ;
563
+ ;
564
+ } ;
565
+ ;
566
+ return niter ;
567
+ }
568
+
569
+
570
+ SCM2CPP_FN inline int
571
+ rfe_chol( scm2cpp::cspan<double> g, scm2cpp::cspan<int> idx, scm2cpp::span<double> l, double alpha, int k, int p )
572
+ { for( int j = 0 ; !(j == k) ; j = (j+1) ) {
573
+ double s = (g[((idx[j]*p)+idx[j])]+alpha);
574
+ for( int m = 0 ; !(m == j) ; m = (m+1) ) {
575
+ s = (s-(l[((j*p)+m)]*l[((j*p)+m)])) ;
576
+ } ;
577
+ l[ ((j*p)+j) ] = sqrt(s) ;
578
+ for( int i = (j+1) ; !(i >= k) ; i = (i+1) ) {
579
+ double t = g[((idx[i]*p)+idx[j])];
580
+ for( int m = 0 ; !(m == j) ; m = (m+1) ) {
581
+ t = (t-(l[((i*p)+m)]*l[((j*p)+m)])) ;
582
+ } ;
583
+ l[ ((i*p)+j) ] = (t/l[((j*p)+j)]) ;
584
+ ;
585
+ } ;
586
+ ;
587
+ } ;
588
+ return 0 ;
589
+ }
590
+
591
+
592
+ SCM2CPP_FN inline int
593
+ rfe_solve( scm2cpp::cspan<double> c, scm2cpp::cspan<int> idx, scm2cpp::span<double> w, scm2cpp::cspan<double> l, int k, int p )
594
+ { for( int i = 0 ; !(i == k) ; i = (i+1) ) {
595
+ double t = c[idx[i]];
596
+ for( int m = 0 ; !(m == i) ; m = (m+1) ) {
597
+ t = (t-(l[((i*p)+m)]*w[m])) ;
598
+ } ;
599
+ w[ i ] = (t/l[((i*p)+i)]) ;
600
+ ;
601
+ } ;
602
+ for( int ii = 0 ; !(ii == k) ; ii = (ii+1) ) {
603
+ int i = ((k-1)-ii);
604
+ double t = w[i];
605
+ for( int m = (i+1) ; !(m >= k) ; m = (m+1) ) {
606
+ t = (t-(l[((m*p)+i)]*w[m])) ;
607
+ } ;
608
+ w[ i ] = (t/l[((i*p)+i)]) ;
609
+ ;
610
+ ;
611
+ } ;
612
+ return 0 ;
613
+ }
614
+
615
+
616
+ inline int
617
+ rfe( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<int> support, scm2cpp::span<int> ranking, double alpha, int nsel, int step, int n, int p )
618
+ { std::vector<double> xc((n*p),0.0);
619
+ std::vector<double> yc(n,0.0);
620
+ std::vector<double> mx(p,0.0);
621
+ std::vector<double> g((p*p),0.0);
622
+ std::vector<double> c(p,0.0);
623
+ std::vector<double> l((p*p),0.0);
624
+ std::vector<double> w(p,0.0);
625
+ std::vector<int> idx(p,0);
626
+ std::vector<int> ord(p,0);
627
+ std::vector<int> gone(p,0);
628
+ double ym = 0.0;
629
+ int rounds = 0;
630
+ int k = p;
631
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
632
+ ym = (ym+y[i]) ;
633
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
634
+ mx[ j ] = (mx[j]+x[((i*p)+j)]) ;
635
+ } ;
636
+ } ;
637
+ ym = (ym/double(n)) ;
638
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
639
+ mx[ j ] = (mx[j]/double(n)) ;
640
+ } ;
641
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
642
+ yc[ i ] = (y[i]-ym) ;
643
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
644
+ xc[ ((i*p)+j) ] = (x[((i*p)+j)]-mx[j]) ;
645
+ } ;
646
+ } ;
647
+ scm2cpp::device_matrix d6089 = scm2cpp::dmat_upload(xc, (n*p), 1);
648
+ scm2cpp::blas_syrk(g, d6089, 1.0, 0.0, 1, p, n) ;
649
+ ;
650
+ scm2cpp::device_matrix d6090 = scm2cpp::dmat_upload(xc, (n*p), 1);
651
+ scm2cpp::blas_gemv(c, d6090, yc, 1.0, 0.0, 1, p, n) ;
652
+ ;
653
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
654
+ support[ j ] = 1 ;
655
+ ranking[ j ] = 1 ;
656
+ idx[ j ] = j ;
657
+ } ;
658
+ rfe_chol(g,idx,l,alpha,p,p) ;
659
+ for( ; !(k <= nsel) ; ) {
660
+ rfe_solve(c,idx,w,l,k,p) ;
661
+ for( int i = 0 ; !(i == k) ; i = (i+1) ) {
662
+ double key = (w[i]*w[i]);
663
+ int jj = (i-1);
664
+ for( ; !((jj < 0 || (w[ord[jj]]*w[ord[jj]]) <= key)) ; ) {
665
+ ord[ (jj+1) ] = ord[jj] ;
666
+ jj = (jj-1) ;
667
+ } ;
668
+ ord[ (jj+1) ] = i ;
669
+ ;
670
+ } ;
671
+ int thr = ( ( step < (k-nsel) ) ? (step) : ((k-nsel)) );
672
+ for( int r = 0 ; !(r == thr) ; r = (r+1) ) {
673
+ support[ idx[ord[r]] ] = 0 ;
674
+ } ;
675
+ for( int t = 0 ; !(t == k) ; t = (t+1) ) {
676
+ gone[ t ] = 0 ;
677
+ } ;
678
+ for( int r = 0 ; !(r == thr) ; r = (r+1) ) {
679
+ gone[ ord[r] ] = 1 ;
680
+ } ;
681
+ int cur = k;
682
+ for( int tt = 0 ; !(tt == k) ; tt = (tt+1) ) {
683
+ int pos = ((k-1)-tt);
684
+ if( gone[pos] == 1 ) {
685
+ cholesky_delete(l,pos,cur,p) ;
686
+ for( int u = pos ; !(u >= (cur-1)) ; u = (u+1) ) {
687
+ idx[ u ] = idx[(u+1)] ;
688
+ } ;
689
+ cur = (cur-1) ;
690
+ } else {
691
+ 0 ;
692
+ } ;
693
+ ;
694
+ } ;
695
+ ;
696
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
697
+ if( support[j] == 0 ) {
698
+ ranking[ j ] = (ranking[j]+1) ;
699
+ } else {
700
+ 0 ;
701
+ } ;
702
+ } ;
703
+ k = (k-thr) ;
704
+ rounds = (rounds+1) ;
705
+ ;
706
+ } ;
707
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
708
+ coef[ j ] = 0.0 ;
709
+ } ;
710
+ rfe_solve(c,idx,w,l,k,p) ;
711
+ for( int i = 0 ; !(i == k) ; i = (i+1) ) {
712
+ coef[ idx[i] ] = w[i] ;
713
+ } ;
714
+ return rounds ;
715
+ }
716
+
717
+
718
+ SCM2CPP_FN inline double
719
+ eig_hypot( double a, double b )
720
+ {
721
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
722
+ double bb = ( ( b < 0.0 ) ? ((0.0-b)) : (b) );
723
+ if( aa > bb ) {
724
+ return (aa*sqrt((1.0+((bb/aa)*(bb/aa))))) ;
725
+ }
726
+ else {
727
+ if( bb == 0.0 ) {
728
+ return 0.0 ;
729
+ }
730
+ else {
731
+ return (bb*sqrt((1.0+((aa/bb)*(aa/bb))))) ;
732
+ }
733
+ }
734
+ }
735
+
736
+
737
+ SCM2CPP_FN inline int
738
+ sym_eigen( scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m )
739
+ { for( int ii = 0 ; !(ii == (m-1)) ; ii = (ii+1) ) {
740
+ int i = ((m-1)-ii);
741
+ int l = (i-1);
742
+ double h = 0.0;
743
+ double scale = 0.0;
744
+ if( l > 0 ) {
745
+ for( int k = 0 ; !(k > l) ; k = (k+1) ) {
746
+ double ak = a[((i*m)+k)];
747
+ scale = (scale+( ( ak < 0.0 ) ? ((0.0-ak)) : (ak) )) ;
748
+ ;
749
+ } ;
750
+ if( scale == 0.0 ) {
751
+ e[ i ] = a[((i*m)+l)] ;
752
+ } else {
753
+ for( int k = 0 ; !(k > l) ; k = (k+1) ) {
754
+ a[ ((i*m)+k) ] = (a[((i*m)+k)]/scale) ;
755
+ h = (h+(a[((i*m)+k)]*a[((i*m)+k)])) ;
756
+ } ;
757
+ double f = a[((i*m)+l)];
758
+ double g = ( ( f >= 0.0 ) ? ((0.0-sqrt(h))) : (sqrt(h)) );
759
+ e[ i ] = (scale*g) ;
760
+ h = (h-(f*g)) ;
761
+ a[ ((i*m)+l) ] = (f-g) ;
762
+ double ff = 0.0;
763
+ for( int j = 0 ; !(j > l) ; j = (j+1) ) {
764
+ a[ ((j*m)+i) ] = (a[((i*m)+j)]/h) ;
765
+ double gg = 0.0;
766
+ for( int k = 0 ; !(k > j) ; k = (k+1) ) {
767
+ gg = (gg+(a[((j*m)+k)]*a[((i*m)+k)])) ;
768
+ } ;
769
+ for( int k = (j+1) ; !(k > l) ; k = (k+1) ) {
770
+ gg = (gg+(a[((k*m)+j)]*a[((i*m)+k)])) ;
771
+ } ;
772
+ e[ j ] = (gg/h) ;
773
+ ff = (ff+(e[j]*a[((i*m)+j)])) ;
774
+ ;
775
+ } ;
776
+ double hh = (ff/(h+h));
777
+ for( int j = 0 ; !(j > l) ; j = (j+1) ) {
778
+ double f2 = a[((i*m)+j)];
779
+ double g2 = (e[j]-(hh*f2));
780
+ e[ j ] = g2 ;
781
+ for( int k = 0 ; !(k > j) ; k = (k+1) ) {
782
+ a[ ((j*m)+k) ] = (a[((j*m)+k)]-((f2*e[k])+(g2*a[((i*m)+k)]))) ;
783
+ } ;
784
+ ;
785
+ ;
786
+ } ;
787
+ ;
788
+ ;
789
+ ;
790
+ ;
791
+ } ;
792
+ } else {
793
+ e[ i ] = a[((i*m)+l)] ;
794
+ } ;
795
+ ev[ i ] = h ;
796
+ ;
797
+ ;
798
+ } ;
799
+ ev[ 0 ] = 0.0 ;
800
+ e[ 0 ] = 0.0 ;
801
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
802
+ if( !(ev[i] == 0.0) ) {
803
+ for( int j = 0 ; !(j == i) ; j = (j+1) ) {
804
+ double g3 = 0.0;
805
+ for( int k = 0 ; !(k == i) ; k = (k+1) ) {
806
+ g3 = (g3+(a[((i*m)+k)]*a[((k*m)+j)])) ;
807
+ } ;
808
+ for( int k = 0 ; !(k == i) ; k = (k+1) ) {
809
+ a[ ((k*m)+j) ] = (a[((k*m)+j)]-(g3*a[((k*m)+i)])) ;
810
+ } ;
811
+ ;
812
+ } ;
813
+ } else {
814
+ 0 ;
815
+ } ;
816
+ ev[ i ] = a[((i*m)+i)] ;
817
+ a[ ((i*m)+i) ] = 1.0 ;
818
+ for( int j = 0 ; !(j == i) ; j = (j+1) ) {
819
+ a[ ((j*m)+i) ] = 0.0 ;
820
+ a[ ((i*m)+j) ] = 0.0 ;
821
+ } ;
822
+ } ;
823
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
824
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
825
+ v[ ((j*m)+i) ] = a[((i*m)+j)] ;
826
+ } ;
827
+ } ;
828
+ for( int i = 1 ; !(i == m) ; i = (i+1) ) {
829
+ e[ (i-1) ] = e[i] ;
830
+ } ;
831
+ e[ (m-1) ] = 0.0 ;
832
+ for( int l = 0 ; !(l == m) ; l = (l+1) ) {
833
+ int fin = 0;
834
+ int iter = 0;
835
+ for( ; !((fin == 1 || iter > 60)) ; ) {
836
+ int mm = l;
837
+ int found = 0;
838
+ for( ; !((found == 1 || mm >= (m-1))) ; ) {
839
+ double dd = (eig_abs(ev[mm])+eig_abs(ev[(mm+1)]));
840
+ if( (eig_abs(e[mm])+dd) == dd ) {
841
+ found = 1 ;
842
+ } else {
843
+ mm = (mm+1) ;
844
+ } ;
845
+ ;
846
+ } ;
847
+ if( mm == l ) {
848
+ fin = 1 ;
849
+ } else {
850
+ iter = (iter+1) ;
851
+ double g = ((ev[(l+1)]-ev[l])/(2.0*e[l]));
852
+ double r = eig_hypot(g,1.0);
853
+ double g4 = ((ev[mm]-ev[l])+(e[l]/(g+( ( g >= 0.0 ) ? (eig_abs(r)) : ((0.0-eig_abs(r))) ))));
854
+ double s = 1.0;
855
+ double c = 1.0;
856
+ double pp = 0.0;
857
+ double gq = g4;
858
+ int under = 0;
859
+ int i = (mm-1);
860
+ for( ; !((under == 1 || i < l)) ; ) {
861
+ double f = (s*e[i]);
862
+ double b = (c*e[i]);
863
+ double r2 = eig_hypot(f,gq);
864
+ e[ (i+1) ] = r2 ;
865
+ if( r2 == 0.0 ) {
866
+ ev[ (i+1) ] = (ev[(i+1)]-pp) ;
867
+ e[ mm ] = 0.0 ;
868
+ under = 1 ;
869
+ } else {
870
+ s = (f/r2) ;
871
+ c = (gq/r2) ;
872
+ double g5 = (ev[(i+1)]-pp);
873
+ double r3 = (((ev[i]-g5)*s)+(2.0*(c*b)));
874
+ pp = (s*r3) ;
875
+ ev[ (i+1) ] = (g5+pp) ;
876
+ gq = ((c*r3)-b) ;
877
+ ;
878
+ ;
879
+ for( int k = 0 ; !(k == m) ; k = (k+1) ) {
880
+ double zf = v[(((i+1)*m)+k)];
881
+ double zi = v[((i*m)+k)];
882
+ v[ (((i+1)*m)+k) ] = ((s*zi)+(c*zf)) ;
883
+ v[ ((i*m)+k) ] = ((c*zi)-(s*zf)) ;
884
+ ;
885
+ } ;
886
+ i = (i-1) ;
887
+ } ;
888
+ ;
889
+ ;
890
+ } ;
891
+ if( under == 0 ) {
892
+ ev[ l ] = (ev[l]-pp) ;
893
+ e[ l ] = gq ;
894
+ e[ mm ] = 0.0 ;
895
+ } else {
896
+ 0 ;
897
+ } ;
898
+ ;
899
+ ;
900
+ ;
901
+ ;
902
+ } ;
903
+ ;
904
+ } ;
905
+ ;
906
+ } ;
907
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
908
+ for( int j = (i+1) ; !(j >= m) ; j = (j+1) ) {
909
+ double tmp = v[((i*m)+j)];
910
+ v[ ((i*m)+j) ] = v[((j*m)+i)] ;
911
+ v[ ((j*m)+i) ] = tmp ;
912
+ ;
913
+ } ;
914
+ } ;
915
+ return 0 ;
916
+ }
917
+
918
+
919
+ SCM2CPP_FN inline double
920
+ eig_abs( double a )
921
+ {
922
+ if( a < 0.0 ) {
923
+ return (0.0-a) ;
924
+ }
925
+ else {
926
+ return a ;
927
+ }
928
+ }
929
+
930
+
931
+ SCM2CPP_FN inline int
932
+ eig_order( scm2cpp::cspan<double> ev, scm2cpp::span<int> ord, int m )
933
+ { for( int j = 0 ; !(j == m) ; j = (j+1) ) {
934
+ ord[ j ] = j ;
935
+ } ;
936
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
937
+ int best = j;
938
+ for( int r = (j+1) ; !(r >= m) ; r = (r+1) ) {
939
+ if( ev[ord[r]] > ev[ord[best]] ) {
940
+ best = r ;
941
+ } else {
942
+ 0 ;
943
+ } ;
944
+ } ;
945
+ int tmp = ord[j];
946
+ ord[ j ] = ord[best] ;
947
+ ord[ best ] = tmp ;
948
+ ;
949
+ ;
950
+ } ;
951
+ return 0 ;
952
+ }
953
+
954
+
955
+ inline int
956
+ sym_eigen_top( scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m, int k )
957
+ { std::vector<double> vf((m*m),0.0);
958
+ std::vector<double> evf(m,0.0);
959
+ std::vector<int> ord(m,0);
960
+ sym_eigen(a,vf,evf,e,m) ;
961
+ eig_order(evf,ord,m) ;
962
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
963
+ int col = ord[c];
964
+ ev[ c ] = evf[col] ;
965
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
966
+ v[ ((j*k)+c) ] = vf[((j*m)+col)] ;
967
+ } ;
968
+ ;
969
+ } ;
970
+ return 0 ;
971
+ }
972
+
973
+
974
+ SCM2CPP_FN inline int
975
+ sym_eigen_gen( scm2cpp::span<double> a, scm2cpp::span<double> b, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m )
976
+ { for( int j = 0 ; !(j == m) ; j = (j+1) ) {
977
+ double d = b[((j*m)+j)];
978
+ for( int l = 0 ; !(l == j) ; l = (l+1) ) {
979
+ d = (d-(b[((j*m)+l)]*b[((j*m)+l)])) ;
980
+ } ;
981
+ b[ ((j*m)+j) ] = sqrt(d) ;
982
+ for( int i = (j+1) ; !(i >= m) ; i = (i+1) ) {
983
+ double s = b[((i*m)+j)];
984
+ for( int l = 0 ; !(l == j) ; l = (l+1) ) {
985
+ s = (s-(b[((i*m)+l)]*b[((j*m)+l)])) ;
986
+ } ;
987
+ b[ ((i*m)+j) ] = (s/b[((j*m)+j)]) ;
988
+ ;
989
+ } ;
990
+ ;
991
+ } ;
992
+ for( int c = 0 ; !(c == m) ; c = (c+1) ) {
993
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
994
+ double s = a[((i*m)+c)];
995
+ for( int l = 0 ; !(l == i) ; l = (l+1) ) {
996
+ s = (s-(b[((i*m)+l)]*a[((l*m)+c)])) ;
997
+ } ;
998
+ a[ ((i*m)+c) ] = (s/b[((i*m)+i)]) ;
999
+ ;
1000
+ } ;
1001
+ } ;
1002
+ for( int r = 0 ; !(r == m) ; r = (r+1) ) {
1003
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
1004
+ double s = a[((r*m)+i)];
1005
+ for( int l = 0 ; !(l == i) ; l = (l+1) ) {
1006
+ s = (s-(b[((i*m)+l)]*a[((r*m)+l)])) ;
1007
+ } ;
1008
+ a[ ((r*m)+i) ] = (s/b[((i*m)+i)]) ;
1009
+ ;
1010
+ } ;
1011
+ } ;
1012
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
1013
+ for( int j = 0 ; !(j == i) ; j = (j+1) ) {
1014
+ double s = (0.5*(a[((i*m)+j)]+a[((j*m)+i)]));
1015
+ a[ ((i*m)+j) ] = s ;
1016
+ a[ ((j*m)+i) ] = s ;
1017
+ ;
1018
+ } ;
1019
+ } ;
1020
+ sym_eigen(a,v,ev,e,m) ;
1021
+ for( int c = 0 ; !(c == m) ; c = (c+1) ) {
1022
+ for( int ii = 0 ; !(ii == m) ; ii = (ii+1) ) {
1023
+ int i = ((m-1)-ii);
1024
+ double s = v[((i*m)+c)];
1025
+ for( int l = (i+1) ; !(l >= m) ; l = (l+1) ) {
1026
+ s = (s-(b[((l*m)+i)]*v[((l*m)+c)])) ;
1027
+ } ;
1028
+ v[ ((i*m)+c) ] = (s/b[((i*m)+i)]) ;
1029
+ ;
1030
+ ;
1031
+ } ;
1032
+ } ;
1033
+ return 0 ;
1034
+ }
1035
+
1036
+
1037
+ inline int
1038
+ pca( scm2cpp::cspan<double> x, scm2cpp::span<double> comps, scm2cpp::span<double> ev, scm2cpp::span<double> sv, scm2cpp::span<double> mean, int n, int p )
1039
+ { std::vector<double> c((p*p),0.0);
1040
+ std::vector<double> v((p*p),0.0);
1041
+ std::vector<double> e(p,0.0);
1042
+ std::vector<double> sc(p,0.0);
1043
+ std::vector<int> ord(p,0);
1044
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1045
+ mean[ j ] = 0.0 ;
1046
+ } ;
1047
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
1048
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1049
+ mean[ j ] = (mean[j]+x[((i*p)+j)]) ;
1050
+ } ;
1051
+ } ;
1052
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1053
+ mean[ j ] = (mean[j]/double(n)) ;
1054
+ } ;
1055
+ scm2cpp::device_matrix d6091 = scm2cpp::dmat_upload(x, (n*p), 1);
1056
+ scm2cpp::blas_syrk(c, d6091, 1.0, 0.0, 1, p, n) ;
1057
+ ;
1058
+ for( int i = 0 ; !(i == p) ; i = (i+1) ) {
1059
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1060
+ c[ ((i*p)+j) ] = ((c[((i*p)+j)]-(double(n)*(mean[i]*mean[j])))/double((n-1))) ;
1061
+ } ;
1062
+ } ;
1063
+ sym_eigen(c,v,e,sc,p) ;
1064
+ eig_order(e,ord,p) ;
1065
+ for( int r = 0 ; !(r == p) ; r = (r+1) ) {
1066
+ int col = ord[r];
1067
+ double lam = ( ( e[col] < 0.0 ) ? (0.0) : (e[col]) );
1068
+ int big = 0;
1069
+ double bv = -1.0;
1070
+ ev[ r ] = lam ;
1071
+ sv[ r ] = sqrt((lam*double((n-1)))) ;
1072
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1073
+ double a = v[((j*p)+col)];
1074
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
1075
+ if( aa > bv ) {
1076
+ bv = aa ;
1077
+ big = j ;
1078
+ } else {
1079
+ 0 ;
1080
+ } ;
1081
+ ;
1082
+ ;
1083
+ } ;
1084
+ double sg = ( ( v[((big*p)+col)] < 0.0 ) ? (-1.0) : (1.0) );
1085
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1086
+ comps[ ((r*p)+j) ] = (sg*v[((j*p)+col)]) ;
1087
+ } ;
1088
+ ;
1089
+ ;
1090
+ ;
1091
+ } ;
1092
+ return 0 ;
1093
+ }
1094
+
1095
+
1096
+ SCM2CPP_FN inline int
1097
+ gram_xx( scm2cpp::cspan<double> x, scm2cpp::span<double> g, int n, int p )
1098
+ { scm2cpp::device_matrix d6092 = scm2cpp::dmat_upload(x, (n*p), 1);
1099
+ scm2cpp::blas_syrk(g, d6092, 1.0, 0.0, 1, p, n) ;
1100
+ ;
1101
+ return 0 ;
1102
+ }
1103
+
1104
+
1105
+ SCM2CPP_FN inline int
1106
+ gram_xy( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> c, int n, int p, int q )
1107
+ { scm2cpp::device_matrix d6093 = scm2cpp::dmat_upload(x, (n*p), 1);
1108
+ scm2cpp::device_matrix d6094 = scm2cpp::dmat_upload(y, (n*q), 1);
1109
+ scm2cpp::blas_gemm(c, d6093, d6094, 1.0, 0.0, 1, 0, p, q, n) ;
1110
+ ;
1111
+ return 0 ;
1112
+ }
1113
+
1114
+
1115
+ SCM2CPP_FN inline int
1116
+ spd_solve( scm2cpp::span<double> a, scm2cpp::span<double> b, int m, int q )
1117
+ { int info = 0;
1118
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
1119
+ double d = a[((j*m)+j)];
1120
+ for( int l = 0 ; !(l == j) ; l = (l+1) ) {
1121
+ d = (d-(a[((j*m)+l)]*a[((j*m)+l)])) ;
1122
+ } ;
1123
+ if( d > 0.0 ) {
1124
+ a[ ((j*m)+j) ] = sqrt(d) ;
1125
+ } else {
1126
+ if( info == 0 ) {
1127
+ info = (j+1) ;
1128
+ } else {
1129
+ 0 ;
1130
+ } ;
1131
+ a[ ((j*m)+j) ] = 1.0 ;
1132
+ } ;
1133
+ for( int i = (j+1) ; !(i >= m) ; i = (i+1) ) {
1134
+ double s = a[((i*m)+j)];
1135
+ for( int l = 0 ; !(l == j) ; l = (l+1) ) {
1136
+ s = (s-(a[((i*m)+l)]*a[((j*m)+l)])) ;
1137
+ } ;
1138
+ a[ ((i*m)+j) ] = (s/a[((j*m)+j)]) ;
1139
+ ;
1140
+ } ;
1141
+ ;
1142
+ } ;
1143
+ for( int c = 0 ; !(c == q) ; c = (c+1) ) {
1144
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
1145
+ double s = b[((i*q)+c)];
1146
+ for( int l = 0 ; !(l == i) ; l = (l+1) ) {
1147
+ s = (s-(a[((i*m)+l)]*b[((l*q)+c)])) ;
1148
+ } ;
1149
+ b[ ((i*q)+c) ] = (s/a[((i*m)+i)]) ;
1150
+ ;
1151
+ } ;
1152
+ for( int ii = 0 ; !(ii == m) ; ii = (ii+1) ) {
1153
+ int i = ((m-1)-ii);
1154
+ double s = b[((i*q)+c)];
1155
+ for( int l = (i+1) ; !(l >= m) ; l = (l+1) ) {
1156
+ s = (s-(a[((l*m)+i)]*b[((l*q)+c)])) ;
1157
+ } ;
1158
+ b[ ((i*q)+c) ] = (s/a[((i*m)+i)]) ;
1159
+ ;
1160
+ ;
1161
+ } ;
1162
+ } ;
1163
+ return info ;
1164
+ }
1165
+
1166
+
1167
+ inline int
1168
+ gram_ridge_solve( scm2cpp::cspan<double> g, scm2cpp::span<double> c, double alpha, int m, int q )
1169
+ { std::vector<double> a((m*m),0.0);
1170
+ for( int s = 0 ; !(s == (m*m)) ; s = (s+1) ) {
1171
+ a[ s ] = g[s] ;
1172
+ } ;
1173
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
1174
+ a[ ((j*m)+j) ] = (a[((j*m)+j)]+alpha) ;
1175
+ } ;
1176
+ return spd_solve(a,c,m,q) ;
1177
+ }
1178
+ #endif // ACCEL_HPP