scm2cpp-lasso 0.13.2__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 (65) hide show
  1. scm2cpp_lasso/__init__.py +2808 -0
  2. scm2cpp_lasso/_classifiers.cp312-win_amd64.pyd +0 -0
  3. scm2cpp_lasso/_generated/__init__.py +0 -0
  4. scm2cpp_lasso/_generated/_loader.py +41 -0
  5. scm2cpp_lasso/_generated/_loader_accel_cublas.py +140 -0
  6. scm2cpp_lasso/_generated/_loader_classifiers.py +281 -0
  7. scm2cpp_lasso/_generated/_loader_derived_blas.py +29 -0
  8. scm2cpp_lasso/_generated/_loader_derived_cublas.py +29 -0
  9. scm2cpp_lasso/_generated/_loader_derived_loops.py +29 -0
  10. scm2cpp_lasso/_generated/_loader_gpu_cuda.py +294 -0
  11. scm2cpp_lasso/_generated/_loader_gramops_blas.py +496 -0
  12. scm2cpp_lasso/_generated/_loader_gramops_loops.py +496 -0
  13. scm2cpp_lasso/_generated/_loader_nmf_blas.py +29 -0
  14. scm2cpp_lasso/_generated/_loader_nmf_cublas.py +29 -0
  15. scm2cpp_lasso/_generated/_loader_nmf_loops.py +29 -0
  16. scm2cpp_lasso/_generated/accel_cublas/accel.cpp +20 -0
  17. scm2cpp_lasso/_generated/accel_cublas/accel.hpp +1023 -0
  18. scm2cpp_lasso/_generated/accel_cublas/accel_capi.cpp +64 -0
  19. scm2cpp_lasso/_generated/classifiers.cpp +34 -0
  20. scm2cpp_lasso/_generated/classifiers.hpp +2825 -0
  21. scm2cpp_lasso/_generated/classifiers_capi.cpp +106 -0
  22. scm2cpp_lasso/_generated/derived_blas/lasso_design.cpp +5 -0
  23. scm2cpp_lasso/_generated/derived_blas/lasso_design.hpp +153 -0
  24. scm2cpp_lasso/_generated/derived_blas/lasso_design_capi.cpp +19 -0
  25. scm2cpp_lasso/_generated/derived_cublas/lasso_design.cpp +5 -0
  26. scm2cpp_lasso/_generated/derived_cublas/lasso_design.hpp +155 -0
  27. scm2cpp_lasso/_generated/derived_cublas/lasso_design_capi.cpp +19 -0
  28. scm2cpp_lasso/_generated/derived_loops/lasso_design.cpp +5 -0
  29. scm2cpp_lasso/_generated/derived_loops/lasso_design.hpp +176 -0
  30. scm2cpp_lasso/_generated/derived_loops/lasso_design_capi.cpp +19 -0
  31. scm2cpp_lasso/_generated/gpu_cuda/gpu.cpp +35 -0
  32. scm2cpp_lasso/_generated/gpu_cuda/gpu.hpp +3715 -0
  33. scm2cpp_lasso/_generated/gpu_cuda/gpu_capi.cpp +289 -0
  34. scm2cpp_lasso/_generated/gramops_blas/gramops.cpp +57 -0
  35. scm2cpp_lasso/_generated/gramops_blas/gramops.hpp +3033 -0
  36. scm2cpp_lasso/_generated/gramops_blas/gramops_capi.cpp +175 -0
  37. scm2cpp_lasso/_generated/gramops_loops/gramops.cpp +57 -0
  38. scm2cpp_lasso/_generated/gramops_loops/gramops.hpp +3302 -0
  39. scm2cpp_lasso/_generated/gramops_loops/gramops_capi.cpp +175 -0
  40. scm2cpp_lasso/_generated/lasso_cov.cpp +7 -0
  41. scm2cpp_lasso/_generated/lasso_cov.hpp +152 -0
  42. scm2cpp_lasso/_generated/lasso_cov_capi.cpp +25 -0
  43. scm2cpp_lasso/_generated/nmf_blas/nmf_cd.cpp +5 -0
  44. scm2cpp_lasso/_generated/nmf_blas/nmf_cd.hpp +132 -0
  45. scm2cpp_lasso/_generated/nmf_blas/nmf_cd_capi.cpp +19 -0
  46. scm2cpp_lasso/_generated/nmf_cublas/nmf_cd.cpp +5 -0
  47. scm2cpp_lasso/_generated/nmf_cublas/nmf_cd.hpp +136 -0
  48. scm2cpp_lasso/_generated/nmf_cublas/nmf_cd_capi.cpp +19 -0
  49. scm2cpp_lasso/_generated/nmf_loops/nmf_cd.cpp +5 -0
  50. scm2cpp_lasso/_generated/nmf_loops/nmf_cd.hpp +167 -0
  51. scm2cpp_lasso/_generated/nmf_loops/nmf_cd_capi.cpp +19 -0
  52. scm2cpp_lasso/_generated/scm2cpp-blas.hpp +77 -0
  53. scm2cpp_lasso/_generated/scm2cpp-cublas.hpp +155 -0
  54. scm2cpp_lasso/_generated/scm2cpp-cuda.hpp +285 -0
  55. scm2cpp_lasso/_generated/scm2cpp.hpp +1627 -0
  56. scm2cpp_lasso/_gramops_loops.cp312-win_amd64.pyd +0 -0
  57. scm2cpp_lasso/_lasso_cov.cp312-win_amd64.pyd +0 -0
  58. scm2cpp_lasso/_lasso_derived_loops.cp312-win_amd64.pyd +0 -0
  59. scm2cpp_lasso/_libfind.py +149 -0
  60. scm2cpp_lasso/_nmf_loops.cp312-win_amd64.pyd +0 -0
  61. scm2cpp_lasso/batch_capi.cu +428 -0
  62. scm2cpp_lasso-0.13.2.dist-info/METADATA +920 -0
  63. scm2cpp_lasso-0.13.2.dist-info/RECORD +65 -0
  64. scm2cpp_lasso-0.13.2.dist-info/WHEEL +5 -0
  65. scm2cpp_lasso-0.13.2.dist-info/top_level.txt +1 -0
