/************************************************************************* Problem testing *************************************************************************/ static void testproblem(const ap::real_2d_array& a, int m, int n) { int i; int j; int k; double mx; ap::real_2d_array b; ap::real_1d_array taub; ap::real_2d_array q; ap::real_2d_array l; ap::real_2d_array q2; double v; // // MX - estimate of the matrix norm // mx = 0; for(i = 0; i <= m-1; i++) { for(j = 0; j <= n-1; j++) { if( fabs(a(i,j))>mx ) { mx = fabs(a(i,j)); } } } if( mx==0 ) { mx = 1; } // // Test decompose-and-unpack error // makeacopy(a, m, n, b); rmatrixlq(b, m, n, taub); rmatrixlqunpackq(b, m, n, taub, n, q); rmatrixlqunpackl(b, m, n, l); for(i = 0; i <= m-1; i++) { for(j = 0; j <= n-1; j++) { v = ap::vdotproduct(l.getrow(i, 0, n-1), q.getcolumn(j, 0, n-1)); decomperrors = decomperrors||fabs(v-a(i,j))>=threshold; } } for(i = 0; i <= m-1; i++) { for(j = ap::minint(i, n-1)+1; j <= n-1; j++) { structerrors = structerrors||l(i,j)!=0; } } for(i = 0; i <= n-1; i++) { for(j = 0; j <= n-1; j++) { v = ap::vdotproduct(&q(i, 0), &q(j, 0), ap::vlen(0,n-1)); if( i==j ) { structerrors = structerrors||fabs(v-1)>=threshold; } else { structerrors = structerrors||fabs(v)>=threshold; } } } // // Test for other errors // for(k = 1; k <= n-1; k++) { rmatrixlqunpackq(b, m, n, taub, k, q2); for(i = 0; i <= k-1; i++) { for(j = 0; j <= n-1; j++) { othererrors = othererrors||q2(i,j)!=q(i,j); } } } }
/************************************************************************* Internal fitting subroutine *************************************************************************/ static void lsfitlinearinternal(const ap::real_1d_array& y, const ap::real_1d_array& w, const ap::real_2d_array& fmatrix, int n, int m, int& info, ap::real_1d_array& c, lsfitreport& rep) { double threshold; ap::real_2d_array ft; ap::real_2d_array q; ap::real_2d_array l; ap::real_2d_array r; ap::real_1d_array b; ap::real_1d_array wmod; ap::real_1d_array tau; int i; int j; double v; ap::real_1d_array sv; ap::real_2d_array u; ap::real_2d_array vt; ap::real_1d_array tmp; ap::real_1d_array utb; ap::real_1d_array sutb; int relcnt; if( n<1||m<1 ) { info = -1; return; } info = 1; threshold = sqrt(ap::machineepsilon); // // Degenerate case, needs special handling // if( n<m ) { // // Create design matrix. // ft.setlength(n, m); b.setlength(n); wmod.setlength(n); for(j = 0; j <= n-1; j++) { v = w(j); ap::vmove(&ft(j, 0), 1, &fmatrix(j, 0), 1, ap::vlen(0,m-1), v); b(j) = w(j)*y(j); wmod(j) = 1; } // // LQ decomposition and reduction to M=N // c.setlength(m); for(i = 0; i <= m-1; i++) { c(i) = 0; } rep.taskrcond = 0; rmatrixlq(ft, n, m, tau); rmatrixlqunpackq(ft, n, m, tau, n, q); rmatrixlqunpackl(ft, n, m, l); lsfitlinearinternal(b, wmod, l, n, n, info, tmp, rep); if( info<=0 ) { return; } for(i = 0; i <= n-1; i++) { v = tmp(i); ap::vadd(&c(0), 1, &q(i, 0), 1, ap::vlen(0,m-1), v); } return; } // // N>=M. Generate design matrix and reduce to N=M using // QR decomposition. // ft.setlength(n, m); b.setlength(n); for(j = 0; j <= n-1; j++) { v = w(j); ap::vmove(&ft(j, 0), 1, &fmatrix(j, 0), 1, ap::vlen(0,m-1), v); b(j) = w(j)*y(j); } rmatrixqr(ft, n, m, tau); rmatrixqrunpackq(ft, n, m, tau, m, q); rmatrixqrunpackr(ft, n, m, r); tmp.setlength(m); for(i = 0; i <= m-1; i++) { tmp(i) = 0; } for(i = 0; i <= n-1; i++) { v = b(i); ap::vadd(&tmp(0), 1, &q(i, 0), 1, ap::vlen(0,m-1), v); } b.setlength(m); ap::vmove(&b(0), 1, &tmp(0), 1, ap::vlen(0,m-1)); // // R contains reduced MxM design upper triangular matrix, // B contains reduced Mx1 right part. // // Determine system condition number and decide // should we use triangular solver (faster) or // SVD-based solver (more stable). // // We can use LU-based RCond estimator for this task. // rep.taskrcond = rmatrixlurcondinf(r, m); if( ap::fp_greater(rep.taskrcond,threshold) ) { // // use QR-based solver // c.setlength(m); c(m-1) = b(m-1)/r(m-1,m-1); for(i = m-2; i >= 0; i--) { v = ap::vdotproduct(&r(i, i+1), 1, &c(i+1), 1, ap::vlen(i+1,m-1)); c(i) = (b(i)-v)/r(i,i); } } else { // // use SVD-based solver // if( !rmatrixsvd(r, m, m, 1, 1, 2, sv, u, vt) ) { info = -4; return; } utb.setlength(m); sutb.setlength(m); for(i = 0; i <= m-1; i++) { utb(i) = 0; } for(i = 0; i <= m-1; i++) { v = b(i); ap::vadd(&utb(0), 1, &u(i, 0), 1, ap::vlen(0,m-1), v); } if( ap::fp_greater(sv(0),0) ) { rep.taskrcond = sv(m-1)/sv(0); for(i = 0; i <= m-1; i++) { if( ap::fp_greater(sv(i),threshold*sv(0)) ) { sutb(i) = utb(i)/sv(i); } else { sutb(i) = 0; } } } else { rep.taskrcond = 0; for(i = 0; i <= m-1; i++) { sutb(i) = 0; } } c.setlength(m); for(i = 0; i <= m-1; i++) { c(i) = 0; } for(i = 0; i <= m-1; i++) { v = sutb(i); ap::vadd(&c(0), 1, &vt(i, 0), 1, ap::vlen(0,m-1), v); } } // // calculate errors // rep.rmserror = 0; rep.avgerror = 0; rep.avgrelerror = 0; rep.maxerror = 0; relcnt = 0; for(i = 0; i <= n-1; i++) { v = ap::vdotproduct(&fmatrix(i, 0), 1, &c(0), 1, ap::vlen(0,m-1)); rep.rmserror = rep.rmserror+ap::sqr(v-y(i)); rep.avgerror = rep.avgerror+fabs(v-y(i)); if( ap::fp_neq(y(i),0) ) { rep.avgrelerror = rep.avgrelerror+fabs(v-y(i))/fabs(y(i)); relcnt = relcnt+1; } rep.maxerror = ap::maxreal(rep.maxerror, fabs(v-y(i))); } rep.rmserror = sqrt(rep.rmserror/n); rep.avgerror = rep.avgerror/n; if( relcnt!=0 ) { rep.avgrelerror = rep.avgrelerror/relcnt; } }