@@ -0,0 +1,3302 @@
1
+
2
+ #ifndef GRAMOPS_HPP
3
+ #define GRAMOPS_HPP
4
+ #define SCM2CPP_MINIMAL
5
+ #include <cmath>
6
+ #include <array>
7
+ #include <math.h>
8
+ #include <vector>
9
+ #include "scm2cpp.hpp"
10
+
11
+ SCM2CPP_FN int
12
+ spd_inverse( scm2cpp::cspan<double> a, scm2cpp::span<double> inv, scm2cpp::span<double> l, scm2cpp::span<double> z, int p );
13
+ SCM2CPP_FN int
14
+ enet_gap( scm2cpp::cspan<double> w, scm2cpp::cspan<double> q, scm2cpp::cspan<double> qw, scm2cpp::span<double> xta, std::array<double,2> & out, double alpha, double ynorm2, int m );
15
+ SCM2CPP_FN int
16
+ enet_safe_rule( scm2cpp::span<double> w, scm2cpp::cspan<double> qm, scm2cpp::span<double> qw, scm2cpp::cspan<double> xta, scm2cpp::span<int> active, scm2cpp::span<int> excl, const std::array<double,2> & out, double alpha, int m );
17
+ SCM2CPP_FN int
18
+ enet_gram( scm2cpp::span<double> w, scm2cpp::cspan<double> qm, scm2cpp::cspan<double> q, scm2cpp::span<double> qw, scm2cpp::span<double> xta, scm2cpp::span<int> active, scm2cpp::span<int> excl, std::array<double,2> & out, double alpha, int maxiter, double tol, int m );
19
+ int
20
+ graphical_lasso( scm2cpp::cspan<double> emp, scm2cpp::span<double> cov, scm2cpp::span<double> prec, double alpha, int maxiter, double tol, double enettol, int p );
21
+ int
22
+ omp( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> path, int rec, int kmax, int n, int p );
23
+ SCM2CPP_FN double
24
+ logistic_fg( scm2cpp::cspan<double> coef, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> z, double l2, int multi, int fitint, int n, int p, int k );
25
+ int
26
+ logistic_lbfgs( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> out, double c, int maxiter, double tol, int multi, int fitint, int n, int p, int k );
27
+ SCM2CPP_FN double
28
+ huber_fg( scm2cpp::cspan<double> coef, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> z, double epsilon, double alpha, int fitint, int n, int p );
29
+ int
30
+ huber( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> out, double epsilon, double alpha, int maxiter, double tol, int fitint, int n, int p );
31
+ SCM2CPP_FN double
32
+ glm_fg( scm2cpp::cspan<double> coef, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> z, int family, double power, double l2, int fitint, int n, int p );
33
+ int
34
+ glm( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> out, int family, double power, double alpha, int maxiter, double tol, int fitint, int n, int p );
35
+ SCM2CPP_FN double
36
+ lb_abs( double a );
37
+ SCM2CPP_FN double
38
+ lb_max( double a, double b );
39
+ SCM2CPP_FN double
40
+ lb_min( double a, double b );
41
+ SCM2CPP_FN int
42
+ lb_dcstep( std::array<double,8> & cs, double fp, double dp, double stpmin, double stpmax );
43
+ SCM2CPP_FN int
44
+ lb_search_start( std::array<double,16> & ls, double f, double g, double stp, double stpmin, double stpmax, double ftol );
45
+ SCM2CPP_FN int
46
+ lb_search_step( std::array<double,16> & ls, std::array<double,8> & cs, double f, double g, double ftol, double gtol, double xtol, double stpmin, double stpmax );
47
+ SCM2CPP_FN double
48
+ lb_dot( scm2cpp::cspan<double> a, scm2cpp::cspan<double> b, int nv );
49
+ SCM2CPP_FN double
50
+ lb_dot_row( scm2cpp::cspan<double> mem, int slot, scm2cpp::cspan<double> v, int nv );
51
+ SCM2CPP_FN double
52
+ lb_dot_rows( scm2cpp::cspan<double> a, int ra, scm2cpp::cspan<double> b, int rb, int nv );
53
+ SCM2CPP_FN double
54
+ lb_projgr( scm2cpp::cspan<double> g, scm2cpp::cspan<double> w, int ib, double lbv, int nv );
55
+ SCM2CPP_FN int
56
+ lb_hv( scm2cpp::span<double> q, scm2cpp::cspan<double> smem, scm2cpp::cspan<double> ymem, scm2cpp::cspan<double> rho, scm2cpp::span<double> al, double theta, int col, int head, int m, int nv );
57
+ SCM2CPP_FN double
58
+ lb_vbv( scm2cpp::cspan<double> v, scm2cpp::cspan<double> smem, scm2cpp::cspan<double> ymem, scm2cpp::cspan<double> rho, scm2cpp::span<double> bm, scm2cpp::span<double> sb, double theta, int col, int head, int m, int nv );
59
+ SCM2CPP_FN int
60
+ lb_direction( scm2cpp::cspan<double> w, scm2cpp::cspan<double> g, scm2cpp::span<double> d, scm2cpp::span<double> q, scm2cpp::span<double> e, scm2cpp::cspan<double> smem, scm2cpp::cspan<double> ymem, scm2cpp::cspan<double> rho, scm2cpp::span<double> al, scm2cpp::span<double> bm, scm2cpp::span<double> sb, double theta, int col, int head, int m, int ib, double lbv, int nv );
61
+ int
62
+ lbfgs( int kind, scm2cpp::span<double> w, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, const std::array<double,4> & aux, scm2cpp::span<double> work, scm2cpp::span<double> out, int m, int maxiter, double pgtol, double ftol, int maxls, int ib, double lbv, int nv, int n, int p, int k );
63
+ SCM2CPP_FN double
64
+ lbfgs_fg( int kind, scm2cpp::cspan<double> w, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, const std::array<double,4> & aux, scm2cpp::span<double> work, int n, int p, int k );
65
+ SCM2CPP_FN int
66
+ gmm_mstep( scm2cpp::cspan<double> x, scm2cpp::cspan<double> resp, scm2cpp::span<double> weights, scm2cpp::span<double> means, scm2cpp::span<double> prec, scm2cpp::span<double> dw, scm2cpp::span<double> cov, scm2cpp::span<double> l, scm2cpp::span<double> u, double reg, int norm, int n, int p, int kc );
67
+ SCM2CPP_FN double
68
+ gmm_estep( scm2cpp::cspan<double> x, scm2cpp::span<double> resp, scm2cpp::cspan<double> weights, scm2cpp::cspan<double> means, scm2cpp::cspan<double> prec, scm2cpp::span<double> wlp, scm2cpp::span<double> y, scm2cpp::span<double> u, scm2cpp::span<double> mu, int n, int p, int kc );
69
+ SCM2CPP_FN double
70
+ gmm_abs( double a );
71
+ int
72
+ gmm( scm2cpp::cspan<double> x, scm2cpp::span<double> resp, scm2cpp::span<double> weights, scm2cpp::span<double> means, scm2cpp::span<double> prec, scm2cpp::span<double> labels, scm2cpp::span<double> out, int maxiter, double tol, double reg, int n, int p, int kc );
73
+ SCM2CPP_FN double
74
+ eig_hypot( double a, double b );
75
+ SCM2CPP_FN int
76
+ sym_eigen( scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m );
77
+ SCM2CPP_FN double
78
+ eig_abs( double a );
79
+ SCM2CPP_FN int
80
+ eig_order( scm2cpp::cspan<double> ev, scm2cpp::span<int> ord, int m );
81
+ SCM2CPP_FN double
82
+ ica_tanh( double x );
83
+ SCM2CPP_FN int
84
+ ica_sym( scm2cpp::span<double> w, scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, scm2cpp::span<double> t, int m );
85
+ int
86
+ fastica( scm2cpp::cspan<double> x, scm2cpp::cspan<double> winit, scm2cpp::span<double> comps, scm2cpp::span<double> white, scm2cpp::span<double> unmix, scm2cpp::span<double> mean, int maxiter, double tol, int n, int p, int nc );
87
+ int
88
+ 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 );
89
+ SCM2CPP_FN int
90
+ ard_pinvh( scm2cpp::span<double> a, scm2cpp::span<double> s, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int k );
91
+ SCM2CPP_FN int
92
+ ard_sigma_coef( scm2cpp::cspan<double> xy, scm2cpp::cspan<int> idx, scm2cpp::cspan<double> lam, scm2cpp::span<double> coef, scm2cpp::span<double> sigma, scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, scm2cpp::cspan<double> gk, double alpha, int k );
93
+ int
94
+ ard( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> sigma, scm2cpp::span<double> lam, scm2cpp::span<double> out, int maxiter, double tol, double alpha1, double alpha2, double lambda1, double lambda2, double thresh, int hoist, int n, int p );
95
+ int
96
+ 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 );
97
+ int
98
+ f_classif( scm2cpp::cspan<double> x, scm2cpp::cspan<int> lab, scm2cpp::span<double> f, int n, int p, int k );
99
+ SCM2CPP_FN double
100
+ min_pos( scm2cpp::cspan<double> v, int m );
101
+ SCM2CPP_FN double
102
+ round_even( double y );
103
+ SCM2CPP_FN int
104
+ cholesky_delete( scm2cpp::span<double> l, int go, int n, int k );
105
+ SCM2CPP_FN int
106
+ swap_rc( scm2cpp::span<double> g, int a, int b, int p );
107
+ int
108
+ 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 );
109
+ SCM2CPP_FN int
110
+ rfe_chol( scm2cpp::cspan<double> g, scm2cpp::cspan<int> idx, scm2cpp::span<double> l, double alpha, int k, int p );
111
+ SCM2CPP_FN int
112
+ rfe_solve( scm2cpp::cspan<double> c, scm2cpp::cspan<int> idx, scm2cpp::span<double> w, scm2cpp::cspan<double> l, int k, int p );
113
+ int
114
+ 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 );
115
+ SCM2CPP_FN int
116
+ gram_xx( scm2cpp::cspan<double> x, scm2cpp::span<double> g, int n, int p );
117
+ SCM2CPP_FN int
118
+ gram_xy( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> c, int n, int p, int q );
119
+
120
+
121
+
122
+ SCM2CPP_FN inline int
123
+ spd_inverse( scm2cpp::cspan<double> a, scm2cpp::span<double> inv, scm2cpp::span<double> l, scm2cpp::span<double> z, int p )
124
+ { for( int j = 0 ; !(j == p) ; j = (j+1) ) {
125
+ double s = a[((j*p)+j)];
126
+ for( int k = 0 ; !(k == j) ; k = (k+1) ) {
127
+ s = (s-(l[((j*p)+k)]*l[((j*p)+k)])) ;
128
+ } ;
129
+ l[ ((j*p)+j) ] = sqrt(s) ;
130
+ for( int i = (j+1) ; !(i >= p) ; i = (i+1) ) {
131
+ double t = a[((i*p)+j)];
132
+ for( int k = 0 ; !(k == j) ; k = (k+1) ) {
133
+ t = (t-(l[((i*p)+k)]*l[((j*p)+k)])) ;
134
+ } ;
135
+ l[ ((i*p)+j) ] = (t/l[((j*p)+j)]) ;
136
+ ;
137
+ } ;
138
+ ;
139
+ } ;
140
+ for( int c = 0 ; !(c == p) ; c = (c+1) ) {
141
+ for( int i = 0 ; !(i == p) ; i = (i+1) ) {
142
+ double t = ( ( i == c ) ? (1.0) : (0.0) );
143
+ for( int k = 0 ; !(k == i) ; k = (k+1) ) {
144
+ t = (t-(l[((i*p)+k)]*z[k])) ;
145
+ } ;
146
+ z[ i ] = (t/l[((i*p)+i)]) ;
147
+ ;
148
+ } ;
149
+ for( int ii = 0 ; !(ii == p) ; ii = (ii+1) ) {
150
+ int i = ((p-1)-ii);
151
+ double t = z[i];
152
+ for( int k = (i+1) ; !(k >= p) ; k = (k+1) ) {
153
+ t = (t-(l[((k*p)+i)]*inv[((k*p)+c)])) ;
154
+ } ;
155
+ inv[ ((i*p)+c) ] = (t/l[((i*p)+i)]) ;
156
+ ;
157
+ ;
158
+ } ;
159
+ } ;
160
+ return 0 ;
161
+ }
162
+
163
+
164
+ SCM2CPP_FN inline int
165
+ enet_gap( scm2cpp::cspan<double> w, scm2cpp::cspan<double> q, scm2cpp::cspan<double> qw, scm2cpp::span<double> xta, std::array<double,2> & out, double alpha, double ynorm2, int m )
166
+ { double qdotw = 0.0;
167
+ double wqw = 0.0;
168
+ double l1 = 0.0;
169
+ double dn = 0.0;
170
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
171
+ double wj = w[j];
172
+ qdotw = (qdotw+(wj*q[j])) ;
173
+ wqw = (wqw+(wj*qw[j])) ;
174
+ l1 = (l1+( ( wj < 0.0 ) ? ((0.0-wj)) : (wj) )) ;
175
+ double x = (q[j]-qw[j]);
176
+ xta[ j ] = x ;
177
+ double ax = ( ( x < 0.0 ) ? ((0.0-x)) : (x) );
178
+ if( ax > dn ) {
179
+ dn = ax ;
180
+ } else {
181
+ 0 ;
182
+ } ;
183
+ ;
184
+ ;
185
+ ;
186
+ } ;
187
+ double rnorm2 = ((ynorm2+wqw)-(2.0*qdotw));
188
+ double ry = (ynorm2-qdotw);
189
+ double scale = ( ( dn > alpha ) ? ((alpha/dn)) : (1.0) );
190
+ out[ 0 ] = (((0.5*rnorm2)+(alpha*l1))-((-0.5*((scale*scale)*rnorm2))+(scale*ry))) ;
191
+ out[ 1 ] = dn ;
192
+ ;
193
+ ;
194
+ ;
195
+ return 0 ;
196
+ }
197
+
198
+
199
+ SCM2CPP_FN inline int
200
+ enet_safe_rule( scm2cpp::span<double> w, scm2cpp::cspan<double> qm, scm2cpp::span<double> qw, scm2cpp::cspan<double> xta, scm2cpp::span<int> active, scm2cpp::span<int> excl, const std::array<double,2> & out, double alpha, int m )
201
+ {
202
+ struct let17060 {
203
+ let17060() {}
204
+ double operator()( double g )
205
+ {
206
+ if( g < 0.0 ) {
207
+ return (0.0-g) ;
208
+ }
209
+ else {
210
+ return g ;
211
+ }
212
+ }
213
+ } ;
214
+ double radius = (sqrt((2.0*let17060()(out[0])))/alpha);
215
+ double dn = out[1];
216
+ int nact = 0;
217
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
218
+ if( excl[j] == 0 ) {
219
+ double xjt = (xta[j]/( ( alpha > dn ) ? (alpha) : (dn) ));
220
+ double dj = ((1.0-( ( xjt < 0.0 ) ? ((0.0-xjt)) : (xjt) ))/sqrt(qm[((j*m)+j)]));
221
+ if( dj <= radius ) {
222
+ active[ nact ] = j ;
223
+ nact = (nact+1) ;
224
+ } else {
225
+ if( !(w[j] == 0.0) ) {
226
+ double wj = w[j];
227
+ for( int r = 0 ; !(r == m) ; r = (r+1) ) {
228
+ qw[ r ] = (qw[r]-(wj*qm[((j*m)+r)])) ;
229
+ } ;
230
+ w[ j ] = 0.0 ;
231
+ ;
232
+ } else {
233
+ 0 ;
234
+ } ;
235
+ excl[ j ] = 1 ;
236
+ } ;
237
+ ;
238
+ ;
239
+ } else {
240
+ 0 ;
241
+ } ;
242
+ } ;
243
+ return nact ;
244
+ }
245
+
246
+
247
+ SCM2CPP_FN inline int
248
+ enet_gram( scm2cpp::span<double> w, scm2cpp::cspan<double> qm, scm2cpp::cspan<double> q, scm2cpp::span<double> qw, scm2cpp::span<double> xta, scm2cpp::span<int> active, scm2cpp::span<int> excl, std::array<double,2> & out, double alpha, int maxiter, double tol, int m )
249
+ { double ynorm2 = 0.0;
250
+ double dwtol = tol;
251
+ int nact = 0;
252
+ int done = 0;
253
+ int iter = 0;
254
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
255
+ ynorm2 = (ynorm2+(q[j]*q[j])) ;
256
+ excl[ j ] = 0 ;
257
+ } ;
258
+ for( int k2493 = 0 ; !(k2493 == m) ; k2493 = (k2493+1) ) {
259
+ qw[ k2493 ] = ([&]() -> double { int i2496 = 0; double r2497 = 0.0; while (!(i2496 == m)) {
260
+ int i2496_next17088 = (i2496+1);
261
+ double r2497_next17089 = (r2497+(qm[((k2493*m)+i2496)]*w[i2496]));
262
+ i2496 = i2496_next17088;
263
+ r2497 = r2497_next17089;
264
+ } return r2497; })() ;
265
+ } ;
266
+ double gtol = (tol*ynorm2);
267
+ enet_gap(w,q,qw,xta,out,alpha,ynorm2,m) ;
268
+ if( (out[0] >= 0.0 && out[0] <= gtol) ) {
269
+ done = 1 ;
270
+ } else {
271
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
272
+ if( qm[((j*m)+j)] == 0.0 ) {
273
+ w[ j ] = 0.0 ;
274
+ excl[ j ] = 1 ;
275
+ } else {
276
+ 0 ;
277
+ } ;
278
+ } ;
279
+ nact = enet_safe_rule(w,qm,qw,xta,active,excl,out,alpha,m) ;
280
+ } ;
281
+ for( ; !((done == 1 || iter >= maxiter)) ; ) {
282
+ double wmax = 0.0;
283
+ double dwmax = 0.0;
284
+ for( int f = 0 ; !(f == nact) ; f = (f+1) ) {
285
+ int j = active[f];
286
+ double qjj = qm[((j*m)+j)];
287
+ if( !(qjj == 0.0) ) {
288
+ double wj = w[j];
289
+ double tmp = ((q[j]-qw[j])+(wj*qjj));
290
+ double mag = (( ( tmp < 0.0 ) ? ((0.0-tmp)) : (tmp) )-alpha);
291
+ double wn = ( ( mag > 0.0 ) ? ((( ( tmp < 0.0 ) ? ((0.0-mag)) : (mag) )/qjj)) : (0.0) );
292
+ w[ j ] = wn ;
293
+ if( !(wn == wj) ) {
294
+ for( int r = 0 ; !(r == m) ; r = (r+1) ) {
295
+ qw[ r ] = (qw[r]+((wn-wj)*qm[((j*m)+r)])) ;
296
+ } ;
297
+ } else {
298
+ 0 ;
299
+ } ;
300
+ double dw = ( ( wn < wj ) ? ((wj-wn)) : ((wn-wj)) );
301
+ double aw = ( ( wn < 0.0 ) ? ((0.0-wn)) : (wn) );
302
+ if( dw > dwmax ) {
303
+ dwmax = dw ;
304
+ } else {
305
+ 0 ;
306
+ } ;
307
+ if( aw > wmax ) {
308
+ wmax = aw ;
309
+ } else {
310
+ 0 ;
311
+ } ;
312
+ ;
313
+ ;
314
+ ;
315
+ ;
316
+ ;
317
+ } else {
318
+ 0 ;
319
+ } ;
320
+ ;
321
+ ;
322
+ } ;
323
+ if( (wmax == 0.0 || (dwmax/wmax) <= dwtol || iter == (maxiter-1)) ) {
324
+ enet_gap(w,q,qw,xta,out,alpha,ynorm2,m) ;
325
+ if( out[0] <= gtol ) {
326
+ done = 1 ;
327
+ } else {
328
+ nact = enet_safe_rule(w,qm,qw,xta,active,excl,out,alpha,m) ;
329
+ } ;
330
+ } else {
331
+ 0 ;
332
+ } ;
333
+ iter = (iter+1) ;
334
+ ;
335
+ } ;
336
+ ;
337
+ return iter ;
338
+ }
339
+
340
+
341
+ inline int
342
+ graphical_lasso( scm2cpp::cspan<double> emp, scm2cpp::span<double> cov, scm2cpp::span<double> prec, double alpha, int maxiter, double tol, double enettol, int p )
343
+ { int m = (p-1);
344
+ std::vector<double> sub((m*m),0.0);
345
+ std::vector<double> row(m,0.0);
346
+ std::vector<double> b(m,0.0);
347
+ std::vector<double> bnew(m,0.0);
348
+ std::vector<double> qw(m,0.0);
349
+ std::vector<double> xta(m,0.0);
350
+ std::vector<int> active(m,0);
351
+ std::vector<int> excl(m,0);
352
+ std::array<double,2> out = scm2cpp::filled_array<double,2>(0.0);
353
+ std::vector<double> l((p*p),0.0);
354
+ std::vector<double> z(p,0.0);
355
+ int done = 0;
356
+ int it = 0;
357
+ int innermax = ( ( maxiter > 20 ) ? (maxiter) : (20) );
358
+ for( int i = 0 ; !(i == p) ; i = (i+1) ) {
359
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
360
+ cov[ ((i*p)+j) ] = ( ( i == j ) ? (emp[((i*p)+j)]) : ((0.95*emp[((i*p)+j)])) ) ;
361
+ } ;
362
+ } ;
363
+ spd_inverse(cov,prec,l,z,p) ;
364
+ for( ; !((done == 1 || it >= maxiter)) ; ) {
365
+ for( int idx = 0 ; !(idx == p) ; idx = (idx+1) ) {
366
+ if( idx > 0 ) {
367
+ int di = (idx-1);
368
+ for( int s = 0 ; !(s == m) ; s = (s+1) ) {
369
+ int o = ( ( s < idx ) ? (s) : ((s+1)) );
370
+ sub[ ((di*m)+s) ] = cov[((di*p)+o)] ;
371
+ sub[ ((s*m)+di) ] = cov[((o*p)+di)] ;
372
+ ;
373
+ } ;
374
+ ;
375
+ } else {
376
+ for( int s = 0 ; !(s == m) ; s = (s+1) ) {
377
+ for( int t = 0 ; !(t == m) ; t = (t+1) ) {
378
+ sub[ ((s*m)+t) ] = cov[(((s+1)*p)+(t+1))] ;
379
+ } ;
380
+ } ;
381
+ } ;
382
+ double pii = prec[((idx*p)+idx)];
383
+ for( int s = 0 ; !(s == m) ; s = (s+1) ) {
384
+ int o = ( ( s < idx ) ? (s) : ((s+1)) );
385
+ row[ s ] = emp[((idx*p)+o)] ;
386
+ b[ s ] = (0.0-(prec[((o*p)+idx)]/(pii+(1000.0*2.220446049250313e-16)))) ;
387
+ ;
388
+ } ;
389
+ ;
390
+ enet_gram(b,sub,row,qw,xta,active,excl,out,alpha,innermax,enettol,m) ;
391
+ double acc = 0.0;
392
+ for( int s = 0 ; !(s == m) ; s = (s+1) ) {
393
+ int o = ( ( s < idx ) ? (s) : ((s+1)) );
394
+ acc = (acc+(cov[((o*p)+idx)]*b[s])) ;
395
+ ;
396
+ } ;
397
+ double pnew = (1.0/(cov[((idx*p)+idx)]-acc));
398
+ prec[ ((idx*p)+idx) ] = pnew ;
399
+ for( int s = 0 ; !(s == m) ; s = (s+1) ) {
400
+ int o = ( ( s < idx ) ? (s) : ((s+1)) );
401
+ prec[ ((o*p)+idx) ] = (0.0-(pnew*b[s])) ;
402
+ prec[ ((idx*p)+o) ] = (0.0-(pnew*b[s])) ;
403
+ ;
404
+ } ;
405
+ ;
406
+ ;
407
+ for( int k2500 = 0 ; !(k2500 == m) ; k2500 = (k2500+1) ) {
408
+ bnew[ k2500 ] = ([&]() -> double { int i2503 = 0; double r2504 = 0.0; while (!(i2503 == m)) {
409
+ int i2503_next17090 = (i2503+1);
410
+ double r2504_next17091 = (r2504+(sub[((k2500*m)+i2503)]*b[i2503]));
411
+ i2503 = i2503_next17090;
412
+ r2504 = r2504_next17091;
413
+ } return r2504; })() ;
414
+ } ;
415
+ for( int s = 0 ; !(s == m) ; s = (s+1) ) {
416
+ int o = ( ( s < idx ) ? (s) : ((s+1)) );
417
+ cov[ ((idx*p)+o) ] = bnew[s] ;
418
+ cov[ ((o*p)+idx) ] = bnew[s] ;
419
+ ;
420
+ } ;
421
+ } ;
422
+ double tr = 0.0;
423
+ double offl1 = 0.0;
424
+ for( int i = 0 ; !(i == p) ; i = (i+1) ) {
425
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
426
+ double t = prec[((i*p)+j)];
427
+ tr = (tr+(emp[((i*p)+j)]*t)) ;
428
+ if( !(i == j) ) {
429
+ offl1 = (offl1+( ( t < 0.0 ) ? ((0.0-t)) : (t) )) ;
430
+ } else {
431
+ 0 ;
432
+ } ;
433
+ ;
434
+ } ;
435
+ } ;
436
+ double gap = ((tr-(1.0*p))+(alpha*offl1));
437
+ it = (it+1) ;
438
+ if( ( ( gap < 0.0 ) ? ((0.0-gap)) : (gap) ) < tol ) {
439
+ done = 1 ;
440
+ } else {
441
+ 0 ;
442
+ } ;
443
+ ;
444
+ ;
445
+ } ;
446
+ return it ;
447
+ }
448
+
449
+
450
+ inline int
451
+ omp( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> path, int rec, int kmax, int n, int p )
452
+ { std::vector<double> g((p*p),0.0);
453
+ std::vector<double> xy(p,0.0);
454
+ std::vector<double> alpha(p,0.0);
455
+ std::vector<double> beta(p,0.0);
456
+ std::vector<int> index(p,0);
457
+ std::vector<double> l((kmax*kmax),0.0);
458
+ std::vector<double> gamma(kmax,0.0);
459
+ std::vector<double> z(kmax,0.0);
460
+ double eps = 2.220446049250313e-16;
461
+ int na = 0;
462
+ int done = 0;
463
+ for( int k2507 = 0 ; !(k2507 == p) ; k2507 = (k2507+1) ) {
464
+ for( int k2508 = k2507 ; !(k2508 == p) ; k2508 = (k2508+1) ) {
465
+ g[ ((k2507*p)+k2508) ] = ([&]() -> double { int i2510 = 0; double r2511 = 0.0; while (!(i2510 == n)) {
466
+ int i2510_next17092 = (i2510+1);
467
+ double r2511_next17093 = (r2511+(x[((i2510*p)+k2507)]*x[((i2510*p)+k2508)]));
468
+ i2510 = i2510_next17092;
469
+ r2511 = r2511_next17093;
470
+ } return r2511; })() ;
471
+ g[ ((k2508*p)+k2507) ] = g[((k2507*p)+k2508)] ;
472
+ } ;
473
+ } ;
474
+ for( int i2515 = 0 ; !(i2515 == p) ; i2515 = (i2515+1) ) {
475
+ xy[ i2515 ] = 0.0 ;
476
+ } ;
477
+ for( int k2513 = 0 ; !(k2513 == n) ; k2513 = (k2513+1) ) {
478
+ for( int i2516 = 0 ; !(i2516 == p) ; i2516 = (i2516+1) ) {
479
+ xy[ i2516 ] = (xy[i2516]+(x[((k2513*p)+i2516)]*y[k2513])) ;
480
+ } ;
481
+ } ;
482
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
483
+ index[ j ] = j ;
484
+ alpha[ j ] = xy[j] ;
485
+ } ;
486
+ for( ; !(done == 1) ; ) {
487
+ int lam = 0;
488
+ double best = -1.0;
489
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
490
+ double a = alpha[j];
491
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
492
+ if( aa > best ) {
493
+ best = aa ;
494
+ lam = j ;
495
+ } else {
496
+ 0 ;
497
+ } ;
498
+ ;
499
+ ;
500
+ } ;
501
+ if( (lam < na || (alpha[lam]*alpha[lam]) < eps) ) {
502
+ done = 1 ;
503
+ } else {
504
+ if( na > 0 ) {
505
+ double v = 0.0;
506
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
507
+ double t = g[((lam*p)+i)];
508
+ for( int s = 0 ; !(s == i) ; s = (s+1) ) {
509
+ t = (t-(l[((i*kmax)+s)]*l[((na*kmax)+s)])) ;
510
+ } ;
511
+ double li = (t/l[((i*kmax)+i)]);
512
+ l[ ((na*kmax)+i) ] = li ;
513
+ v = (v+(li*li)) ;
514
+ ;
515
+ ;
516
+ } ;
517
+ double lkk = (g[((lam*p)+lam)]-v);
518
+ if( lkk <= eps ) {
519
+ done = 1 ;
520
+ } else {
521
+ l[ ((na*kmax)+na) ] = sqrt(lkk) ;
522
+ } ;
523
+ ;
524
+ ;
525
+ } else {
526
+ l[ 0 ] = sqrt(g[((lam*p)+lam)]) ;
527
+ } ;
528
+ if( done == 0 ) {
529
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
530
+ double grow = g[((na*p)+j)];
531
+ g[ ((na*p)+j) ] = g[((lam*p)+j)] ;
532
+ g[ ((lam*p)+j) ] = grow ;
533
+ ;
534
+ } ;
535
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
536
+ double gcol = g[((j*p)+na)];
537
+ g[ ((j*p)+na) ] = g[((j*p)+lam)] ;
538
+ g[ ((j*p)+lam) ] = gcol ;
539
+ ;
540
+ } ;
541
+ int itmp = index[na];
542
+ index[ na ] = index[lam] ;
543
+ index[ lam ] = itmp ;
544
+ ;
545
+ double xtmp = xy[na];
546
+ xy[ na ] = xy[lam] ;
547
+ xy[ lam ] = xtmp ;
548
+ ;
549
+ na = (na+1) ;
550
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
551
+ double t = xy[i];
552
+ for( int s = 0 ; !(s == i) ; s = (s+1) ) {
553
+ t = (t-(l[((i*kmax)+s)]*z[s])) ;
554
+ } ;
555
+ z[ i ] = (t/l[((i*kmax)+i)]) ;
556
+ ;
557
+ } ;
558
+ for( int ii = 0 ; !(ii == na) ; ii = (ii+1) ) {
559
+ int i = ((na-1)-ii);
560
+ double t = z[i];
561
+ for( int s = (i+1) ; !(s >= na) ; s = (s+1) ) {
562
+ t = (t-(l[((s*kmax)+i)]*gamma[s])) ;
563
+ } ;
564
+ gamma[ i ] = (t/l[((i*kmax)+i)]) ;
565
+ ;
566
+ ;
567
+ } ;
568
+ if( rec == 1 ) {
569
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
570
+ path[ (((na-1)*p)+j) ] = 0.0 ;
571
+ } ;
572
+ for( int s = 0 ; !(s == na) ; s = (s+1) ) {
573
+ path[ (((na-1)*p)+index[s]) ] = gamma[s] ;
574
+ } ;
575
+ } else {
576
+ 0 ;
577
+ } ;
578
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
579
+ double acc = 0.0;
580
+ for( int s = 0 ; !(s == na) ; s = (s+1) ) {
581
+ acc = (acc+(g[((j*p)+s)]*gamma[s])) ;
582
+ } ;
583
+ beta[ j ] = acc ;
584
+ alpha[ j ] = (xy[j]-acc) ;
585
+ ;
586
+ } ;
587
+ if( na == kmax ) {
588
+ done = 1 ;
589
+ } else {
590
+ 0 ;
591
+ } ;
592
+ } else {
593
+ 0 ;
594
+ } ;
595
+ } ;
596
+ ;
597
+ } ;
598
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
599
+ coef[ j ] = 0.0 ;
600
+ } ;
601
+ for( int s = 0 ; !(s == na) ; s = (s+1) ) {
602
+ coef[ index[s] ] = gamma[s] ;
603
+ } ;
604
+ return na ;
605
+ }
606
+
607
+
608
+ SCM2CPP_FN inline double
609
+ logistic_fg( scm2cpp::cspan<double> coef, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> z, double l2, int multi, int fitint, int n, int p, int k )
610
+ { double loss = 0.0;
611
+ double pen = 0.0;
612
+ for( int k2518 = 0 ; !(k2518 == n) ; k2518 = (k2518+1) ) {
613
+ for( int k2519 = 0 ; !(k2519 == k) ; k2519 = (k2519+1) ) {
614
+ z[ ((k2518*k)+k2519) ] = ([&]() -> double { int i2521 = 0; double r2522 = 0.0; while (!(i2521 == p)) {
615
+ int i2521_next17094 = (i2521+1);
616
+ double r2522_next17095 = (r2522+(x[((k2518*p)+i2521)]*coef[((k2519*p)+i2521)]));
617
+ i2521 = i2521_next17094;
618
+ r2522 = r2522_next17095;
619
+ } return r2522; })() ;
620
+ } ;
621
+ } ;
622
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
623
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
624
+ z[ ((i*k)+c) ] = (z[((i*k)+c)]+coef[((k*p)+c)]) ;
625
+ } ;
626
+ } ;
627
+ if( multi == 0 ) {
628
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
629
+ double zi = z[i];
630
+ double yi = y[i];
631
+ if( zi <= -2.0 ) {
632
+ double e1 = exp(zi);
633
+ if( zi <= -37.0 ) {
634
+ loss = (loss+(e1-(yi*zi))) ;
635
+ z[ i ] = (e1-yi) ;
636
+ } else {
637
+ loss = (loss+(log((1.0+e1))-(yi*zi))) ;
638
+ z[ i ] = ((((1.0-yi)*e1)-yi)/(1.0+e1)) ;
639
+ } ;
640
+ ;
641
+ } else {
642
+ double e2 = exp((0.0-zi));
643
+ loss = (loss+(( ( zi <= 18.0 ) ? (log((1.0+e2))) : (e2) )+((1.0-yi)*zi))) ;
644
+ z[ i ] = (((1.0-yi)-(yi*e2))/(1.0+e2)) ;
645
+ ;
646
+ } ;
647
+ ;
648
+ } ;
649
+ } else {
650
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
651
+ double zmax = z[(i*k)];
652
+ double se = 0.0;
653
+ double yc = y[i];
654
+ for( int c = 1 ; !(c == k) ; c = (c+1) ) {
655
+ if( z[((i*k)+c)] > zmax ) {
656
+ zmax = z[((i*k)+c)] ;
657
+ } else {
658
+ 0 ;
659
+ } ;
660
+ } ;
661
+ loss = (loss-z[((i*k)+int(yc))]) ;
662
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
663
+ double ec = exp((z[((i*k)+c)]-zmax));
664
+ z[ ((i*k)+c) ] = ec ;
665
+ se = (se+ec) ;
666
+ ;
667
+ } ;
668
+ loss = (loss+(zmax+log(se))) ;
669
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
670
+ z[ ((i*k)+c) ] = (z[((i*k)+c)]/se) ;
671
+ } ;
672
+ int iy = ((i*k)+int(yc));
673
+ z[ iy ] = (z[iy]-1.0) ;
674
+ ;
675
+ ;
676
+ } ;
677
+ } ;
678
+ for( int i2526 = 0 ; !(i2526 == k) ; i2526 = (i2526+1) ) {
679
+ for( int i2527 = 0 ; !(i2527 == p) ; i2527 = (i2527+1) ) {
680
+ g[ ((i2526*p)+i2527) ] = 0.0 ;
681
+ } ;
682
+ } ;
683
+ for( int k2524 = 0 ; !(k2524 == n) ; k2524 = (k2524+1) ) {
684
+ for( int k2525 = 0 ; !(k2525 == k) ; k2525 = (k2525+1) ) {
685
+ for( int k2528 = 0 ; !(k2528 == p) ; k2528 = (k2528+1) ) {
686
+ g[ ((k2525*p)+k2528) ] = (g[((k2525*p)+k2528)]+(x[((k2524*p)+k2528)]*z[((k2524*k)+k2525)])) ;
687
+ } ;
688
+ } ;
689
+ } ;
690
+ for( int t = 0 ; !(t == (k*p)) ; t = (t+1) ) {
691
+ double wt = coef[t];
692
+ pen = (pen+(wt*wt)) ;
693
+ g[ t ] = ((g[t]/double(n))+(l2*wt)) ;
694
+ ;
695
+ } ;
696
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
697
+ double acc = 0.0;
698
+ if( fitint == 1 ) {
699
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
700
+ acc = (acc+z[((i*k)+c)]) ;
701
+ } ;
702
+ } else {
703
+ 0 ;
704
+ } ;
705
+ g[ ((k*p)+c) ] = (acc/double(n)) ;
706
+ ;
707
+ } ;
708
+ return ((loss/double(n))+(0.5*(l2*pen))) ;
709
+ }
710
+
711
+
712
+ inline int
713
+ logistic_lbfgs( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> out, double c, int maxiter, double tol, int multi, int fitint, int n, int p, int k )
714
+ { std::array<double,4> aux = scm2cpp::filled_array<double,4>(0.0);
715
+ std::vector<double> work((n*k),0.0);
716
+ aux[ 0 ] = (1.0/(c*double(n))) ;
717
+ aux[ 1 ] = ( ( multi == 1 ) ? (1.0) : (0.0) ) ;
718
+ aux[ 2 ] = ( ( fitint == 1 ) ? (1.0) : (0.0) ) ;
719
+ return lbfgs(0,coef,x,y,aux,work,out,10,maxiter,tol,(64.0*2.220446049250313e-16),50,-1,0.0,(k*(p+1)),n,p,k) ;
720
+ }
721
+
722
+
723
+ SCM2CPP_FN inline double
724
+ huber_fg( scm2cpp::cspan<double> coef, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> z, double epsilon, double alpha, int fitint, int n, int p )
725
+ { double b = coef[p];
726
+ double sigma = coef[(p+1)];
727
+ int nout = 0;
728
+ double outsum = 0.0;
729
+ double sq = 0.0;
730
+ double csum = 0.0;
731
+ double ww = 0.0;
732
+ for( int k2531 = 0 ; !(k2531 == n) ; k2531 = (k2531+1) ) {
733
+ z[ k2531 ] = ([&]() -> double { int i2534 = 0; double r2535 = 0.0; while (!(i2534 == p)) {
734
+ int i2534_next17096 = (i2534+1);
735
+ double r2535_next17097 = (r2535+(x[((k2531*p)+i2534)]*coef[i2534]));
736
+ i2534 = i2534_next17096;
737
+ r2535 = r2535_next17097;
738
+ } return r2535; })() ;
739
+ } ;
740
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
741
+ double r = ((y[i]-z[i])-b);
742
+ double a = lb_abs(r);
743
+ if( a > (epsilon*sigma) ) {
744
+ nout = (nout+1) ;
745
+ outsum = (outsum+a) ;
746
+ z[ i ] = (-2.0*(epsilon*( ( r < 0.0 ) ? (-1.0) : (1.0) ))) ;
747
+ } else {
748
+ sq = (sq+(r*r)) ;
749
+ z[ i ] = ((-2.0*r)/sigma) ;
750
+ } ;
751
+ csum = (csum+z[i]) ;
752
+ ;
753
+ ;
754
+ } ;
755
+ for( int i2539 = 0 ; !(i2539 == p) ; i2539 = (i2539+1) ) {
756
+ g[ i2539 ] = 0.0 ;
757
+ } ;
758
+ for( int k2537 = 0 ; !(k2537 == n) ; k2537 = (k2537+1) ) {
759
+ for( int i2540 = 0 ; !(i2540 == p) ; i2540 = (i2540+1) ) {
760
+ g[ i2540 ] = (g[i2540]+(x[((k2537*p)+i2540)]*z[k2537])) ;
761
+ } ;
762
+ } ;
763
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
764
+ double wj = coef[j];
765
+ ww = (ww+(wj*wj)) ;
766
+ g[ j ] = (g[j]+(2.0*(alpha*wj))) ;
767
+ ;
768
+ } ;
769
+ g[ p ] = ( ( fitint == 1 ) ? (csum) : (0.0) ) ;
770
+ double sqloss = (sq/sigma);
771
+ double eps2 = (epsilon*epsilon);
772
+ g[ (p+1) ] = ((double(n)-(double(nout)*eps2))-(sqloss/sigma)) ;
773
+ return ((((double(n)*sigma)+sqloss)+((2.0*(epsilon*outsum))-(sigma*(double(nout)*eps2))))+(alpha*ww)) ;
774
+ }
775
+
776
+
777
+ inline int
778
+ huber( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> out, double epsilon, double alpha, int maxiter, double tol, int fitint, int n, int p )
779
+ { std::array<double,4> aux = scm2cpp::filled_array<double,4>(0.0);
780
+ std::vector<double> work(n,0.0);
781
+ aux[ 0 ] = epsilon ;
782
+ aux[ 1 ] = alpha ;
783
+ aux[ 2 ] = ( ( fitint == 1 ) ? (1.0) : (0.0) ) ;
784
+ return lbfgs(1,coef,x,y,aux,work,out,10,maxiter,tol,(10000000.0*2.220446049250313e-16),20,(p+1),(10.0*2.220446049250313e-16),(p+2),n,p,1) ;
785
+ }
786
+
787
+
788
+ SCM2CPP_FN inline double
789
+ glm_fg( scm2cpp::cspan<double> coef, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> z, int family, double power, double l2, int fitint, int n, int p )
790
+ { double loss = 0.0;
791
+ double pen = 0.0;
792
+ double b = coef[p];
793
+ for( int k2543 = 0 ; !(k2543 == n) ; k2543 = (k2543+1) ) {
794
+ z[ k2543 ] = ([&]() -> double { int i2546 = 0; double r2547 = 0.0; while (!(i2546 == p)) {
795
+ int i2546_next17098 = (i2546+1);
796
+ double r2547_next17099 = (r2547+(x[((k2543*p)+i2546)]*coef[i2546]));
797
+ i2546 = i2546_next17098;
798
+ r2547 = r2547_next17099;
799
+ } return r2547; })() ;
800
+ } ;
801
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
802
+ double zi = (z[i]+b);
803
+ double yi = y[i];
804
+ if( (family == 0 || (family == 2 && power == 1.0)) ) {
805
+ double e = exp(zi);
806
+ loss = (loss+(e-(yi*zi))) ;
807
+ z[ i ] = (e-yi) ;
808
+ ;
809
+ } else {
810
+ if( (family == 1 || (family == 2 && power == 2.0)) ) {
811
+ double e2 = exp((0.0-zi));
812
+ loss = (loss+(zi+(yi*e2))) ;
813
+ z[ i ] = (1.0-(yi*e2)) ;
814
+ ;
815
+ } else {
816
+ if( family == 3 ) {
817
+ double r = (zi-yi);
818
+ loss = (loss+(0.5*(r*r))) ;
819
+ z[ i ] = r ;
820
+ ;
821
+ } else {
822
+ if( power == 0.0 ) {
823
+ double e3 = exp(zi);
824
+ loss = (loss+(0.5*((e3-yi)*(e3-yi)))) ;
825
+ z[ i ] = (e3*(e3-yi)) ;
826
+ ;
827
+ } else {
828
+ double e1 = exp(((1.0-power)*zi));
829
+ double e4 = exp(((2.0-power)*zi));
830
+ loss = (loss+((e4/(2.0-power))-((yi*e1)/(1.0-power)))) ;
831
+ z[ i ] = (e4-(yi*e1)) ;
832
+ ;
833
+ } ;
834
+ } ;
835
+ } ;
836
+ } ;
837
+ ;
838
+ } ;
839
+ for( int i2551 = 0 ; !(i2551 == p) ; i2551 = (i2551+1) ) {
840
+ g[ i2551 ] = 0.0 ;
841
+ } ;
842
+ for( int k2549 = 0 ; !(k2549 == n) ; k2549 = (k2549+1) ) {
843
+ for( int i2552 = 0 ; !(i2552 == p) ; i2552 = (i2552+1) ) {
844
+ g[ i2552 ] = (g[i2552]+(x[((k2549*p)+i2552)]*z[k2549])) ;
845
+ } ;
846
+ } ;
847
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
848
+ double wj = coef[j];
849
+ pen = (pen+(wj*wj)) ;
850
+ g[ j ] = ((g[j]/double(n))+(l2*wj)) ;
851
+ ;
852
+ } ;
853
+ double acc = 0.0;
854
+ if( fitint == 1 ) {
855
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
856
+ acc = (acc+z[i]) ;
857
+ } ;
858
+ } else {
859
+ 0 ;
860
+ } ;
861
+ g[ p ] = (acc/double(n)) ;
862
+ ;
863
+ return ((loss/double(n))+(0.5*(l2*pen))) ;
864
+ }
865
+
866
+
867
+ inline int
868
+ glm( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> out, int family, double power, double alpha, int maxiter, double tol, int fitint, int n, int p )
869
+ { std::array<double,4> aux = scm2cpp::filled_array<double,4>(0.0);
870
+ std::vector<double> work(n,0.0);
871
+ double ym = 0.0;
872
+ aux[ 0 ] = alpha ;
873
+ aux[ 1 ] = double(family) ;
874
+ aux[ 2 ] = ( ( fitint == 1 ) ? (1.0) : (0.0) ) ;
875
+ aux[ 3 ] = power ;
876
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
877
+ coef[ j ] = 0.0 ;
878
+ } ;
879
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
880
+ ym = (ym+y[i]) ;
881
+ } ;
882
+ ym = (ym/double(n)) ;
883
+ coef[ p ] = ( ( fitint == 1 ) ? (( ( family == 3 ) ? (ym) : (log(ym)) )) : (0.0) ) ;
884
+ return lbfgs(2,coef,x,y,aux,work,out,10,maxiter,tol,(64.0*2.220446049250313e-16),50,-1,0.0,(p+1),n,p,1) ;
885
+ }
886
+
887
+
888
+ SCM2CPP_FN inline double
889
+ lb_abs( double a )
890
+ {
891
+ if( a < 0.0 ) {
892
+ return (0.0-a) ;
893
+ }
894
+ else {
895
+ return a ;
896
+ }
897
+ }
898
+
899
+
900
+ SCM2CPP_FN inline double
901
+ lb_max( double a, double b )
902
+ {
903
+ if( a > b ) {
904
+ return a ;
905
+ }
906
+ else {
907
+ return b ;
908
+ }
909
+ }
910
+
911
+
912
+ SCM2CPP_FN inline double
913
+ lb_min( double a, double b )
914
+ {
915
+ if( a < b ) {
916
+ return a ;
917
+ }
918
+ else {
919
+ return b ;
920
+ }
921
+ }
922
+
923
+
924
+ SCM2CPP_FN inline int
925
+ lb_dcstep( std::array<double,8> & cs, double fp, double dp, double stpmin, double stpmax )
926
+ { double stx = cs[0];
927
+ double fx = cs[1];
928
+ double dx = cs[2];
929
+ double sty = cs[3];
930
+ double fy = cs[4];
931
+ double dy = cs[5];
932
+ double stp = cs[6];
933
+ double brackt = cs[7];
934
+ double stpf = 0.0;
935
+ double sgnd = (dp*(dx/lb_abs(dx)));
936
+ if( fp > fx ) {
937
+ double th1 = ((((3.0*(fx-fp))/(stp-stx))+dx)+dp);
938
+ double s1 = lb_max(lb_abs(th1),lb_max(lb_abs(dx),lb_abs(dp)));
939
+ double ga1 = (s1*sqrt((((th1/s1)*(th1/s1))-((dx/s1)*(dp/s1)))));
940
+ double gm1 = ( ( stp < stx ) ? ((0.0-ga1)) : (ga1) );
941
+ double r1 = (((gm1-dx)+th1)/(((gm1-dx)+gm1)+dp));
942
+ double stpc1 = (stx+(r1*(stp-stx)));
943
+ double stpq1 = (stx+(((dx/(((fx-fp)/(stp-stx))+dx))/2.0)*(stp-stx)));
944
+ if( lb_abs(double((stpc1-stx))) < lb_abs(double((stpq1-stx))) ) {
945
+ stpf = stpc1 ;
946
+ } else {
947
+ stpf = (stpc1+((stpq1-stpc1)/2.0)) ;
948
+ } ;
949
+ brackt = 1.0 ;
950
+ ;
951
+ ;
952
+ ;
953
+ ;
954
+ ;
955
+ ;
956
+ 0 ;
957
+ } else {
958
+ if( sgnd < 0.0 ) {
959
+ double th2 = ((((3.0*(fx-fp))/(stp-stx))+dx)+dp);
960
+ double s2 = lb_max(lb_abs(th2),lb_max(lb_abs(dx),lb_abs(dp)));
961
+ double ga2 = (s2*sqrt((((th2/s2)*(th2/s2))-((dx/s2)*(dp/s2)))));
962
+ double gm2 = ( ( stp > stx ) ? ((0.0-ga2)) : (ga2) );
963
+ double r2 = (((gm2-dp)+th2)/(((gm2-dp)+gm2)+dx));
964
+ double stpc2 = (stp+(r2*(stx-stp)));
965
+ double stpq2 = (stp+((dp/(dp-dx))*(stx-stp)));
966
+ if( lb_abs(double((stpc2-stp))) > lb_abs(double((stpq2-stp))) ) {
967
+ stpf = stpc2 ;
968
+ } else {
969
+ stpf = stpq2 ;
970
+ } ;
971
+ brackt = 1.0 ;
972
+ ;
973
+ ;
974
+ ;
975
+ ;
976
+ ;
977
+ ;
978
+ 0 ;
979
+ } else {
980
+ if( lb_abs(dp) < lb_abs(dx) ) {
981
+ double th3 = ((((3.0*(fx-fp))/(stp-stx))+dx)+dp);
982
+ double s3 = lb_max(lb_abs(th3),lb_max(lb_abs(dx),lb_abs(dp)));
983
+ double ga3 = (s3*sqrt(lb_max(0.0,double((((th3/s3)*(th3/s3))-((dx/s3)*(dp/s3)))))));
984
+ double gm3 = ( ( stp > stx ) ? ((0.0-ga3)) : (ga3) );
985
+ double r3 = (((gm3-dp)+th3)/((gm3+(dx-dp))+gm3));
986
+ double stpc3 = ( ( (r3 < 0.0 && !(gm3 == 0.0)) ) ? ((stp+(r3*(stx-stp)))) : (( ( stp > stx ) ? (stpmax) : (stpmin) )) );
987
+ double stpq3 = (stp+((dp/(dp-dx))*(stx-stp)));
988
+ if( brackt == 1.0 ) {
989
+ if( lb_abs(double((stpc3-stp))) < lb_abs(double((stpq3-stp))) ) {
990
+ stpf = stpc3 ;
991
+ } else {
992
+ stpf = stpq3 ;
993
+ } ;
994
+ if( stp > stx ) {
995
+ stpf = lb_min(double((stp+(0.66*(sty-stp)))),stpf) ;
996
+ } else {
997
+ stpf = lb_max(double((stp+(0.66*(sty-stp)))),stpf) ;
998
+ } ;
999
+ } else {
1000
+ if( lb_abs(double((stpc3-stp))) > lb_abs(double((stpq3-stp))) ) {
1001
+ stpf = stpc3 ;
1002
+ } else {
1003
+ stpf = stpq3 ;
1004
+ } ;
1005
+ stpf = lb_min(stpmax,stpf) ;
1006
+ stpf = lb_max(stpmin,stpf) ;
1007
+ } ;
1008
+ ;
1009
+ ;
1010
+ ;
1011
+ ;
1012
+ ;
1013
+ ;
1014
+ 0 ;
1015
+ } else {
1016
+ if( brackt == 1.0 ) {
1017
+ double th4 = ((((3.0*(fp-fy))/(sty-stp))+dy)+dp);
1018
+ double s4 = lb_max(lb_abs(th4),lb_max(lb_abs(dy),lb_abs(dp)));
1019
+ double ga4 = (s4*sqrt((((th4/s4)*(th4/s4))-((dy/s4)*(dp/s4)))));
1020
+ double gm4 = ( ( stp > sty ) ? ((0.0-ga4)) : (ga4) );
1021
+ double r4 = (((gm4-dp)+th4)/(((gm4-dp)+gm4)+dy));
1022
+ stpf = (stp+(r4*(sty-stp))) ;
1023
+ ;
1024
+ ;
1025
+ ;
1026
+ ;
1027
+ ;
1028
+ 0 ;
1029
+ } else {
1030
+ if( stp > stx ) {
1031
+ stpf = stpmax ;
1032
+ } else {
1033
+ stpf = stpmin ;
1034
+ } ;
1035
+ } ;
1036
+ } ;
1037
+ } ;
1038
+ } ;
1039
+ if( fp > fx ) {
1040
+ cs[ 3 ] = stp ;
1041
+ cs[ 4 ] = fp ;
1042
+ cs[ 5 ] = dp ;
1043
+ } else {
1044
+ if( sgnd < 0.0 ) {
1045
+ cs[ 3 ] = stx ;
1046
+ cs[ 4 ] = fx ;
1047
+ cs[ 5 ] = dx ;
1048
+ } else {
1049
+ 0 ;
1050
+ } ;
1051
+ cs[ 0 ] = stp ;
1052
+ cs[ 1 ] = fp ;
1053
+ cs[ 2 ] = dp ;
1054
+ } ;
1055
+ cs[ 6 ] = stpf ;
1056
+ cs[ 7 ] = brackt ;
1057
+ return 0 ;
1058
+ }
1059
+
1060
+
1061
+ SCM2CPP_FN inline int
1062
+ lb_search_start( std::array<double,16> & ls, double f, double g, double stp, double stpmin, double stpmax, double ftol )
1063
+ { ls[ 0 ] = 0.0 ;
1064
+ ls[ 1 ] = f ;
1065
+ ls[ 2 ] = g ;
1066
+ ls[ 3 ] = 0.0 ;
1067
+ ls[ 4 ] = f ;
1068
+ ls[ 5 ] = g ;
1069
+ ls[ 6 ] = 0.0 ;
1070
+ ls[ 7 ] = 1.0 ;
1071
+ ls[ 8 ] = f ;
1072
+ ls[ 9 ] = g ;
1073
+ ls[ 10 ] = (ftol*g) ;
1074
+ ls[ 11 ] = (stpmax-stpmin) ;
1075
+ ls[ 12 ] = ((stpmax-stpmin)/0.5) ;
1076
+ ls[ 13 ] = 0.0 ;
1077
+ ls[ 14 ] = (stp+(4.0*stp)) ;
1078
+ ls[ 15 ] = stp ;
1079
+ return 0 ;
1080
+ }
1081
+
1082
+
1083
+ SCM2CPP_FN inline int
1084
+ lb_search_step( std::array<double,16> & ls, std::array<double,8> & cs, double f, double g, double ftol, double gtol, double xtol, double stpmin, double stpmax )
1085
+ { double stp = ls[15];
1086
+ double finit = ls[8];
1087
+ double ginit = ls[9];
1088
+ double gtest = ls[10];
1089
+ int task = 0;
1090
+ double ftest = (finit+(stp*gtest));
1091
+ if( (ls[7] == 1.0 && (f <= ftest && g >= 0.0)) ) {
1092
+ ls[ 7 ] = 2.0 ;
1093
+ } else {
1094
+ 0 ;
1095
+ } ;
1096
+ if( (ls[6] == 1.0 && (stp <= ls[13] || stp >= ls[14])) ) {
1097
+ task = 2 ;
1098
+ } else {
1099
+ 0 ;
1100
+ } ;
1101
+ if( (ls[6] == 1.0 && (ls[14]-ls[13]) <= (xtol*ls[14])) ) {
1102
+ task = 2 ;
1103
+ } else {
1104
+ 0 ;
1105
+ } ;
1106
+ if( (stp == stpmax && (f <= ftest && g <= gtest)) ) {
1107
+ task = 2 ;
1108
+ } else {
1109
+ 0 ;
1110
+ } ;
1111
+ if( (stp == stpmin && (f > ftest || g >= gtest)) ) {
1112
+ task = 2 ;
1113
+ } else {
1114
+ 0 ;
1115
+ } ;
1116
+ if( (f <= ftest && lb_abs(g) <= (gtol*(0.0-ginit))) ) {
1117
+ task = 1 ;
1118
+ } else {
1119
+ 0 ;
1120
+ } ;
1121
+ if( task == 0 ) {
1122
+ cs[ 0 ] = ls[0] ;
1123
+ cs[ 3 ] = ls[3] ;
1124
+ cs[ 6 ] = stp ;
1125
+ cs[ 7 ] = ls[6] ;
1126
+ if( (ls[7] == 1.0 && (f <= ls[1] && f > ftest)) ) {
1127
+ cs[ 1 ] = (ls[1]-(ls[0]*gtest)) ;
1128
+ cs[ 2 ] = (ls[2]-gtest) ;
1129
+ cs[ 4 ] = (ls[4]-(ls[3]*gtest)) ;
1130
+ cs[ 5 ] = (ls[5]-gtest) ;
1131
+ lb_dcstep(cs,double((f-(stp*gtest))),double((g-gtest)),ls[13],ls[14]) ;
1132
+ ls[ 1 ] = (cs[1]+(cs[0]*gtest)) ;
1133
+ ls[ 2 ] = (cs[2]+gtest) ;
1134
+ ls[ 4 ] = (cs[4]+(cs[3]*gtest)) ;
1135
+ ls[ 5 ] = (cs[5]+gtest) ;
1136
+ } else {
1137
+ cs[ 1 ] = ls[1] ;
1138
+ cs[ 2 ] = ls[2] ;
1139
+ cs[ 4 ] = ls[4] ;
1140
+ cs[ 5 ] = ls[5] ;
1141
+ lb_dcstep(cs,f,g,ls[13],ls[14]) ;
1142
+ ls[ 1 ] = cs[1] ;
1143
+ ls[ 2 ] = cs[2] ;
1144
+ ls[ 4 ] = cs[4] ;
1145
+ ls[ 5 ] = cs[5] ;
1146
+ } ;
1147
+ ls[ 0 ] = cs[0] ;
1148
+ ls[ 3 ] = cs[3] ;
1149
+ ls[ 6 ] = cs[7] ;
1150
+ double nstp = cs[6];
1151
+ double stx = cs[0];
1152
+ double sty = cs[3];
1153
+ if( ls[6] == 1.0 ) {
1154
+ if( lb_abs(double((sty-stx))) >= (0.66*ls[12]) ) {
1155
+ nstp = (stx+(0.5*(sty-stx))) ;
1156
+ } else {
1157
+ 0 ;
1158
+ } ;
1159
+ ls[ 12 ] = ls[11] ;
1160
+ ls[ 11 ] = lb_abs(double((sty-stx))) ;
1161
+ } else {
1162
+ 0 ;
1163
+ } ;
1164
+ if( ls[6] == 1.0 ) {
1165
+ ls[ 13 ] = lb_min(stx,sty) ;
1166
+ ls[ 14 ] = lb_max(stx,sty) ;
1167
+ } else {
1168
+ ls[ 13 ] = (nstp+(1.1*(nstp-stx))) ;
1169
+ ls[ 14 ] = (nstp+(4.0*(nstp-stx))) ;
1170
+ } ;
1171
+ nstp = lb_max(nstp,stpmin) ;
1172
+ nstp = lb_min(nstp,stpmax) ;
1173
+ if( (ls[6] == 1.0 && ((nstp <= ls[13] || nstp >= ls[14]) || (ls[14]-ls[13]) <= (xtol*ls[14]))) ) {
1174
+ nstp = stx ;
1175
+ } else {
1176
+ 0 ;
1177
+ } ;
1178
+ ls[ 15 ] = nstp ;
1179
+ ;
1180
+ } else {
1181
+ 0 ;
1182
+ } ;
1183
+ return task ;
1184
+ }
1185
+
1186
+
1187
+ SCM2CPP_FN inline double
1188
+ lb_dot( scm2cpp::cspan<double> a, scm2cpp::cspan<double> b, int nv )
1189
+ { double acc = 0.0;
1190
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1191
+ acc = (acc+(a[j]*b[j])) ;
1192
+ } ;
1193
+ return acc ;
1194
+ }
1195
+
1196
+
1197
+ SCM2CPP_FN inline double
1198
+ lb_dot_row( scm2cpp::cspan<double> mem, int slot, scm2cpp::cspan<double> v, int nv )
1199
+ { double acc = 0.0;
1200
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1201
+ acc = (acc+(mem[((slot*nv)+j)]*v[j])) ;
1202
+ } ;
1203
+ return acc ;
1204
+ }
1205
+
1206
+
1207
+ SCM2CPP_FN inline double
1208
+ lb_dot_rows( scm2cpp::cspan<double> a, int ra, scm2cpp::cspan<double> b, int rb, int nv )
1209
+ { double acc = 0.0;
1210
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1211
+ acc = (acc+(a[((ra*nv)+j)]*b[((rb*nv)+j)])) ;
1212
+ } ;
1213
+ return acc ;
1214
+ }
1215
+
1216
+
1217
+ SCM2CPP_FN inline double
1218
+ lb_projgr( scm2cpp::cspan<double> g, scm2cpp::cspan<double> w, int ib, double lbv, int nv )
1219
+ { double acc = 0.0;
1220
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1221
+ double gj = g[j];
1222
+ double gp = ( ( (j == ib && gj >= 0.0) ) ? (lb_min(double((w[j]-lbv)),gj)) : (gj) );
1223
+ double v = lb_abs(gp);
1224
+ if( v > acc ) {
1225
+ acc = v ;
1226
+ } else {
1227
+ 0 ;
1228
+ } ;
1229
+ ;
1230
+ ;
1231
+ ;
1232
+ } ;
1233
+ return acc ;
1234
+ }
1235
+
1236
+
1237
+ SCM2CPP_FN inline int
1238
+ lb_hv( scm2cpp::span<double> q, scm2cpp::cspan<double> smem, scm2cpp::cspan<double> ymem, scm2cpp::cspan<double> rho, scm2cpp::span<double> al, double theta, int col, int head, int m, int nv )
1239
+ { for( int ii = 0 ; !(ii == col) ; ii = (ii+1) ) {
1240
+ int slot = ((head+((col-1)-ii)) % m);
1241
+ double a = (rho[slot]*lb_dot_row(smem,slot,q,nv));
1242
+ al[ slot ] = a ;
1243
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1244
+ q[ j ] = (q[j]-(a*ymem[((slot*nv)+j)])) ;
1245
+ } ;
1246
+ ;
1247
+ ;
1248
+ } ;
1249
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1250
+ q[ j ] = (q[j]/theta) ;
1251
+ } ;
1252
+ for( int ii = 0 ; !(ii == col) ; ii = (ii+1) ) {
1253
+ int slot2 = ((head+ii) % m);
1254
+ double bb = (rho[slot2]*lb_dot_row(ymem,slot2,q,nv));
1255
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1256
+ q[ j ] = (q[j]+((al[slot2]-bb)*smem[((slot2*nv)+j)])) ;
1257
+ } ;
1258
+ ;
1259
+ ;
1260
+ } ;
1261
+ return 0 ;
1262
+ }
1263
+
1264
+
1265
+ SCM2CPP_FN inline double
1266
+ lb_vbv( scm2cpp::cspan<double> v, scm2cpp::cspan<double> smem, scm2cpp::cspan<double> ymem, scm2cpp::cspan<double> rho, scm2cpp::span<double> bm, scm2cpp::span<double> sb, double theta, int col, int head, int m, int nv )
1267
+ { for( int ii = 0 ; !(ii == col) ; ii = (ii+1) ) {
1268
+ int si = ((head+ii) % m);
1269
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1270
+ bm[ ((ii*nv)+j) ] = (theta*smem[((si*nv)+j)]) ;
1271
+ } ;
1272
+ for( int jj = 0 ; !(jj == ii) ; jj = (jj+1) ) {
1273
+ int sj = ((head+jj) % m);
1274
+ double cb = (lb_dot_rows(bm,jj,smem,si,nv)/sb[jj]);
1275
+ double cy = (rho[sj]*lb_dot_rows(ymem,sj,smem,si,nv));
1276
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1277
+ bm[ ((ii*nv)+j) ] = ((bm[((ii*nv)+j)]-(cb*bm[((jj*nv)+j)]))+(cy*ymem[((sj*nv)+j)])) ;
1278
+ } ;
1279
+ ;
1280
+ ;
1281
+ } ;
1282
+ sb[ ii ] = lb_dot_rows(bm,ii,smem,si,nv) ;
1283
+ ;
1284
+ } ;
1285
+ double acc = (theta*lb_dot(v,v,nv));
1286
+ for( int ii = 0 ; !(ii == col) ; ii = (ii+1) ) {
1287
+ int si2 = ((head+ii) % m);
1288
+ double bv = lb_dot_row(bm,ii,v,nv);
1289
+ double yv = lb_dot_row(ymem,si2,v,nv);
1290
+ acc = ((acc-((bv*bv)/sb[ii]))+(rho[si2]*(yv*yv))) ;
1291
+ ;
1292
+ ;
1293
+ } ;
1294
+ return acc ;
1295
+ }
1296
+
1297
+
1298
+ SCM2CPP_FN inline int
1299
+ lb_direction( scm2cpp::cspan<double> w, scm2cpp::cspan<double> g, scm2cpp::span<double> d, scm2cpp::span<double> q, scm2cpp::span<double> e, scm2cpp::cspan<double> smem, scm2cpp::cspan<double> ymem, scm2cpp::cspan<double> rho, scm2cpp::span<double> al, scm2cpp::span<double> bm, scm2cpp::span<double> sb, double theta, int col, int head, int m, int ib, double lbv, int nv )
1300
+ { for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1301
+ q[ j ] = g[j] ;
1302
+ } ;
1303
+ lb_hv(q,smem,ymem,rho,al,theta,col,head,m,nv) ;
1304
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1305
+ d[ j ] = (0.0-q[j]) ;
1306
+ } ;
1307
+ if( ib >= 0 ) {
1308
+ double gs = g[ib];
1309
+ double tl = (w[ib]-lbv);
1310
+ int fixed = 0;
1311
+ double delta = 0.0;
1312
+ double dtm = 0.0;
1313
+ if( (tl <= 0.0 && gs >= 0.0) ) {
1314
+ fixed = 1 ;
1315
+ } else {
1316
+ dtm = (lb_dot(g,g,nv)/lb_vbv(g,smem,ymem,rho,bm,sb,theta,col,head,m,nv)) ;
1317
+ if( (gs > 0.0 && dtm >= (tl/gs)) ) {
1318
+ fixed = 1 ;
1319
+ delta = (0.0-tl) ;
1320
+ } else {
1321
+ 0 ;
1322
+ } ;
1323
+ } ;
1324
+ if( fixed == 1 ) {
1325
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1326
+ e[ j ] = 0.0 ;
1327
+ } ;
1328
+ e[ ib ] = 1.0 ;
1329
+ lb_hv(e,smem,ymem,rho,al,theta,col,head,m,nv) ;
1330
+ double lam = ((delta+q[ib])/e[ib]);
1331
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1332
+ d[ j ] = (d[j]+(lam*e[j])) ;
1333
+ } ;
1334
+ ;
1335
+ d[ ib ] = delta ;
1336
+ } else {
1337
+ if( (w[ib]+d[ib]) < lbv ) {
1338
+ double ddp = ((lb_dot(d,g,nv)-(d[ib]*gs))+((lbv-w[ib])*gs));
1339
+ if( ddp > 0.0 ) {
1340
+ double dus = (d[ib]-((0.0-dtm)*gs));
1341
+ double xcps = (w[ib]-(dtm*gs));
1342
+ double alpha = 1.0;
1343
+ if( dus < 0.0 ) {
1344
+ double temp2 = (lbv-xcps);
1345
+ if( temp2 >= 0.0 ) {
1346
+ alpha = 0.0 ;
1347
+ } else {
1348
+ if( dus < temp2 ) {
1349
+ alpha = (temp2/dus) ;
1350
+ } else {
1351
+ 0 ;
1352
+ } ;
1353
+ } ;
1354
+ ;
1355
+ } else {
1356
+ 0 ;
1357
+ } ;
1358
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1359
+ double xcpj = ((0.0-dtm)*g[j]);
1360
+ d[ j ] = (xcpj+(alpha*(d[j]-xcpj))) ;
1361
+ ;
1362
+ } ;
1363
+ if( alpha < 1.0 ) {
1364
+ d[ ib ] = (lbv-w[ib]) ;
1365
+ } else {
1366
+ 0 ;
1367
+ } ;
1368
+ ;
1369
+ } else {
1370
+ d[ ib ] = (lbv-w[ib]) ;
1371
+ } ;
1372
+ ;
1373
+ } else {
1374
+ 0 ;
1375
+ } ;
1376
+ } ;
1377
+ ;
1378
+ } else {
1379
+ 0 ;
1380
+ } ;
1381
+ return 0 ;
1382
+ }
1383
+
1384
+
1385
+ inline int
1386
+ lbfgs( int kind, scm2cpp::span<double> w, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, const std::array<double,4> & aux, scm2cpp::span<double> work, scm2cpp::span<double> out, int m, int maxiter, double pgtol, double ftol, int maxls, int ib, double lbv, int nv, int n, int p, int k )
1387
+ { std::vector<double> g(nv,0.0);
1388
+ std::vector<double> gold(nv,0.0);
1389
+ std::vector<double> d(nv,0.0);
1390
+ std::vector<double> t(nv,0.0);
1391
+ std::vector<double> q(nv,0.0);
1392
+ std::vector<double> e(nv,0.0);
1393
+ std::vector<double> smem((m*nv),0.0);
1394
+ std::vector<double> ymem((m*nv),0.0);
1395
+ std::vector<double> bm((m*nv),0.0);
1396
+ std::vector<double> rho(m,0.0);
1397
+ std::vector<double> sb(m,0.0);
1398
+ std::vector<double> al(m,0.0);
1399
+ std::array<double,16> ls = scm2cpp::filled_array<double,16>(0.0);
1400
+ std::array<double,8> cs = scm2cpp::filled_array<double,8>(0.0);
1401
+ double eps = 2.220446049250313e-16;
1402
+ int iter = 0;
1403
+ int col = 0;
1404
+ int head = 0;
1405
+ double theta = 1.0;
1406
+ int nfg = 0;
1407
+ int done = 0;
1408
+ double f = lbfgs_fg(kind,w,g,x,y,aux,work,n,p,k);
1409
+ nfg = 1 ;
1410
+ if( lb_projgr(g,w,ib,lbv,nv) <= pgtol ) {
1411
+ done = 1 ;
1412
+ } else {
1413
+ 0 ;
1414
+ } ;
1415
+ for( ; !(done == 1) ; ) {
1416
+ lb_direction(w,g,d,q,e,smem,ymem,rho,al,bm,sb,theta,col,head,m,ib,lbv,nv) ;
1417
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1418
+ t[ j ] = w[j] ;
1419
+ gold[ j ] = g[j] ;
1420
+ } ;
1421
+ double fold = f;
1422
+ double dnorm = sqrt(lb_dot(d,d,nv));
1423
+ double gdold = lb_dot(g,d,nv);
1424
+ double stpmx = 10000000000.0;
1425
+ double gd = 0.0;
1426
+ int task = 0;
1427
+ int ifun = 0;
1428
+ int fail = 0;
1429
+ if( ib >= 0 ) {
1430
+ if( iter == 0 ) {
1431
+ stpmx = 1.0 ;
1432
+ } else {
1433
+ if( d[ib] < 0.0 ) {
1434
+ double a2 = (lbv-w[ib]);
1435
+ if( a2 >= 0.0 ) {
1436
+ stpmx = 0.0 ;
1437
+ } else {
1438
+ if( (d[ib]*stpmx) < a2 ) {
1439
+ stpmx = (a2/d[ib]) ;
1440
+ } else {
1441
+ 0 ;
1442
+ } ;
1443
+ } ;
1444
+ ;
1445
+ } else {
1446
+ 0 ;
1447
+ } ;
1448
+ } ;
1449
+ } else {
1450
+ 0 ;
1451
+ } ;
1452
+ if( gdold >= 0.0 ) {
1453
+ fail = 1 ;
1454
+ } else {
1455
+ lb_search_start(ls,f,gdold,( ( iter == 0 ) ? (lb_min(double((1.0/dnorm)),stpmx)) : (1.0) ),0.0,stpmx,0.001) ;
1456
+ for( ; !((fail == 1 || !(task == 0))) ; ) {
1457
+ ifun = (ifun+1) ;
1458
+ if( ifun > maxls ) {
1459
+ fail = 1 ;
1460
+ } else {
1461
+ double stp = ls[15];
1462
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1463
+ w[ j ] = (t[j]+(stp*d[j])) ;
1464
+ } ;
1465
+ f = lbfgs_fg(kind,w,g,x,y,aux,work,n,p,k) ;
1466
+ nfg = (nfg+1) ;
1467
+ gd = lb_dot(g,d,nv) ;
1468
+ task = lb_search_step(ls,cs,f,gd,0.001,0.9,0.1,0.0,stpmx) ;
1469
+ ;
1470
+ } ;
1471
+ } ;
1472
+ } ;
1473
+ if( fail == 1 ) {
1474
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1475
+ w[ j ] = t[j] ;
1476
+ g[ j ] = gold[j] ;
1477
+ } ;
1478
+ f = fold ;
1479
+ if( col == 0 ) {
1480
+ done = 1 ;
1481
+ } else {
1482
+ col = 0 ;
1483
+ head = 0 ;
1484
+ theta = 1.0 ;
1485
+ } ;
1486
+ } else {
1487
+ double stp2 = ls[15];
1488
+ iter = (iter+1) ;
1489
+ if( iter >= maxiter ) {
1490
+ done = 1 ;
1491
+ } else {
1492
+ 0 ;
1493
+ } ;
1494
+ if( lb_projgr(g,w,ib,lbv,nv) <= pgtol ) {
1495
+ done = 1 ;
1496
+ } else {
1497
+ 0 ;
1498
+ } ;
1499
+ if( (fold-f) <= (ftol*lb_max(lb_max(lb_abs(fold),lb_abs(f)),1.0)) ) {
1500
+ done = 1 ;
1501
+ } else {
1502
+ 0 ;
1503
+ } ;
1504
+ if( done == 0 ) {
1505
+ double dr = ((gd-gdold)*stp2);
1506
+ double ddum = ((0.0-gdold)*stp2);
1507
+ if( dr > (eps*ddum) ) {
1508
+ int slot3 = ( ( col < m ) ? (((head+col) % m)) : (head) );
1509
+ double rr = 0.0;
1510
+ for( int j = 0 ; !(j == nv) ; j = (j+1) ) {
1511
+ double yj = (g[j]-gold[j]);
1512
+ smem[ ((slot3*nv)+j) ] = (stp2*d[j]) ;
1513
+ ymem[ ((slot3*nv)+j) ] = yj ;
1514
+ rr = (rr+(yj*yj)) ;
1515
+ ;
1516
+ } ;
1517
+ rho[ slot3 ] = (1.0/dr) ;
1518
+ theta = (rr/dr) ;
1519
+ if( col < m ) {
1520
+ col = (col+1) ;
1521
+ } else {
1522
+ head = ((head+1) % m) ;
1523
+ } ;
1524
+ ;
1525
+ ;
1526
+ 0 ;
1527
+ } else {
1528
+ 0 ;
1529
+ } ;
1530
+ ;
1531
+ } else {
1532
+ 0 ;
1533
+ } ;
1534
+ ;
1535
+ } ;
1536
+ ;
1537
+ } ;
1538
+ out[ 0 ] = f ;
1539
+ out[ 1 ] = double(nfg) ;
1540
+ return iter ;
1541
+ }
1542
+
1543
+
1544
+ SCM2CPP_FN inline double
1545
+ lbfgs_fg( int kind, scm2cpp::cspan<double> w, scm2cpp::span<double> g, scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, const std::array<double,4> & aux, scm2cpp::span<double> work, int n, int p, int k )
1546
+ {
1547
+ if( kind == 0 ) {
1548
+ return logistic_fg(w,g,x,y,work,aux[0],( ( aux[1] == 1.0 ) ? (1) : (0) ),( ( aux[2] == 1.0 ) ? (1) : (0) ),n,p,k) ;
1549
+ }
1550
+ else {
1551
+ if( kind == 1 ) {
1552
+ return huber_fg(w,g,x,y,work,aux[0],aux[1],( ( aux[2] == 1.0 ) ? (1) : (0) ),n,p) ;
1553
+ }
1554
+ else {
1555
+ return glm_fg(w,g,x,y,work,int(aux[1]),aux[3],aux[0],( ( aux[2] == 1.0 ) ? (1) : (0) ),n,p) ;
1556
+ }
1557
+ }
1558
+ }
1559
+
1560
+
1561
+ SCM2CPP_FN inline int
1562
+ gmm_mstep( scm2cpp::cspan<double> x, scm2cpp::cspan<double> resp, scm2cpp::span<double> weights, scm2cpp::span<double> means, scm2cpp::span<double> prec, scm2cpp::span<double> dw, scm2cpp::span<double> cov, scm2cpp::span<double> l, scm2cpp::span<double> u, double reg, int norm, int n, int p, int kc )
1563
+ { double tot = 0.0;
1564
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1565
+ weights[ c ] = 0.0 ;
1566
+ } ;
1567
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
1568
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1569
+ weights[ c ] = (weights[c]+resp[((i*kc)+c)]) ;
1570
+ } ;
1571
+ } ;
1572
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1573
+ weights[ c ] = (weights[c]+(10.0*2.220446049250313e-16)) ;
1574
+ tot = (tot+weights[c]) ;
1575
+ } ;
1576
+ for( int i2572 = 0 ; !(i2572 == kc) ; i2572 = (i2572+1) ) {
1577
+ for( int i2573 = 0 ; !(i2573 == p) ; i2573 = (i2573+1) ) {
1578
+ means[ ((i2572*p)+i2573) ] = 0.0 ;
1579
+ } ;
1580
+ } ;
1581
+ for( int k2570 = 0 ; !(k2570 == n) ; k2570 = (k2570+1) ) {
1582
+ for( int k2571 = 0 ; !(k2571 == kc) ; k2571 = (k2571+1) ) {
1583
+ for( int k2574 = 0 ; !(k2574 == p) ; k2574 = (k2574+1) ) {
1584
+ means[ ((k2571*p)+k2574) ] = (means[((k2571*p)+k2574)]+(x[((k2570*p)+k2574)]*resp[((k2570*kc)+k2571)])) ;
1585
+ } ;
1586
+ } ;
1587
+ } ;
1588
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1589
+ double nk = weights[c];
1590
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1591
+ means[ ((c*p)+j) ] = (means[((c*p)+j)]/nk) ;
1592
+ } ;
1593
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
1594
+ double r = resp[((i*kc)+c)];
1595
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1596
+ double dv = (x[((i*p)+j)]-means[((c*p)+j)]);
1597
+ u[ ((i*p)+j) ] = dv ;
1598
+ dw[ ((i*p)+j) ] = (r*dv) ;
1599
+ ;
1600
+ } ;
1601
+ ;
1602
+ } ;
1603
+ for( int i2577 = 0 ; !(i2577 == p) ; i2577 = (i2577+1) ) {
1604
+ for( int i2578 = 0 ; !(i2578 == p) ; i2578 = (i2578+1) ) {
1605
+ cov[ ((i2577*p)+i2578) ] = 0.0 ;
1606
+ } ;
1607
+ } ;
1608
+ for( int k2575 = 0 ; !(k2575 == n) ; k2575 = (k2575+1) ) {
1609
+ for( int k2576 = 0 ; !(k2576 == p) ; k2576 = (k2576+1) ) {
1610
+ for( int k2579 = 0 ; !(k2579 == p) ; k2579 = (k2579+1) ) {
1611
+ cov[ ((k2576*p)+k2579) ] = (cov[((k2576*p)+k2579)]+(u[((k2575*p)+k2579)]*dw[((k2575*p)+k2576)])) ;
1612
+ } ;
1613
+ } ;
1614
+ } ;
1615
+ for( int t = 0 ; !(t == (p*p)) ; t = (t+1) ) {
1616
+ cov[ t ] = (cov[t]/nk) ;
1617
+ } ;
1618
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1619
+ cov[ ((j*p)+j) ] = (cov[((j*p)+j)]+reg) ;
1620
+ } ;
1621
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1622
+ double s = cov[((j*p)+j)];
1623
+ for( int m = 0 ; !(m == j) ; m = (m+1) ) {
1624
+ s = (s-(l[((j*p)+m)]*l[((j*p)+m)])) ;
1625
+ } ;
1626
+ l[ ((j*p)+j) ] = sqrt(s) ;
1627
+ for( int i = (j+1) ; !(i >= p) ; i = (i+1) ) {
1628
+ double t2 = cov[((i*p)+j)];
1629
+ for( int m = 0 ; !(m == j) ; m = (m+1) ) {
1630
+ t2 = (t2-(l[((i*p)+m)]*l[((j*p)+m)])) ;
1631
+ } ;
1632
+ l[ ((i*p)+j) ] = (t2/l[((j*p)+j)]) ;
1633
+ ;
1634
+ } ;
1635
+ ;
1636
+ } ;
1637
+ for( int t = 0 ; !(t == (p*p)) ; t = (t+1) ) {
1638
+ prec[ ((c*(p*p))+t) ] = 0.0 ;
1639
+ } ;
1640
+ for( int e = 0 ; !(e == p) ; e = (e+1) ) {
1641
+ for( int i = e ; !(i == p) ; i = (i+1) ) {
1642
+ double t3 = ( ( i == e ) ? (1.0) : (0.0) );
1643
+ for( int m = e ; !(m == i) ; m = (m+1) ) {
1644
+ t3 = (t3-(l[((i*p)+m)]*prec[((c*(p*p))+((e*p)+m))])) ;
1645
+ } ;
1646
+ prec[ ((c*(p*p))+((e*p)+i)) ] = (t3/l[((i*p)+i)]) ;
1647
+ ;
1648
+ } ;
1649
+ } ;
1650
+ ;
1651
+ } ;
1652
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1653
+ weights[ c ] = (weights[c]/( ( norm == 1 ) ? (double(n)) : (tot) )) ;
1654
+ } ;
1655
+ return 0 ;
1656
+ }
1657
+
1658
+
1659
+ SCM2CPP_FN inline double
1660
+ gmm_estep( scm2cpp::cspan<double> x, scm2cpp::span<double> resp, scm2cpp::cspan<double> weights, scm2cpp::cspan<double> means, scm2cpp::cspan<double> prec, scm2cpp::span<double> wlp, scm2cpp::span<double> y, scm2cpp::span<double> u, scm2cpp::span<double> mu, int n, int p, int kc )
1661
+ { for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1662
+ double logdet = 0.0;
1663
+ double lw = log(weights[c]);
1664
+ for( int t = 0 ; !(t == (p*p)) ; t = (t+1) ) {
1665
+ u[ t ] = prec[((c*(p*p))+t)] ;
1666
+ } ;
1667
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1668
+ logdet = (logdet+log(u[((j*p)+j)])) ;
1669
+ double acc = 0.0;
1670
+ for( int m = 0 ; !(m == p) ; m = (m+1) ) {
1671
+ acc = (acc+(means[((c*p)+m)]*u[((m*p)+j)])) ;
1672
+ } ;
1673
+ mu[ j ] = acc ;
1674
+ ;
1675
+ } ;
1676
+ for( int k2581 = 0 ; !(k2581 == n) ; k2581 = (k2581+1) ) {
1677
+ for( int k2582 = 0 ; !(k2582 == p) ; k2582 = (k2582+1) ) {
1678
+ y[ ((k2581*p)+k2582) ] = ([&]() -> double { int i2583 = 0; double sum2584 = 0.0; while (!(i2583 == p)) {
1679
+ int i2583_next17402 = (i2583+1);
1680
+ double sum2584_next17403 = (sum2584+(x[((k2581*p)+i2583)]*u[((i2583*p)+k2582)]));
1681
+ i2583 = i2583_next17402;
1682
+ sum2584 = sum2584_next17403;
1683
+ } return sum2584; })() ;
1684
+ } ;
1685
+ } ;
1686
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
1687
+ double sq = 0.0;
1688
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
1689
+ double v = (y[((i*p)+j)]-mu[j]);
1690
+ sq = (sq+(v*v)) ;
1691
+ ;
1692
+ } ;
1693
+ wlp[ ((i*kc)+c) ] = (((-0.5*((double(p)*1.8378770664093453)+sq))+logdet)+lw) ;
1694
+ ;
1695
+ } ;
1696
+ ;
1697
+ } ;
1698
+ double lb = 0.0;
1699
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
1700
+ double amax = wlp[(i*kc)];
1701
+ double se = 0.0;
1702
+ for( int c = 1 ; !(c == kc) ; c = (c+1) ) {
1703
+ if( wlp[((i*kc)+c)] > amax ) {
1704
+ amax = wlp[((i*kc)+c)] ;
1705
+ } else {
1706
+ 0 ;
1707
+ } ;
1708
+ } ;
1709
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1710
+ se = (se+exp((wlp[((i*kc)+c)]-amax))) ;
1711
+ } ;
1712
+ double lse = (log(se)+amax);
1713
+ lb = (lb+lse) ;
1714
+ for( int c = 0 ; !(c == kc) ; c = (c+1) ) {
1715
+ resp[ ((i*kc)+c) ] = exp((wlp[((i*kc)+c)]-lse)) ;
1716
+ } ;
1717
+ ;
1718
+ ;
1719
+ } ;
1720
+ return (lb/double(n)) ;
1721
+ }
1722
+
1723
+
1724
+ SCM2CPP_FN inline double
1725
+ gmm_abs( double a )
1726
+ {
1727
+ if( a < 0.0 ) {
1728
+ return (0.0-a) ;
1729
+ }
1730
+ else {
1731
+ return a ;
1732
+ }
1733
+ }
1734
+
1735
+
1736
+ inline int
1737
+ gmm( scm2cpp::cspan<double> x, scm2cpp::span<double> resp, scm2cpp::span<double> weights, scm2cpp::span<double> means, scm2cpp::span<double> prec, scm2cpp::span<double> labels, scm2cpp::span<double> out, int maxiter, double tol, double reg, int n, int p, int kc )
1738
+ { std::vector<double> dw((n*p),0.0);
1739
+ std::vector<double> y((n*p),0.0);
1740
+ std::vector<double> wlp((n*kc),0.0);
1741
+ std::vector<double> cov((p*p),0.0);
1742
+ std::vector<double> l((p*p),0.0);
1743
+ std::vector<double> u((p*p),0.0);
1744
+ std::vector<double> mu(p,0.0);
1745
+ double lb = -1e+300;
1746
+ int it = 0;
1747
+ int conv = 0;
1748
+ int done = 0;
1749
+ gmm_mstep(x,resp,weights,means,prec,dw,cov,l,y,reg,1,n,p,kc) ;
1750
+ for( ; !((done == 1 || it >= maxiter)) ; ) {
1751
+ double prev = lb;
1752
+ lb = gmm_estep(x,resp,weights,means,prec,wlp,y,u,mu,n,p,kc) ;
1753
+ gmm_mstep(x,resp,weights,means,prec,dw,cov,l,y,reg,0,n,p,kc) ;
1754
+ it = (it+1) ;
1755
+ if( (it > 1 && gmm_abs(double((lb-prev))) < tol) ) {
1756
+ conv = 1 ;
1757
+ done = 1 ;
1758
+ } else {
1759
+ 0 ;
1760
+ } ;
1761
+ ;
1762
+ } ;
1763
+ gmm_estep(x,resp,weights,means,prec,wlp,y,u,mu,n,p,kc) ;
1764
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
1765
+ int best = 0;
1766
+ double bv = resp[(i*kc)];
1767
+ for( int c = 1 ; !(c == kc) ; c = (c+1) ) {
1768
+ if( resp[((i*kc)+c)] > bv ) {
1769
+ bv = resp[((i*kc)+c)] ;
1770
+ best = c ;
1771
+ } else {
1772
+ 0 ;
1773
+ } ;
1774
+ } ;
1775
+ labels[ i ] = double(best) ;
1776
+ ;
1777
+ } ;
1778
+ out[ 0 ] = lb ;
1779
+ out[ 1 ] = double(conv) ;
1780
+ return it ;
1781
+ }
1782
+
1783
+
1784
+ SCM2CPP_FN inline double
1785
+ eig_hypot( double a, double b )
1786
+ {
1787
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
1788
+ double bb = ( ( b < 0.0 ) ? ((0.0-b)) : (b) );
1789
+ if( aa > bb ) {
1790
+ return (aa*sqrt((1.0+((bb/aa)*(bb/aa))))) ;
1791
+ }
1792
+ else {
1793
+ if( bb == 0.0 ) {
1794
+ return 0.0 ;
1795
+ }
1796
+ else {
1797
+ return (bb*sqrt((1.0+((aa/bb)*(aa/bb))))) ;
1798
+ }
1799
+ }
1800
+ }
1801
+
1802
+
1803
+ SCM2CPP_FN inline int
1804
+ sym_eigen( scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int m )
1805
+ { for( int ii = 0 ; !(ii == (m-1)) ; ii = (ii+1) ) {
1806
+ int i = ((m-1)-ii);
1807
+ int l = (i-1);
1808
+ double h = 0.0;
1809
+ double scale = 0.0;
1810
+ if( l > 0 ) {
1811
+ for( int k = 0 ; !(k > l) ; k = (k+1) ) {
1812
+ double ak = a[((i*m)+k)];
1813
+ scale = (scale+( ( ak < 0.0 ) ? ((0.0-ak)) : (ak) )) ;
1814
+ ;
1815
+ } ;
1816
+ if( scale == 0.0 ) {
1817
+ e[ i ] = a[((i*m)+l)] ;
1818
+ } else {
1819
+ for( int k = 0 ; !(k > l) ; k = (k+1) ) {
1820
+ a[ ((i*m)+k) ] = (a[((i*m)+k)]/scale) ;
1821
+ h = (h+(a[((i*m)+k)]*a[((i*m)+k)])) ;
1822
+ } ;
1823
+ double f = a[((i*m)+l)];
1824
+ double g = ( ( f >= 0.0 ) ? ((0.0-sqrt(h))) : (sqrt(h)) );
1825
+ e[ i ] = (scale*g) ;
1826
+ h = (h-(f*g)) ;
1827
+ a[ ((i*m)+l) ] = (f-g) ;
1828
+ double ff = 0.0;
1829
+ for( int j = 0 ; !(j > l) ; j = (j+1) ) {
1830
+ a[ ((j*m)+i) ] = (a[((i*m)+j)]/h) ;
1831
+ double gg = 0.0;
1832
+ for( int k = 0 ; !(k > j) ; k = (k+1) ) {
1833
+ gg = (gg+(a[((j*m)+k)]*a[((i*m)+k)])) ;
1834
+ } ;
1835
+ for( int k = (j+1) ; !(k > l) ; k = (k+1) ) {
1836
+ gg = (gg+(a[((k*m)+j)]*a[((i*m)+k)])) ;
1837
+ } ;
1838
+ e[ j ] = (gg/h) ;
1839
+ ff = (ff+(e[j]*a[((i*m)+j)])) ;
1840
+ ;
1841
+ } ;
1842
+ double hh = (ff/(h+h));
1843
+ for( int j = 0 ; !(j > l) ; j = (j+1) ) {
1844
+ double f2 = a[((i*m)+j)];
1845
+ double g2 = (e[j]-(hh*f2));
1846
+ e[ j ] = g2 ;
1847
+ for( int k = 0 ; !(k > j) ; k = (k+1) ) {
1848
+ a[ ((j*m)+k) ] = (a[((j*m)+k)]-((f2*e[k])+(g2*a[((i*m)+k)]))) ;
1849
+ } ;
1850
+ ;
1851
+ ;
1852
+ } ;
1853
+ ;
1854
+ ;
1855
+ ;
1856
+ ;
1857
+ } ;
1858
+ } else {
1859
+ e[ i ] = a[((i*m)+l)] ;
1860
+ } ;
1861
+ ev[ i ] = h ;
1862
+ ;
1863
+ ;
1864
+ } ;
1865
+ ev[ 0 ] = 0.0 ;
1866
+ e[ 0 ] = 0.0 ;
1867
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
1868
+ if( !(ev[i] == 0.0) ) {
1869
+ for( int j = 0 ; !(j == i) ; j = (j+1) ) {
1870
+ double g3 = 0.0;
1871
+ for( int k = 0 ; !(k == i) ; k = (k+1) ) {
1872
+ g3 = (g3+(a[((i*m)+k)]*a[((k*m)+j)])) ;
1873
+ } ;
1874
+ for( int k = 0 ; !(k == i) ; k = (k+1) ) {
1875
+ a[ ((k*m)+j) ] = (a[((k*m)+j)]-(g3*a[((k*m)+i)])) ;
1876
+ } ;
1877
+ ;
1878
+ } ;
1879
+ } else {
1880
+ 0 ;
1881
+ } ;
1882
+ ev[ i ] = a[((i*m)+i)] ;
1883
+ a[ ((i*m)+i) ] = 1.0 ;
1884
+ for( int j = 0 ; !(j == i) ; j = (j+1) ) {
1885
+ a[ ((j*m)+i) ] = 0.0 ;
1886
+ a[ ((i*m)+j) ] = 0.0 ;
1887
+ } ;
1888
+ } ;
1889
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
1890
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
1891
+ v[ ((j*m)+i) ] = a[((i*m)+j)] ;
1892
+ } ;
1893
+ } ;
1894
+ for( int i = 1 ; !(i == m) ; i = (i+1) ) {
1895
+ e[ (i-1) ] = e[i] ;
1896
+ } ;
1897
+ e[ (m-1) ] = 0.0 ;
1898
+ for( int l = 0 ; !(l == m) ; l = (l+1) ) {
1899
+ int fin = 0;
1900
+ int iter = 0;
1901
+ for( ; !((fin == 1 || iter > 60)) ; ) {
1902
+ int mm = l;
1903
+ int found = 0;
1904
+ for( ; !((found == 1 || mm >= (m-1))) ; ) {
1905
+ double dd = (eig_abs(ev[mm])+eig_abs(ev[(mm+1)]));
1906
+ if( (eig_abs(e[mm])+dd) == dd ) {
1907
+ found = 1 ;
1908
+ } else {
1909
+ mm = (mm+1) ;
1910
+ } ;
1911
+ ;
1912
+ } ;
1913
+ if( mm == l ) {
1914
+ fin = 1 ;
1915
+ } else {
1916
+ iter = (iter+1) ;
1917
+ double g = ((ev[(l+1)]-ev[l])/(2.0*e[l]));
1918
+ double r = eig_hypot(g,1.0);
1919
+ double g4 = ((ev[mm]-ev[l])+(e[l]/(g+( ( g >= 0.0 ) ? (eig_abs(r)) : ((0.0-eig_abs(r))) ))));
1920
+ double s = 1.0;
1921
+ double c = 1.0;
1922
+ double pp = 0.0;
1923
+ double gq = g4;
1924
+ int under = 0;
1925
+ int i = (mm-1);
1926
+ for( ; !((under == 1 || i < l)) ; ) {
1927
+ double f = (s*e[i]);
1928
+ double b = (c*e[i]);
1929
+ double r2 = eig_hypot(f,gq);
1930
+ e[ (i+1) ] = r2 ;
1931
+ if( r2 == 0.0 ) {
1932
+ ev[ (i+1) ] = (ev[(i+1)]-pp) ;
1933
+ e[ mm ] = 0.0 ;
1934
+ under = 1 ;
1935
+ } else {
1936
+ s = (f/r2) ;
1937
+ c = (gq/r2) ;
1938
+ double g5 = (ev[(i+1)]-pp);
1939
+ double r3 = (((ev[i]-g5)*s)+(2.0*(c*b)));
1940
+ pp = (s*r3) ;
1941
+ ev[ (i+1) ] = (g5+pp) ;
1942
+ gq = ((c*r3)-b) ;
1943
+ ;
1944
+ ;
1945
+ for( int k = 0 ; !(k == m) ; k = (k+1) ) {
1946
+ double zf = v[(((i+1)*m)+k)];
1947
+ double zi = v[((i*m)+k)];
1948
+ v[ (((i+1)*m)+k) ] = ((s*zi)+(c*zf)) ;
1949
+ v[ ((i*m)+k) ] = ((c*zi)-(s*zf)) ;
1950
+ ;
1951
+ } ;
1952
+ i = (i-1) ;
1953
+ } ;
1954
+ ;
1955
+ ;
1956
+ } ;
1957
+ if( under == 0 ) {
1958
+ ev[ l ] = (ev[l]-pp) ;
1959
+ e[ l ] = gq ;
1960
+ e[ mm ] = 0.0 ;
1961
+ } else {
1962
+ 0 ;
1963
+ } ;
1964
+ ;
1965
+ ;
1966
+ ;
1967
+ ;
1968
+ } ;
1969
+ ;
1970
+ } ;
1971
+ ;
1972
+ } ;
1973
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
1974
+ for( int j = (i+1) ; !(j >= m) ; j = (j+1) ) {
1975
+ double tmp = v[((i*m)+j)];
1976
+ v[ ((i*m)+j) ] = v[((j*m)+i)] ;
1977
+ v[ ((j*m)+i) ] = tmp ;
1978
+ ;
1979
+ } ;
1980
+ } ;
1981
+ return 0 ;
1982
+ }
1983
+
1984
+
1985
+ SCM2CPP_FN inline double
1986
+ eig_abs( double a )
1987
+ {
1988
+ if( a < 0.0 ) {
1989
+ return (0.0-a) ;
1990
+ }
1991
+ else {
1992
+ return a ;
1993
+ }
1994
+ }
1995
+
1996
+
1997
+ SCM2CPP_FN inline int
1998
+ eig_order( scm2cpp::cspan<double> ev, scm2cpp::span<int> ord, int m )
1999
+ { for( int j = 0 ; !(j == m) ; j = (j+1) ) {
2000
+ ord[ j ] = j ;
2001
+ } ;
2002
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
2003
+ int best = j;
2004
+ for( int r = (j+1) ; !(r >= m) ; r = (r+1) ) {
2005
+ if( ev[ord[r]] > ev[ord[best]] ) {
2006
+ best = r ;
2007
+ } else {
2008
+ 0 ;
2009
+ } ;
2010
+ } ;
2011
+ int tmp = ord[j];
2012
+ ord[ j ] = ord[best] ;
2013
+ ord[ best ] = tmp ;
2014
+ ;
2015
+ ;
2016
+ } ;
2017
+ return 0 ;
2018
+ }
2019
+
2020
+
2021
+ SCM2CPP_FN inline double
2022
+ ica_tanh( double x )
2023
+ {
2024
+ return (1.0-(2.0/(exp((2.0*x))+1.0))) ;
2025
+ }
2026
+
2027
+
2028
+ SCM2CPP_FN inline int
2029
+ ica_sym( scm2cpp::span<double> w, scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, scm2cpp::span<double> t, int m )
2030
+ { for( int i = 0 ; !(i == m) ; i = (i+1) ) {
2031
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
2032
+ double acc = 0.0;
2033
+ for( int r = 0 ; !(r == m) ; r = (r+1) ) {
2034
+ acc = (acc+(w[((i*m)+r)]*w[((j*m)+r)])) ;
2035
+ } ;
2036
+ a[ ((i*m)+j) ] = acc ;
2037
+ ;
2038
+ } ;
2039
+ } ;
2040
+ sym_eigen(a,v,ev,e,m) ;
2041
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
2042
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
2043
+ double acc = 0.0;
2044
+ for( int r = 0 ; !(r == m) ; r = (r+1) ) {
2045
+ double sr = ( ( ev[r] < 2.2250738585072014e-308 ) ? (2.2250738585072014e-308) : (ev[r]) );
2046
+ acc = (acc+((v[((i*m)+r)]/sqrt(sr))*v[((j*m)+r)])) ;
2047
+ ;
2048
+ } ;
2049
+ t[ ((i*m)+j) ] = acc ;
2050
+ ;
2051
+ } ;
2052
+ } ;
2053
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
2054
+ for( int j = 0 ; !(j == m) ; j = (j+1) ) {
2055
+ double acc = 0.0;
2056
+ for( int r = 0 ; !(r == m) ; r = (r+1) ) {
2057
+ acc = (acc+(t[((i*m)+r)]*w[((r*m)+j)])) ;
2058
+ } ;
2059
+ a[ ((i*m)+j) ] = acc ;
2060
+ ;
2061
+ } ;
2062
+ } ;
2063
+ for( int t2 = 0 ; !(t2 == (m*m)) ; t2 = (t2+1) ) {
2064
+ w[ t2 ] = a[t2] ;
2065
+ } ;
2066
+ return 0 ;
2067
+ }
2068
+
2069
+
2070
+ inline int
2071
+ fastica( scm2cpp::cspan<double> x, scm2cpp::cspan<double> winit, scm2cpp::span<double> comps, scm2cpp::span<double> white, scm2cpp::span<double> unmix, scm2cpp::span<double> mean, int maxiter, double tol, int n, int p, int nc )
2072
+ { std::vector<double> xc((n*p),0.0);
2073
+ std::vector<double> g((p*p),0.0);
2074
+ std::vector<double> u((p*p),0.0);
2075
+ std::vector<double> ev(p,0.0);
2076
+ std::vector<int> ord(p,0);
2077
+ std::vector<double> x1((nc*n),0.0);
2078
+ std::vector<double> gw((nc*n),0.0);
2079
+ std::vector<double> w1((nc*nc),0.0);
2080
+ std::vector<double> gx(nc,0.0);
2081
+ std::vector<double> sa((nc*nc),0.0);
2082
+ std::vector<double> sv((nc*nc),0.0);
2083
+ std::vector<double> se(nc,0.0);
2084
+ std::vector<double> se2(nc,0.0);
2085
+ std::vector<double> pe(p,0.0);
2086
+ std::vector<double> st((nc*nc),0.0);
2087
+ int it = 0;
2088
+ int done = 0;
2089
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2090
+ mean[ j ] = 0.0 ;
2091
+ } ;
2092
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2093
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2094
+ mean[ j ] = (mean[j]+x[((i*p)+j)]) ;
2095
+ } ;
2096
+ } ;
2097
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2098
+ mean[ j ] = (mean[j]/double(n)) ;
2099
+ } ;
2100
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2101
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2102
+ xc[ ((i*p)+j) ] = (x[((i*p)+j)]-mean[j]) ;
2103
+ } ;
2104
+ } ;
2105
+ for( int k2595 = 0 ; !(k2595 == p) ; k2595 = (k2595+1) ) {
2106
+ for( int k2596 = k2595 ; !(k2596 == p) ; k2596 = (k2596+1) ) {
2107
+ g[ ((k2595*p)+k2596) ] = ([&]() -> double { int i2598 = 0; double r2599 = 0.0; while (!(i2598 == n)) {
2108
+ int i2598_next17416 = (i2598+1);
2109
+ double r2599_next17417 = (r2599+(xc[((i2598*p)+k2595)]*xc[((i2598*p)+k2596)]));
2110
+ i2598 = i2598_next17416;
2111
+ r2599 = r2599_next17417;
2112
+ } return r2599; })() ;
2113
+ g[ ((k2596*p)+k2595) ] = g[((k2595*p)+k2596)] ;
2114
+ } ;
2115
+ } ;
2116
+ sym_eigen(g,u,ev,pe,p) ;
2117
+ eig_order(ev,ord,p) ;
2118
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2119
+ int col = ord[c];
2120
+ double sg = ( ( u[col] < 0.0 ) ? (-1.0) : (( ( u[col] > 0.0 ) ? (1.0) : (0.0) )) );
2121
+ double d = sqrt(ev[col]);
2122
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2123
+ white[ ((c*p)+j) ] = ((sg*u[((j*p)+col)])/d) ;
2124
+ } ;
2125
+ ;
2126
+ ;
2127
+ } ;
2128
+ for( int k2601 = 0 ; !(k2601 == nc) ; k2601 = (k2601+1) ) {
2129
+ for( int k2602 = 0 ; !(k2602 == n) ; k2602 = (k2602+1) ) {
2130
+ x1[ ((k2601*n)+k2602) ] = ([&]() -> double { int i2604 = 0; double r2605 = 0.0; while (!(i2604 == p)) {
2131
+ int i2604_next17418 = (i2604+1);
2132
+ double r2605_next17419 = (r2605+(white[((k2601*p)+i2604)]*xc[((k2602*p)+i2604)]));
2133
+ i2604 = i2604_next17418;
2134
+ r2605 = r2605_next17419;
2135
+ } return r2605; })() ;
2136
+ } ;
2137
+ } ;
2138
+ double sn = sqrt(double(n));
2139
+ for( int t = 0 ; !(t == (nc*n)) ; t = (t+1) ) {
2140
+ x1[ t ] = (x1[t]*sn) ;
2141
+ } ;
2142
+ ;
2143
+ for( int t = 0 ; !(t == (nc*nc)) ; t = (t+1) ) {
2144
+ unmix[ t ] = winit[t] ;
2145
+ } ;
2146
+ ica_sym(unmix,sa,sv,se,se2,st,nc) ;
2147
+ for( ; !((done == 1 || it >= maxiter)) ; ) {
2148
+ for( int k2613 = 0 ; !(k2613 == nc) ; k2613 = (k2613+1) ) {
2149
+ for( int k2614 = 0 ; !(k2614 == n) ; k2614 = (k2614+1) ) {
2150
+ gw[ ((k2613*n)+k2614) ] = ([&]() -> double { int i2615 = 0; double sum2616 = 0.0; while (!(i2615 == nc)) {
2151
+ int i2615_next17420 = (i2615+1);
2152
+ double sum2616_next17421 = (sum2616+(unmix[((k2613*nc)+i2615)]*x1[((i2615*n)+k2614)]));
2153
+ i2615 = i2615_next17420;
2154
+ sum2616 = sum2616_next17421;
2155
+ } return sum2616; })() ;
2156
+ } ;
2157
+ } ;
2158
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2159
+ double acc = 0.0;
2160
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2161
+ double th = ica_tanh(gw[((c*n)+i)]);
2162
+ gw[ ((c*n)+i) ] = th ;
2163
+ acc = (acc+(1.0-(th*th))) ;
2164
+ ;
2165
+ } ;
2166
+ gx[ c ] = (acc/double(n)) ;
2167
+ ;
2168
+ } ;
2169
+ for( int k2618 = 0 ; !(k2618 == nc) ; k2618 = (k2618+1) ) {
2170
+ for( int k2619 = 0 ; !(k2619 == nc) ; k2619 = (k2619+1) ) {
2171
+ w1[ ((k2618*nc)+k2619) ] = ([&]() -> double { int i2621 = 0; double r2622 = 0.0; while (!(i2621 == n)) {
2172
+ int i2621_next17426 = (i2621+1);
2173
+ double r2622_next17427 = (r2622+(gw[((k2618*n)+i2621)]*x1[((k2619*n)+i2621)]));
2174
+ i2621 = i2621_next17426;
2175
+ r2622 = r2622_next17427;
2176
+ } return r2622; })() ;
2177
+ } ;
2178
+ } ;
2179
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2180
+ for( int j = 0 ; !(j == nc) ; j = (j+1) ) {
2181
+ w1[ ((c*nc)+j) ] = ((w1[((c*nc)+j)]/double(n))-(gx[c]*unmix[((c*nc)+j)])) ;
2182
+ } ;
2183
+ } ;
2184
+ ica_sym(w1,sa,sv,se,se2,st,nc) ;
2185
+ double lim = 0.0;
2186
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2187
+ double acc = 0.0;
2188
+ for( int j = 0 ; !(j == nc) ; j = (j+1) ) {
2189
+ acc = (acc+(w1[((c*nc)+j)]*unmix[((c*nc)+j)])) ;
2190
+ } ;
2191
+ double dv = (( ( acc < 0.0 ) ? ((0.0-acc)) : (acc) )-1.0);
2192
+ double av = ( ( dv < 0.0 ) ? ((0.0-dv)) : (dv) );
2193
+ if( av > lim ) {
2194
+ lim = av ;
2195
+ } else {
2196
+ 0 ;
2197
+ } ;
2198
+ ;
2199
+ ;
2200
+ ;
2201
+ } ;
2202
+ for( int t = 0 ; !(t == (nc*nc)) ; t = (t+1) ) {
2203
+ unmix[ t ] = w1[t] ;
2204
+ } ;
2205
+ it = (it+1) ;
2206
+ if( lim < tol ) {
2207
+ done = 1 ;
2208
+ } else {
2209
+ 0 ;
2210
+ } ;
2211
+ ;
2212
+ } ;
2213
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2214
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2215
+ double acc = 0.0;
2216
+ for( int r = 0 ; !(r == nc) ; r = (r+1) ) {
2217
+ acc = (acc+(unmix[((c*nc)+r)]*white[((r*p)+j)])) ;
2218
+ } ;
2219
+ comps[ ((c*p)+j) ] = acc ;
2220
+ ;
2221
+ } ;
2222
+ } ;
2223
+ for( int k2607 = 0 ; !(k2607 == nc) ; k2607 = (k2607+1) ) {
2224
+ for( int k2608 = 0 ; !(k2608 == n) ; k2608 = (k2608+1) ) {
2225
+ gw[ ((k2607*n)+k2608) ] = ([&]() -> double { int i2610 = 0; double r2611 = 0.0; while (!(i2610 == p)) {
2226
+ int i2610_next17428 = (i2610+1);
2227
+ double r2611_next17429 = (r2611+(comps[((k2607*p)+i2610)]*xc[((k2608*p)+i2610)]));
2228
+ i2610 = i2610_next17428;
2229
+ r2611 = r2611_next17429;
2230
+ } return r2611; })() ;
2231
+ } ;
2232
+ } ;
2233
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2234
+ double m1 = 0.0;
2235
+ double v1 = 0.0;
2236
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2237
+ m1 = (m1+gw[((c*n)+i)]) ;
2238
+ } ;
2239
+ m1 = (m1/double(n)) ;
2240
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2241
+ double dd = (gw[((c*n)+i)]-m1);
2242
+ v1 = (v1+(dd*dd)) ;
2243
+ ;
2244
+ } ;
2245
+ double sd = sqrt((v1/double(n)));
2246
+ for( int j = 0 ; !(j == nc) ; j = (j+1) ) {
2247
+ unmix[ ((c*nc)+j) ] = (unmix[((c*nc)+j)]/sd) ;
2248
+ } ;
2249
+ ;
2250
+ ;
2251
+ } ;
2252
+ for( int c = 0 ; !(c == nc) ; c = (c+1) ) {
2253
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2254
+ double acc = 0.0;
2255
+ for( int r = 0 ; !(r == nc) ; r = (r+1) ) {
2256
+ acc = (acc+(unmix[((c*nc)+r)]*white[((r*p)+j)])) ;
2257
+ } ;
2258
+ comps[ ((c*p)+j) ] = acc ;
2259
+ ;
2260
+ } ;
2261
+ } ;
2262
+ return it ;
2263
+ }
2264
+
2265
+
2266
+ inline int
2267
+ 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 )
2268
+ { std::vector<double> c((p*p),0.0);
2269
+ std::vector<double> v((p*p),0.0);
2270
+ std::vector<double> e(p,0.0);
2271
+ std::vector<double> sc(p,0.0);
2272
+ std::vector<int> ord(p,0);
2273
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2274
+ mean[ j ] = 0.0 ;
2275
+ } ;
2276
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2277
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2278
+ mean[ j ] = (mean[j]+x[((i*p)+j)]) ;
2279
+ } ;
2280
+ } ;
2281
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2282
+ mean[ j ] = (mean[j]/double(n)) ;
2283
+ } ;
2284
+ for( int k2625 = 0 ; !(k2625 == p) ; k2625 = (k2625+1) ) {
2285
+ for( int k2626 = k2625 ; !(k2626 == p) ; k2626 = (k2626+1) ) {
2286
+ c[ ((k2625*p)+k2626) ] = ([&]() -> double { int i2628 = 0; double r2629 = 0.0; while (!(i2628 == n)) {
2287
+ int i2628_next17430 = (i2628+1);
2288
+ double r2629_next17431 = (r2629+(x[((i2628*p)+k2625)]*x[((i2628*p)+k2626)]));
2289
+ i2628 = i2628_next17430;
2290
+ r2629 = r2629_next17431;
2291
+ } return r2629; })() ;
2292
+ c[ ((k2626*p)+k2625) ] = c[((k2625*p)+k2626)] ;
2293
+ } ;
2294
+ } ;
2295
+ for( int i = 0 ; !(i == p) ; i = (i+1) ) {
2296
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2297
+ c[ ((i*p)+j) ] = ((c[((i*p)+j)]-(double(n)*(mean[i]*mean[j])))/double((n-1))) ;
2298
+ } ;
2299
+ } ;
2300
+ sym_eigen(c,v,e,sc,p) ;
2301
+ eig_order(e,ord,p) ;
2302
+ for( int r = 0 ; !(r == p) ; r = (r+1) ) {
2303
+ int col = ord[r];
2304
+ double lam = ( ( e[col] < 0.0 ) ? (0.0) : (e[col]) );
2305
+ int big = 0;
2306
+ double bv = -1.0;
2307
+ ev[ r ] = lam ;
2308
+ sv[ r ] = sqrt((lam*double((n-1)))) ;
2309
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2310
+ double a = v[((j*p)+col)];
2311
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
2312
+ if( aa > bv ) {
2313
+ bv = aa ;
2314
+ big = j ;
2315
+ } else {
2316
+ 0 ;
2317
+ } ;
2318
+ ;
2319
+ ;
2320
+ } ;
2321
+ double sg = ( ( v[((big*p)+col)] < 0.0 ) ? (-1.0) : (1.0) );
2322
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2323
+ comps[ ((r*p)+j) ] = (sg*v[((j*p)+col)]) ;
2324
+ } ;
2325
+ ;
2326
+ ;
2327
+ ;
2328
+ } ;
2329
+ return 0 ;
2330
+ }
2331
+
2332
+
2333
+ SCM2CPP_FN inline int
2334
+ ard_pinvh( scm2cpp::span<double> a, scm2cpp::span<double> s, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, int k )
2335
+ { sym_eigen(a,v,ev,e,k) ;
2336
+ double mx = 0.0;
2337
+ for( int r = 0 ; !(r == k) ; r = (r+1) ) {
2338
+ double av = ( ( ev[r] < 0.0 ) ? ((0.0-ev[r])) : (ev[r]) );
2339
+ if( av > mx ) {
2340
+ mx = av ;
2341
+ } else {
2342
+ 0 ;
2343
+ } ;
2344
+ ;
2345
+ } ;
2346
+ double cut = (mx*(double(k)*2.220446049250313e-16));
2347
+ for( int i = 0 ; !(i == k) ; i = (i+1) ) {
2348
+ for( int j = 0 ; !(j == k) ; j = (j+1) ) {
2349
+ double acc = 0.0;
2350
+ for( int r = 0 ; !(r == k) ; r = (r+1) ) {
2351
+ double er = ev[r];
2352
+ if( ( ( er < 0.0 ) ? ((0.0-er)) : (er) ) > cut ) {
2353
+ acc = (acc+((v[((i*k)+r)]*v[((j*k)+r)])/er)) ;
2354
+ } else {
2355
+ 0 ;
2356
+ } ;
2357
+ ;
2358
+ } ;
2359
+ s[ ((i*k)+j) ] = acc ;
2360
+ ;
2361
+ } ;
2362
+ } ;
2363
+ ;
2364
+ ;
2365
+ return 0 ;
2366
+ }
2367
+
2368
+
2369
+ SCM2CPP_FN inline int
2370
+ ard_sigma_coef( scm2cpp::cspan<double> xy, scm2cpp::cspan<int> idx, scm2cpp::cspan<double> lam, scm2cpp::span<double> coef, scm2cpp::span<double> sigma, scm2cpp::span<double> a, scm2cpp::span<double> v, scm2cpp::span<double> ev, scm2cpp::span<double> e, scm2cpp::cspan<double> gk, double alpha, int k )
2371
+ { for( int r = 0 ; !(r == k) ; r = (r+1) ) {
2372
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2373
+ a[ ((r*k)+c) ] = (( ( r == c ) ? (lam[idx[r]]) : (0.0) )+(alpha*gk[((r*k)+c)])) ;
2374
+ } ;
2375
+ } ;
2376
+ ard_pinvh(a,sigma,v,ev,e,k) ;
2377
+ for( int r = 0 ; !(r == k) ; r = (r+1) ) {
2378
+ double acc = 0.0;
2379
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2380
+ acc = (acc+(sigma[((r*k)+c)]*xy[idx[c]])) ;
2381
+ } ;
2382
+ coef[ idx[r] ] = (alpha*acc) ;
2383
+ ;
2384
+ } ;
2385
+ return 0 ;
2386
+ }
2387
+
2388
+
2389
+ inline int
2390
+ ard( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> coef, scm2cpp::span<double> sigma, scm2cpp::span<double> lam, scm2cpp::span<double> out, int maxiter, double tol, double alpha1, double alpha2, double lambda1, double lambda2, double thresh, int hoist, int n, int p )
2391
+ { std::vector<double> g(( ( hoist == 1 ) ? ((p*p)) : (1) ),0.0);
2392
+ std::vector<double> xy(p,0.0);
2393
+ std::vector<double> xk(( ( hoist == 1 ) ? (1) : ((n*p)) ),0.0);
2394
+ std::vector<double> gk((p*p),0.0);
2395
+ std::vector<double> a((p*p),0.0);
2396
+ std::vector<double> v((p*p),0.0);
2397
+ std::vector<double> ev(p,0.0);
2398
+ std::vector<double> e(p,0.0);
2399
+ std::vector<double> r(n,0.0);
2400
+ std::vector<int> idx(p,0);
2401
+ std::vector<int> keep(p,1);
2402
+ std::vector<double> old(p,0.0);
2403
+ double alpha = 0.0;
2404
+ int k = p;
2405
+ int it = 0;
2406
+ int done = 0;
2407
+ if( hoist == 1 ) {
2408
+ for( int k2638 = 0 ; !(k2638 == p) ; k2638 = (k2638+1) ) {
2409
+ for( int k2639 = k2638 ; !(k2639 == p) ; k2639 = (k2639+1) ) {
2410
+ g[ ((k2638*p)+k2639) ] = ([&]() -> double { int i2641 = 0; double r2642 = 0.0; while (!(i2641 == n)) {
2411
+ int i2641_next17432 = (i2641+1);
2412
+ double r2642_next17433 = (r2642+(x[((i2641*p)+k2638)]*x[((i2641*p)+k2639)]));
2413
+ i2641 = i2641_next17432;
2414
+ r2642 = r2642_next17433;
2415
+ } return r2642; })() ;
2416
+ g[ ((k2639*p)+k2638) ] = g[((k2638*p)+k2639)] ;
2417
+ } ;
2418
+ } ;
2419
+ } else {
2420
+ 0 ;
2421
+ } ;
2422
+ for( int i2636 = 0 ; !(i2636 == p) ; i2636 = (i2636+1) ) {
2423
+ xy[ i2636 ] = 0.0 ;
2424
+ } ;
2425
+ for( int k2634 = 0 ; !(k2634 == n) ; k2634 = (k2634+1) ) {
2426
+ for( int i2637 = 0 ; !(i2637 == p) ; i2637 = (i2637+1) ) {
2427
+ xy[ i2637 ] = (xy[i2637]+(x[((k2634*p)+i2637)]*y[k2634])) ;
2428
+ } ;
2429
+ } ;
2430
+ double ym = 0.0;
2431
+ double vy = 0.0;
2432
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2433
+ ym = (ym+y[i]) ;
2434
+ } ;
2435
+ ym = (ym/double(n)) ;
2436
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2437
+ vy = (vy+((y[i]-ym)*(y[i]-ym))) ;
2438
+ } ;
2439
+ alpha = (1.0/((vy/double(n))+2.220446049250313e-16)) ;
2440
+ ;
2441
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2442
+ lam[ j ] = 1.0 ;
2443
+ coef[ j ] = 0.0 ;
2444
+ } ;
2445
+ for( ; !((done == 1 || it >= maxiter)) ; ) {
2446
+ k = 0 ;
2447
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2448
+ if( keep[j] == 1 ) {
2449
+ idx[ k ] = j ;
2450
+ k = (k+1) ;
2451
+ } else {
2452
+ 0 ;
2453
+ } ;
2454
+ } ;
2455
+ if( hoist == 1 ) {
2456
+ for( int r = 0 ; !(r == k) ; r = (r+1) ) {
2457
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2458
+ gk[ ((r*k)+c) ] = g[((idx[r]*p)+idx[c])] ;
2459
+ } ;
2460
+ } ;
2461
+ } else {
2462
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2463
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2464
+ xk[ ((i*k)+c) ] = x[((i*p)+idx[c])] ;
2465
+ } ;
2466
+ } ;
2467
+ for( int k2644 = 0 ; !(k2644 == k) ; k2644 = (k2644+1) ) {
2468
+ for( int k2645 = k2644 ; !(k2645 == k) ; k2645 = (k2645+1) ) {
2469
+ gk[ ((k2644*k)+k2645) ] = ([&]() -> double { int i2647 = 0; double r2648 = 0.0; while (!(i2647 == n)) {
2470
+ int i2647_next17434 = (i2647+1);
2471
+ double r2648_next17435 = (r2648+(xk[((i2647*k)+k2644)]*xk[((i2647*k)+k2645)]));
2472
+ i2647 = i2647_next17434;
2473
+ r2648 = r2648_next17435;
2474
+ } return r2648; })() ;
2475
+ gk[ ((k2645*k)+k2644) ] = gk[((k2644*k)+k2645)] ;
2476
+ } ;
2477
+ } ;
2478
+ } ;
2479
+ ard_sigma_coef(xy,idx,lam,coef,sigma,a,v,ev,e,gk,alpha,k) ;
2480
+ for( int k2650 = 0 ; !(k2650 == n) ; k2650 = (k2650+1) ) {
2481
+ r[ k2650 ] = ([&]() -> double { int i2653 = 0; double r2654 = 0.0; while (!(i2653 == p)) {
2482
+ int i2653_next17436 = (i2653+1);
2483
+ double r2654_next17437 = (r2654+(x[((k2650*p)+i2653)]*coef[i2653]));
2484
+ i2653 = i2653_next17436;
2485
+ r2654 = r2654_next17437;
2486
+ } return r2654; })() ;
2487
+ } ;
2488
+ double sse = 0.0;
2489
+ double gsum = 0.0;
2490
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2491
+ double d = (y[i]-r[i]);
2492
+ sse = (sse+(d*d)) ;
2493
+ ;
2494
+ } ;
2495
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2496
+ int j = idx[c];
2497
+ double gm = (1.0-(lam[j]*sigma[((c*k)+c)]));
2498
+ gsum = (gsum+gm) ;
2499
+ lam[ j ] = ((gm+(2.0*lambda1))/((coef[j]*coef[j])+(2.0*lambda2))) ;
2500
+ ;
2501
+ ;
2502
+ } ;
2503
+ alpha = (((double(n)-gsum)+(2.0*alpha1))/(sse+(2.0*alpha2))) ;
2504
+ ;
2505
+ int nk = 0;
2506
+ double moved = 0.0;
2507
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2508
+ if( lam[j] < thresh ) {
2509
+ keep[ j ] = 1 ;
2510
+ nk = (nk+1) ;
2511
+ } else {
2512
+ keep[ j ] = 0 ;
2513
+ coef[ j ] = 0.0 ;
2514
+ } ;
2515
+ double dv = (old[j]-coef[j]);
2516
+ moved = (moved+( ( dv < 0.0 ) ? ((0.0-dv)) : (dv) )) ;
2517
+ ;
2518
+ } ;
2519
+ if( (it > 0 && moved < tol) ) {
2520
+ done = 1 ;
2521
+ } else {
2522
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2523
+ old[ j ] = coef[j] ;
2524
+ } ;
2525
+ if( nk == 0 ) {
2526
+ done = 1 ;
2527
+ } else {
2528
+ 0 ;
2529
+ } ;
2530
+ } ;
2531
+ ;
2532
+ it = (it+1) ;
2533
+ } ;
2534
+ k = 0 ;
2535
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2536
+ if( keep[j] == 1 ) {
2537
+ idx[ k ] = j ;
2538
+ k = (k+1) ;
2539
+ } else {
2540
+ 0 ;
2541
+ } ;
2542
+ } ;
2543
+ if( k > 0 ) {
2544
+ if( hoist == 1 ) {
2545
+ for( int r = 0 ; !(r == k) ; r = (r+1) ) {
2546
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2547
+ gk[ ((r*k)+c) ] = g[((idx[r]*p)+idx[c])] ;
2548
+ } ;
2549
+ } ;
2550
+ } else {
2551
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2552
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2553
+ xk[ ((i*k)+c) ] = x[((i*p)+idx[c])] ;
2554
+ } ;
2555
+ } ;
2556
+ for( int k2656 = 0 ; !(k2656 == k) ; k2656 = (k2656+1) ) {
2557
+ for( int k2657 = k2656 ; !(k2657 == k) ; k2657 = (k2657+1) ) {
2558
+ gk[ ((k2656*k)+k2657) ] = ([&]() -> double { int i2659 = 0; double r2660 = 0.0; while (!(i2659 == n)) {
2559
+ int i2659_next17438 = (i2659+1);
2560
+ double r2660_next17439 = (r2660+(xk[((i2659*k)+k2656)]*xk[((i2659*k)+k2657)]));
2561
+ i2659 = i2659_next17438;
2562
+ r2660 = r2660_next17439;
2563
+ } return r2660; })() ;
2564
+ gk[ ((k2657*k)+k2656) ] = gk[((k2656*k)+k2657)] ;
2565
+ } ;
2566
+ } ;
2567
+ } ;
2568
+ ard_sigma_coef(xy,idx,lam,coef,sigma,a,v,ev,e,gk,alpha,k) ;
2569
+ } else {
2570
+ 0 ;
2571
+ } ;
2572
+ out[ 0 ] = alpha ;
2573
+ out[ 1 ] = double(k) ;
2574
+ return it ;
2575
+ }
2576
+
2577
+
2578
+ inline int
2579
+ 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 )
2580
+ { std::vector<double> mx(p,0.0);
2581
+ std::vector<double> sx(p,0.0);
2582
+ std::vector<double> yc((n*q),0.0);
2583
+ std::vector<double> yn(q,0.0);
2584
+ double dof = double((n-( ( center == 1 ) ? (2) : (1) )));
2585
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2586
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2587
+ double v = x[((i*p)+j)];
2588
+ mx[ j ] = (mx[j]+v) ;
2589
+ sx[ j ] = (sx[j]+(v*v)) ;
2590
+ ;
2591
+ } ;
2592
+ } ;
2593
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2594
+ mx[ j ] = (mx[j]/double(n)) ;
2595
+ } ;
2596
+ for( int t = 0 ; !(t == q) ; t = (t+1) ) {
2597
+ double m = 0.0;
2598
+ double s = 0.0;
2599
+ if( center == 1 ) {
2600
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2601
+ m = (m+y[((i*q)+t)]) ;
2602
+ } ;
2603
+ m = (m/double(n)) ;
2604
+ } else {
2605
+ 0 ;
2606
+ } ;
2607
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2608
+ double v = (y[((i*q)+t)]-m);
2609
+ yc[ ((i*q)+t) ] = v ;
2610
+ s = (s+(v*v)) ;
2611
+ ;
2612
+ } ;
2613
+ yn[ t ] = sqrt(s) ;
2614
+ ;
2615
+ } ;
2616
+ for( int i2665 = 0 ; !(i2665 == p) ; i2665 = (i2665+1) ) {
2617
+ for( int i2666 = 0 ; !(i2666 == q) ; i2666 = (i2666+1) ) {
2618
+ r[ ((i2665*q)+i2666) ] = 0.0 ;
2619
+ } ;
2620
+ } ;
2621
+ for( int k2663 = 0 ; !(k2663 == n) ; k2663 = (k2663+1) ) {
2622
+ for( int k2664 = 0 ; !(k2664 == p) ; k2664 = (k2664+1) ) {
2623
+ for( int k2667 = 0 ; !(k2667 == q) ; k2667 = (k2667+1) ) {
2624
+ r[ ((k2664*q)+k2667) ] = (r[((k2664*q)+k2667)]+(yc[((k2663*q)+k2667)]*x[((k2663*p)+k2664)])) ;
2625
+ } ;
2626
+ } ;
2627
+ } ;
2628
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2629
+ double xn = sqrt(( ( center == 1 ) ? ((sx[j]-(double(n)*(mx[j]*mx[j])))) : (sx[j]) ));
2630
+ for( int t = 0 ; !(t == q) ; t = (t+1) ) {
2631
+ double rr = ((r[((j*q)+t)]/xn)/yn[t]);
2632
+ r[ ((j*q)+t) ] = rr ;
2633
+ f[ ((j*q)+t) ] = (((rr*rr)/(1.0-(rr*rr)))*dof) ;
2634
+ ;
2635
+ } ;
2636
+ ;
2637
+ } ;
2638
+ return 0 ;
2639
+ }
2640
+
2641
+
2642
+ inline int
2643
+ f_classif( scm2cpp::cspan<double> x, scm2cpp::cspan<int> lab, scm2cpp::span<double> f, int n, int p, int k )
2644
+ { std::vector<double> oh((n*k),0.0);
2645
+ std::vector<double> cs((k*p),0.0);
2646
+ std::vector<double> cnt(k,0.0);
2647
+ std::vector<double> ss(p,0.0);
2648
+ std::vector<double> tot(p,0.0);
2649
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
2650
+ int c = lab[i];
2651
+ oh[ ((i*k)+c) ] = 1.0 ;
2652
+ cnt[ c ] = (cnt[c]+1.0) ;
2653
+ ;
2654
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2655
+ double v = x[((i*p)+j)];
2656
+ ss[ j ] = (ss[j]+(v*v)) ;
2657
+ ;
2658
+ } ;
2659
+ } ;
2660
+ for( int i2671 = 0 ; !(i2671 == k) ; i2671 = (i2671+1) ) {
2661
+ for( int i2672 = 0 ; !(i2672 == p) ; i2672 = (i2672+1) ) {
2662
+ cs[ ((i2671*p)+i2672) ] = 0.0 ;
2663
+ } ;
2664
+ } ;
2665
+ for( int k2669 = 0 ; !(k2669 == n) ; k2669 = (k2669+1) ) {
2666
+ for( int k2670 = 0 ; !(k2670 == k) ; k2670 = (k2670+1) ) {
2667
+ for( int k2673 = 0 ; !(k2673 == p) ; k2673 = (k2673+1) ) {
2668
+ cs[ ((k2670*p)+k2673) ] = (cs[((k2670*p)+k2673)]+(x[((k2669*p)+k2673)]*oh[((k2669*k)+k2670)])) ;
2669
+ } ;
2670
+ } ;
2671
+ } ;
2672
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2673
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2674
+ tot[ j ] = (tot[j]+cs[((c*p)+j)]) ;
2675
+ } ;
2676
+ } ;
2677
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2678
+ double sq = ((tot[j]*tot[j])/double(n));
2679
+ double ssbn = 0.0;
2680
+ for( int c = 0 ; !(c == k) ; c = (c+1) ) {
2681
+ ssbn = (ssbn+((cs[((c*p)+j)]*cs[((c*p)+j)])/cnt[c])) ;
2682
+ } ;
2683
+ ssbn = (ssbn-sq) ;
2684
+ double sswn = ((ss[j]-sq)-ssbn);
2685
+ f[ j ] = ((ssbn/double((k-1)))/(sswn/double((n-k)))) ;
2686
+ ;
2687
+ ;
2688
+ } ;
2689
+ return 0 ;
2690
+ }
2691
+
2692
+
2693
+ SCM2CPP_FN inline double
2694
+ min_pos( scm2cpp::cspan<double> v, int m )
2695
+ { double r = 1.7976931348623157e+308;
2696
+ for( int i = 0 ; !(i == m) ; i = (i+1) ) {
2697
+ double x = v[i];
2698
+ if( (x > 0.0 && x < r) ) {
2699
+ r = x ;
2700
+ } else {
2701
+ 0 ;
2702
+ } ;
2703
+ ;
2704
+ } ;
2705
+ return r ;
2706
+ }
2707
+
2708
+
2709
+ SCM2CPP_FN inline double
2710
+ round_even( double y )
2711
+ {
2712
+ double r = std::floor(y);
2713
+ double d = (y-r);
2714
+ if( d > 0.5 ) {
2715
+ return (r+1.0) ;
2716
+ }
2717
+ else {
2718
+ if( d < 0.5 ) {
2719
+ return r ;
2720
+ }
2721
+ else {
2722
+ if( (2.0*std::floor((0.5*r))) == r ) {
2723
+ return r ;
2724
+ }
2725
+ else {
2726
+ return (r+1.0) ;
2727
+ }
2728
+ }
2729
+ }
2730
+ }
2731
+
2732
+
2733
+ SCM2CPP_FN inline int
2734
+ cholesky_delete( scm2cpp::span<double> l, int go, int n, int k )
2735
+ { for( int i = go ; !(i >= (n-1)) ; i = (i+1) ) {
2736
+ for( int j = 0 ; !(j == (i+2)) ; j = (j+1) ) {
2737
+ l[ ((i*k)+j) ] = l[(((i+1)*k)+j)] ;
2738
+ } ;
2739
+ } ;
2740
+ for( int i = go ; !(i >= (n-1)) ; i = (i+1) ) {
2741
+ double a = l[((i*k)+i)];
2742
+ double b = l[((i*k)+(i+1))];
2743
+ double aa = ( ( a < 0.0 ) ? ((0.0-a)) : (a) );
2744
+ double ab = ( ( b < 0.0 ) ? ((0.0-b)) : (b) );
2745
+ double roe = ( ( aa > ab ) ? (a) : (b) );
2746
+ double scale = (aa+ab);
2747
+ double r = ( ( scale == 0.0 ) ? (0.0) : ((( ( roe < 0.0 ) ? (-1.0) : (1.0) )*(scale*sqrt((((a/scale)*(a/scale))+((b/scale)*(b/scale))))))) );
2748
+ double c = ( ( scale == 0.0 ) ? (1.0) : ((a/r)) );
2749
+ double s = ( ( scale == 0.0 ) ? (0.0) : ((b/r)) );
2750
+ double cc = ( ( r < 0.0 ) ? ((0.0-c)) : (c) );
2751
+ double ss = ( ( r < 0.0 ) ? ((0.0-s)) : (s) );
2752
+ l[ ((i*k)+i) ] = ( ( r < 0.0 ) ? ((0.0-r)) : (r) ) ;
2753
+ l[ ((i*k)+(i+1)) ] = 0.0 ;
2754
+ for( int t = (i+1) ; !(t >= n) ; t = (t+1) ) {
2755
+ double x = l[((t*k)+i)];
2756
+ double y = l[((t*k)+(i+1))];
2757
+ l[ ((t*k)+i) ] = ((cc*x)+(ss*y)) ;
2758
+ l[ ((t*k)+(i+1)) ] = ((cc*y)-(ss*x)) ;
2759
+ ;
2760
+ } ;
2761
+ ;
2762
+ ;
2763
+ ;
2764
+ ;
2765
+ ;
2766
+ ;
2767
+ } ;
2768
+ return 0 ;
2769
+ }
2770
+
2771
+
2772
+ SCM2CPP_FN inline int
2773
+ swap_rc( scm2cpp::span<double> g, int a, int b, int p )
2774
+ { for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2775
+ double rv = g[((a*p)+j)];
2776
+ g[ ((a*p)+j) ] = g[((b*p)+j)] ;
2777
+ g[ ((b*p)+j) ] = rv ;
2778
+ ;
2779
+ } ;
2780
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2781
+ double cv = g[((j*p)+a)];
2782
+ g[ ((j*p)+a) ] = g[((j*p)+b)] ;
2783
+ g[ ((j*p)+b) ] = cv ;
2784
+ ;
2785
+ } ;
2786
+ return 0 ;
2787
+ }
2788
+
2789
+
2790
+ inline int
2791
+ 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 )
2792
+ { std::vector<double> g0((p*p),0.0);
2793
+ std::vector<double> cov0(p,0.0);
2794
+ std::vector<double> cbuf(p,0.0);
2795
+ std::vector<int> index(p,0);
2796
+ std::vector<int> active(p,0);
2797
+ std::vector<double> sign(p,0.0);
2798
+ int kmax = ( ( maxiter < p ) ? (maxiter) : (p) );
2799
+ std::vector<double> prev(p,0.0);
2800
+ std::vector<double> dir(p,0.0);
2801
+ std::vector<double> ls(p,0.0);
2802
+ std::vector<double> zz(p,0.0);
2803
+ std::vector<double> ratio(p,0.0);
2804
+ std::vector<int> idx(p,0);
2805
+ std::vector<int> dropv(p,0);
2806
+ int cs = 0;
2807
+ int na = 0;
2808
+ int niter = 0;
2809
+ int drop = 0;
2810
+ int done = 0;
2811
+ double alpha = 0.0;
2812
+ double prevalpha = 0.0;
2813
+ double tiny32 = 1.1754943508222875e-38;
2814
+ double eqtol = 1.1920928955078125e-7;
2815
+ std::vector<double> l((kmax*kmax),0.0);
2816
+ for( int t = 0 ; !(t == (p*p)) ; t = (t+1) ) {
2817
+ g0[ t ] = g[t] ;
2818
+ } ;
2819
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2820
+ cov0[ j ] = cov[j] ;
2821
+ cbuf[ j ] = cov[j] ;
2822
+ index[ j ] = j ;
2823
+ coef[ j ] = 0.0 ;
2824
+ if( rec == 1 ) {
2825
+ path[ j ] = 0.0 ;
2826
+ } else {
2827
+ 0 ;
2828
+ } ;
2829
+ } ;
2830
+ for( ; !(done == 1) ; ) {
2831
+ int clen = (p-cs);
2832
+ int cidx = 0;
2833
+ double cval = 0.0;
2834
+ double cabs = 0.0;
2835
+ for( int t = 0 ; !(t == clen) ; t = (t+1) ) {
2836
+ double v = cbuf[(cs+t)];
2837
+ double av = ( ( v < 0.0 ) ? ((0.0-v)) : (v) );
2838
+ if( av > cabs ) {
2839
+ cabs = av ;
2840
+ cidx = t ;
2841
+ cval = v ;
2842
+ } else {
2843
+ 0 ;
2844
+ } ;
2845
+ ;
2846
+ ;
2847
+ } ;
2848
+ alpha = (cabs/(1.0*nsamples)) ;
2849
+ if( rec == 1 ) {
2850
+ alphas[ niter ] = alpha ;
2851
+ } else {
2852
+ 0 ;
2853
+ } ;
2854
+ if( alpha <= (alphamin+eqtol) ) {
2855
+ if( ( ( (alpha-alphamin) < 0.0 ) ? ((alphamin-alpha)) : ((alpha-alphamin)) ) > eqtol ) {
2856
+ if( niter > 0 ) {
2857
+ double ss = ((prevalpha-alphamin)/(prevalpha-alpha));
2858
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2859
+ coef[ j ] = (prev[j]+(ss*(coef[j]-prev[j]))) ;
2860
+ } ;
2861
+ ;
2862
+ } else {
2863
+ 0 ;
2864
+ } ;
2865
+ alpha = alphamin ;
2866
+ if( rec == 1 ) {
2867
+ alphas[ niter ] = alphamin ;
2868
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
2869
+ path[ ((niter*p)+j) ] = coef[j] ;
2870
+ } ;
2871
+ } else {
2872
+ 0 ;
2873
+ } ;
2874
+ } else {
2875
+ 0 ;
2876
+ } ;
2877
+ done = 1 ;
2878
+ } else {
2879
+ if( (niter >= maxiter || na >= p) ) {
2880
+ done = 1 ;
2881
+ } else {
2882
+ int degenerate = 0;
2883
+ if( drop == 0 ) {
2884
+ int m = na;
2885
+ int nn = (cidx+na);
2886
+ sign[ na ] = ( ( cval > 0.0 ) ? (1.0) : (( ( cval < 0.0 ) ? (-1.0) : (0.0) )) ) ;
2887
+ double tc = cbuf[(cs+cidx)];
2888
+ cbuf[ (cs+cidx) ] = cbuf[cs] ;
2889
+ cbuf[ cs ] = tc ;
2890
+ ;
2891
+ int ti = index[nn];
2892
+ index[ nn ] = index[m] ;
2893
+ index[ m ] = ti ;
2894
+ ;
2895
+ cs = (cs+1) ;
2896
+ swap_rc(g,m,nn,p) ;
2897
+ double c = g[((na*p)+na)];
2898
+ double v = 0.0;
2899
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
2900
+ double t = g[((na*p)+i)];
2901
+ for( int s = 0 ; !(s == i) ; s = (s+1) ) {
2902
+ t = (t-(l[((i*kmax)+s)]*l[((na*kmax)+s)])) ;
2903
+ } ;
2904
+ double li = (t/l[((i*kmax)+i)]);
2905
+ l[ ((na*kmax)+i) ] = li ;
2906
+ v = (v+(li*li)) ;
2907
+ ;
2908
+ ;
2909
+ } ;
2910
+ double dd = sqrt(( ( (c-v) < 0.0 ) ? ((v-c)) : ((c-v)) ));
2911
+ double dg = ( ( dd > (1.0*eps) ) ? (dd) : ((1.0*eps)) );
2912
+ l[ ((na*kmax)+na) ] = dg ;
2913
+ if( dg < 1e-7 ) {
2914
+ cs = (cs-1) ;
2915
+ cbuf[ cs ] = 0.0 ;
2916
+ double tc = cbuf[(cs+cidx)];
2917
+ cbuf[ (cs+cidx) ] = cbuf[cs] ;
2918
+ cbuf[ cs ] = tc ;
2919
+ ;
2920
+ degenerate = 1 ;
2921
+ } else {
2922
+ active[ na ] = index[na] ;
2923
+ na = (na+1) ;
2924
+ } ;
2925
+ ;
2926
+ ;
2927
+ ;
2928
+ ;
2929
+ } else {
2930
+ false ;
2931
+ } ;
2932
+ if( degenerate == 0 ) {
2933
+ if( (method == 1 && niter > 0 && prevalpha < alpha) ) {
2934
+ done = 1 ;
2935
+ } else {
2936
+ double aa = 0.0;
2937
+ int clen2 = (p-cs);
2938
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
2939
+ double t = sign[i];
2940
+ for( int s = 0 ; !(s == i) ; s = (s+1) ) {
2941
+ t = (t-(l[((i*kmax)+s)]*zz[s])) ;
2942
+ } ;
2943
+ zz[ i ] = (t/l[((i*kmax)+i)]) ;
2944
+ ;
2945
+ } ;
2946
+ for( int ii = 0 ; !(ii == na) ; ii = (ii+1) ) {
2947
+ int i = ((na-1)-ii);
2948
+ double t = zz[i];
2949
+ for( int s = (i+1) ; !(s >= na) ; s = (s+1) ) {
2950
+ t = (t-(l[((s*kmax)+i)]*ls[s])) ;
2951
+ } ;
2952
+ ls[ i ] = (t/l[((i*kmax)+i)]) ;
2953
+ ;
2954
+ ;
2955
+ } ;
2956
+ if( (na == 1 && ls[0] == 0.0) ) {
2957
+ ls[ 0 ] = 1.0 ;
2958
+ aa = 1.0 ;
2959
+ } else {
2960
+ double sm = 0.0;
2961
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
2962
+ sm = (sm+(ls[i]*sign[i])) ;
2963
+ } ;
2964
+ aa = (1.0/sqrt(sm)) ;
2965
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
2966
+ ls[ i ] = (aa*ls[i]) ;
2967
+ } ;
2968
+ ;
2969
+ } ;
2970
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
2971
+ double acc = 0.0;
2972
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
2973
+ acc = (acc+(g[((i*p)+(na+t))]*ls[i])) ;
2974
+ } ;
2975
+ dir[ t ] = (round_even(double((acc*1e+15)))/1e+15) ;
2976
+ ;
2977
+ } ;
2978
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
2979
+ ratio[ t ] = ((cabs-cbuf[(cs+t)])/((aa-dir[t])+tiny32)) ;
2980
+ } ;
2981
+ double gfirst = min_pos(ratio,clen2);
2982
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
2983
+ ratio[ t ] = ((cabs+cbuf[(cs+t)])/((aa+dir[t])+tiny32)) ;
2984
+ } ;
2985
+ double gsecond = min_pos(ratio,clen2);
2986
+ double gam = ( ( ( ( gfirst < gsecond ) ? (gfirst) : (gsecond) ) < (cabs/aa) ) ? (( ( gfirst < gsecond ) ? (gfirst) : (gsecond) )) : ((cabs/aa)) );
2987
+ int nidx = 0;
2988
+ drop = 0 ;
2989
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
2990
+ zz[ i ] = ((0.0-coef[active[i]])/(ls[i]+tiny32)) ;
2991
+ } ;
2992
+ double zpos = min_pos(zz,na);
2993
+ if( zpos < gam ) {
2994
+ for( int ii = 0 ; !(ii == na) ; ii = (ii+1) ) {
2995
+ int i = ((na-1)-ii);
2996
+ if( zz[i] == zpos ) {
2997
+ idx[ nidx ] = i ;
2998
+ nidx = (nidx+1) ;
2999
+ } else {
3000
+ 0 ;
3001
+ } ;
3002
+ ;
3003
+ } ;
3004
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
3005
+ int i = idx[r];
3006
+ sign[ i ] = (0.0-sign[i]) ;
3007
+ ;
3008
+ } ;
3009
+ if( method == 1 ) {
3010
+ gam = zpos ;
3011
+ } else {
3012
+ 0 ;
3013
+ } ;
3014
+ drop = 1 ;
3015
+ } else {
3016
+ 0 ;
3017
+ } ;
3018
+ ;
3019
+ niter = (niter+1) ;
3020
+ prevalpha = alpha ;
3021
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3022
+ prev[ j ] = coef[j] ;
3023
+ coef[ j ] = 0.0 ;
3024
+ } ;
3025
+ for( int i = 0 ; !(i == na) ; i = (i+1) ) {
3026
+ int a = active[i];
3027
+ coef[ a ] = (prev[a]+(gam*ls[i])) ;
3028
+ ;
3029
+ } ;
3030
+ if( rec == 1 ) {
3031
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3032
+ path[ ((niter*p)+j) ] = coef[j] ;
3033
+ } ;
3034
+ } else {
3035
+ 0 ;
3036
+ } ;
3037
+ for( int t = 0 ; !(t == clen2) ; t = (t+1) ) {
3038
+ cbuf[ (cs+t) ] = (cbuf[(cs+t)]-(gam*dir[t])) ;
3039
+ } ;
3040
+ if( (drop == 1 && method == 1) ) {
3041
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
3042
+ cholesky_delete(l,idx[r],na,kmax) ;
3043
+ } ;
3044
+ na = (na-1) ;
3045
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
3046
+ int ii = idx[r];
3047
+ int dropped = active[ii];
3048
+ for( int i = ii ; !(i >= na) ; i = (i+1) ) {
3049
+ active[ i ] = active[(i+1)] ;
3050
+ } ;
3051
+ dropv[ r ] = dropped ;
3052
+ ;
3053
+ ;
3054
+ } ;
3055
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
3056
+ int ii = idx[r];
3057
+ for( int i = ii ; !(i >= na) ; i = (i+1) ) {
3058
+ int ti = index[i];
3059
+ index[ i ] = index[(i+1)] ;
3060
+ index[ (i+1) ] = ti ;
3061
+ ;
3062
+ swap_rc(g,i,int((i+1)),p) ;
3063
+ } ;
3064
+ ;
3065
+ } ;
3066
+ for( int rr = 0 ; !(rr == nidx) ; rr = (rr+1) ) {
3067
+ int r = ((nidx-1)-rr);
3068
+ int d = dropv[r];
3069
+ double t = cov0[d];
3070
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3071
+ t = (t-(g0[((d*p)+j)]*coef[j])) ;
3072
+ } ;
3073
+ cs = (cs-1) ;
3074
+ cbuf[ cs ] = t ;
3075
+ ;
3076
+ ;
3077
+ ;
3078
+ } ;
3079
+ for( int r = 0 ; !(r == nidx) ; r = (r+1) ) {
3080
+ int ii = idx[r];
3081
+ for( int i = ii ; !(i >= (p-1)) ; i = (i+1) ) {
3082
+ sign[ i ] = sign[(i+1)] ;
3083
+ } ;
3084
+ sign[ (p-1) ] = 0.0 ;
3085
+ ;
3086
+ } ;
3087
+ } else {
3088
+ 0 ;
3089
+ } ;
3090
+ ;
3091
+ ;
3092
+ ;
3093
+ ;
3094
+ } ;
3095
+ } else {
3096
+ 0 ;
3097
+ } ;
3098
+ ;
3099
+ } ;
3100
+ } ;
3101
+ ;
3102
+ } ;
3103
+ ;
3104
+ return niter ;
3105
+ }
3106
+
3107
+
3108
+ SCM2CPP_FN inline int
3109
+ rfe_chol( scm2cpp::cspan<double> g, scm2cpp::cspan<int> idx, scm2cpp::span<double> l, double alpha, int k, int p )
3110
+ { for( int j = 0 ; !(j == k) ; j = (j+1) ) {
3111
+ double s = (g[((idx[j]*p)+idx[j])]+alpha);
3112
+ for( int m = 0 ; !(m == j) ; m = (m+1) ) {
3113
+ s = (s-(l[((j*p)+m)]*l[((j*p)+m)])) ;
3114
+ } ;
3115
+ l[ ((j*p)+j) ] = sqrt(s) ;
3116
+ for( int i = (j+1) ; !(i >= k) ; i = (i+1) ) {
3117
+ double t = g[((idx[i]*p)+idx[j])];
3118
+ for( int m = 0 ; !(m == j) ; m = (m+1) ) {
3119
+ t = (t-(l[((i*p)+m)]*l[((j*p)+m)])) ;
3120
+ } ;
3121
+ l[ ((i*p)+j) ] = (t/l[((j*p)+j)]) ;
3122
+ ;
3123
+ } ;
3124
+ ;
3125
+ } ;
3126
+ return 0 ;
3127
+ }
3128
+
3129
+
3130
+ SCM2CPP_FN inline int
3131
+ rfe_solve( scm2cpp::cspan<double> c, scm2cpp::cspan<int> idx, scm2cpp::span<double> w, scm2cpp::cspan<double> l, int k, int p )
3132
+ { for( int i = 0 ; !(i == k) ; i = (i+1) ) {
3133
+ double t = c[idx[i]];
3134
+ for( int m = 0 ; !(m == i) ; m = (m+1) ) {
3135
+ t = (t-(l[((i*p)+m)]*w[m])) ;
3136
+ } ;
3137
+ w[ i ] = (t/l[((i*p)+i)]) ;
3138
+ ;
3139
+ } ;
3140
+ for( int ii = 0 ; !(ii == k) ; ii = (ii+1) ) {
3141
+ int i = ((k-1)-ii);
3142
+ double t = w[i];
3143
+ for( int m = (i+1) ; !(m >= k) ; m = (m+1) ) {
3144
+ t = (t-(l[((m*p)+i)]*w[m])) ;
3145
+ } ;
3146
+ w[ i ] = (t/l[((i*p)+i)]) ;
3147
+ ;
3148
+ ;
3149
+ } ;
3150
+ return 0 ;
3151
+ }
3152
+
3153
+
3154
+ inline int
3155
+ 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 )
3156
+ { std::vector<double> xc((n*p),0.0);
3157
+ std::vector<double> yc(n,0.0);
3158
+ std::vector<double> mx(p,0.0);
3159
+ std::vector<double> g((p*p),0.0);
3160
+ std::vector<double> c(p,0.0);
3161
+ std::vector<double> l((p*p),0.0);
3162
+ std::vector<double> w(p,0.0);
3163
+ std::vector<int> idx(p,0);
3164
+ std::vector<int> ord(p,0);
3165
+ std::vector<int> gone(p,0);
3166
+ double ym = 0.0;
3167
+ int rounds = 0;
3168
+ int k = p;
3169
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
3170
+ ym = (ym+y[i]) ;
3171
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3172
+ mx[ j ] = (mx[j]+x[((i*p)+j)]) ;
3173
+ } ;
3174
+ } ;
3175
+ ym = (ym/double(n)) ;
3176
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3177
+ mx[ j ] = (mx[j]/double(n)) ;
3178
+ } ;
3179
+ for( int i = 0 ; !(i == n) ; i = (i+1) ) {
3180
+ yc[ i ] = (y[i]-ym) ;
3181
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3182
+ xc[ ((i*p)+j) ] = (x[((i*p)+j)]-mx[j]) ;
3183
+ } ;
3184
+ } ;
3185
+ for( int k2682 = 0 ; !(k2682 == p) ; k2682 = (k2682+1) ) {
3186
+ for( int k2683 = k2682 ; !(k2683 == p) ; k2683 = (k2683+1) ) {
3187
+ g[ ((k2682*p)+k2683) ] = ([&]() -> double { int i2685 = 0; double r2686 = 0.0; while (!(i2685 == n)) {
3188
+ int i2685_next17444 = (i2685+1);
3189
+ double r2686_next17445 = (r2686+(xc[((i2685*p)+k2682)]*xc[((i2685*p)+k2683)]));
3190
+ i2685 = i2685_next17444;
3191
+ r2686 = r2686_next17445;
3192
+ } return r2686; })() ;
3193
+ g[ ((k2683*p)+k2682) ] = g[((k2682*p)+k2683)] ;
3194
+ } ;
3195
+ } ;
3196
+ for( int i2690 = 0 ; !(i2690 == p) ; i2690 = (i2690+1) ) {
3197
+ c[ i2690 ] = 0.0 ;
3198
+ } ;
3199
+ for( int k2688 = 0 ; !(k2688 == n) ; k2688 = (k2688+1) ) {
3200
+ for( int i2691 = 0 ; !(i2691 == p) ; i2691 = (i2691+1) ) {
3201
+ c[ i2691 ] = (c[i2691]+(xc[((k2688*p)+i2691)]*yc[k2688])) ;
3202
+ } ;
3203
+ } ;
3204
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3205
+ support[ j ] = 1 ;
3206
+ ranking[ j ] = 1 ;
3207
+ idx[ j ] = j ;
3208
+ } ;
3209
+ rfe_chol(g,idx,l,alpha,p,p) ;
3210
+ for( ; !(k <= nsel) ; ) {
3211
+ rfe_solve(c,idx,w,l,k,p) ;
3212
+ for( int i = 0 ; !(i == k) ; i = (i+1) ) {
3213
+ double key = (w[i]*w[i]);
3214
+ int jj = (i-1);
3215
+ for( ; !((jj < 0 || (w[ord[jj]]*w[ord[jj]]) <= key)) ; ) {
3216
+ ord[ (jj+1) ] = ord[jj] ;
3217
+ jj = (jj-1) ;
3218
+ } ;
3219
+ ord[ (jj+1) ] = i ;
3220
+ ;
3221
+ } ;
3222
+ int thr = ( ( step < (k-nsel) ) ? (step) : ((k-nsel)) );
3223
+ for( int r = 0 ; !(r == thr) ; r = (r+1) ) {
3224
+ support[ idx[ord[r]] ] = 0 ;
3225
+ } ;
3226
+ for( int t = 0 ; !(t == k) ; t = (t+1) ) {
3227
+ gone[ t ] = 0 ;
3228
+ } ;
3229
+ for( int r = 0 ; !(r == thr) ; r = (r+1) ) {
3230
+ gone[ ord[r] ] = 1 ;
3231
+ } ;
3232
+ int cur = k;
3233
+ for( int tt = 0 ; !(tt == k) ; tt = (tt+1) ) {
3234
+ int pos = ((k-1)-tt);
3235
+ if( gone[pos] == 1 ) {
3236
+ cholesky_delete(l,pos,cur,p) ;
3237
+ for( int u = pos ; !(u >= (cur-1)) ; u = (u+1) ) {
3238
+ idx[ u ] = idx[(u+1)] ;
3239
+ } ;
3240
+ cur = (cur-1) ;
3241
+ } else {
3242
+ 0 ;
3243
+ } ;
3244
+ ;
3245
+ } ;
3246
+ ;
3247
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3248
+ if( support[j] == 0 ) {
3249
+ ranking[ j ] = (ranking[j]+1) ;
3250
+ } else {
3251
+ 0 ;
3252
+ } ;
3253
+ } ;
3254
+ k = (k-thr) ;
3255
+ rounds = (rounds+1) ;
3256
+ ;
3257
+ } ;
3258
+ for( int j = 0 ; !(j == p) ; j = (j+1) ) {
3259
+ coef[ j ] = 0.0 ;
3260
+ } ;
3261
+ rfe_solve(c,idx,w,l,k,p) ;
3262
+ for( int i = 0 ; !(i == k) ; i = (i+1) ) {
3263
+ coef[ idx[i] ] = w[i] ;
3264
+ } ;
3265
+ return rounds ;
3266
+ }
3267
+
3268
+
3269
+ SCM2CPP_FN inline int
3270
+ gram_xx( scm2cpp::cspan<double> x, scm2cpp::span<double> g, int n, int p )
3271
+ { for( int k2693 = 0 ; !(k2693 == p) ; k2693 = (k2693+1) ) {
3272
+ for( int k2694 = k2693 ; !(k2694 == p) ; k2694 = (k2694+1) ) {
3273
+ g[ ((k2693*p)+k2694) ] = ([&]() -> double { int i2696 = 0; double r2697 = 0.0; while (!(i2696 == n)) {
3274
+ int i2696_next17446 = (i2696+1);
3275
+ double r2697_next17447 = (r2697+(x[((i2696*p)+k2693)]*x[((i2696*p)+k2694)]));
3276
+ i2696 = i2696_next17446;
3277
+ r2697 = r2697_next17447;
3278
+ } return r2697; })() ;
3279
+ g[ ((k2694*p)+k2693) ] = g[((k2693*p)+k2694)] ;
3280
+ } ;
3281
+ } ;
3282
+ return 0 ;
3283
+ }
3284
+
3285
+
3286
+ SCM2CPP_FN inline int
3287
+ gram_xy( scm2cpp::cspan<double> x, scm2cpp::cspan<double> y, scm2cpp::span<double> c, int n, int p, int q )
3288
+ { for( int i2702 = 0 ; !(i2702 == p) ; i2702 = (i2702+1) ) {
3289
+ for( int i2703 = 0 ; !(i2703 == q) ; i2703 = (i2703+1) ) {
3290
+ c[ ((i2702*q)+i2703) ] = 0.0 ;
3291
+ } ;
3292
+ } ;
3293
+ for( int k2700 = 0 ; !(k2700 == n) ; k2700 = (k2700+1) ) {
3294
+ for( int k2701 = 0 ; !(k2701 == p) ; k2701 = (k2701+1) ) {
3295
+ for( int k2704 = 0 ; !(k2704 == q) ; k2704 = (k2704+1) ) {
3296
+ c[ ((k2701*q)+k2704) ] = (c[((k2701*q)+k2704)]+(y[((k2700*q)+k2704)]*x[((k2700*p)+k2701)])) ;
3297
+ } ;
3298
+ } ;
3299
+ } ;
3300
+ return 0 ;
3301
+ }
3302
+ #endif // GRAMOPS_HPP