/************************************************************************* 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; } }
/************************************************************************* Singular value decomposition of a rectangular matrix. The algorithm calculates the singular value decomposition of a matrix of size MxN: A = U * S * V^T The algorithm finds the singular values and, optionally, matrices U and V^T. The algorithm can find both first min(M,N) columns of matrix U and rows of matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM and NxN respectively). Take into account that the subroutine does not return matrix V but V^T. Input parameters: A - matrix to be decomposed. Array whose indexes range within [0..M-1, 0..N-1]. M - number of rows in matrix A. N - number of columns in matrix A. UNeeded - 0, 1 or 2. See the description of the parameter U. VTNeeded - 0, 1 or 2. See the description of the parameter VT. AdditionalMemory - If the parameter: * equals 0, the algorithm doesn’t use additional memory (lower requirements, lower performance). * equals 1, the algorithm uses additional memory of size min(M,N)*min(M,N) of real numbers. It often speeds up the algorithm. * equals 2, the algorithm uses additional memory of size M*min(M,N) of real numbers. It allows to get a maximum performance. The recommended value of the parameter is 2. Output parameters: W - contains singular values in descending order. U - if UNeeded=0, U isn't changed, the left singular vectors are not calculated. if Uneeded=1, U contains left singular vectors (first min(M,N) columns of matrix U). Array whose indexes range within [0..M-1, 0..Min(M,N)-1]. if UNeeded=2, U contains matrix U wholly. Array whose indexes range within [0..M-1, 0..M-1]. VT - if VTNeeded=0, VT isn’t changed, the right singular vectors are not calculated. if VTNeeded=1, VT contains right singular vectors (first min(M,N) rows of matrix V^T). Array whose indexes range within [0..min(M,N)-1, 0..N-1]. if VTNeeded=2, VT contains matrix V^T wholly. Array whose indexes range within [0..N-1, 0..N-1]. -- ALGLIB -- Copyright 2005 by Bochkanov Sergey *************************************************************************/ bool rmatrixsvd(ap::real_2d_array a, int m, int n, int uneeded, int vtneeded, int additionalmemory, ap::real_1d_array& w, ap::real_2d_array& u, ap::real_2d_array& vt) { bool result; ap::real_1d_array tauq; ap::real_1d_array taup; ap::real_1d_array tau; ap::real_1d_array e; ap::real_1d_array work; ap::real_2d_array t2; bool isupper; int minmn; int ncu; int nrvt; int nru; int ncvt; int i; int j; result = true; if( m==0||n==0 ) { return result; } ap::ap_error::make_assertion(uneeded>=0&&uneeded<=2, "SVDDecomposition: wrong parameters!"); ap::ap_error::make_assertion(vtneeded>=0&&vtneeded<=2, "SVDDecomposition: wrong parameters!"); ap::ap_error::make_assertion(additionalmemory>=0&&additionalmemory<=2, "SVDDecomposition: wrong parameters!"); // // initialize // minmn = ap::minint(m, n); w.setbounds(1, minmn); ncu = 0; nru = 0; if( uneeded==1 ) { nru = m; ncu = minmn; u.setbounds(0, nru-1, 0, ncu-1); } if( uneeded==2 ) { nru = m; ncu = m; u.setbounds(0, nru-1, 0, ncu-1); } nrvt = 0; ncvt = 0; if( vtneeded==1 ) { nrvt = minmn; ncvt = n; vt.setbounds(0, nrvt-1, 0, ncvt-1); } if( vtneeded==2 ) { nrvt = n; ncvt = n; vt.setbounds(0, nrvt-1, 0, ncvt-1); } // // M much larger than N // Use bidiagonal reduction with QR-decomposition // if( ap::fp_greater(m,1.6*n) ) { if( uneeded==0 ) { // // No left singular vectors to be computed // rmatrixqr(a, m, n, tau); for(i = 0; i <= n-1; i++) { for(j = 0; j <= i-1; j++) { a(i,j) = 0; } } rmatrixbd(a, n, n, tauq, taup); rmatrixbdunpackpt(a, n, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, n, n, isupper, w, e); result = rmatrixbdsvd(w, e, n, isupper, false, u, 0, a, 0, vt, ncvt); return result; } else { // // Left singular vectors (may be full matrix U) to be computed // rmatrixqr(a, m, n, tau); rmatrixqrunpackq(a, m, n, tau, ncu, u); for(i = 0; i <= n-1; i++) { for(j = 0; j <= i-1; j++) { a(i,j) = 0; } } rmatrixbd(a, n, n, tauq, taup); rmatrixbdunpackpt(a, n, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, n, n, isupper, w, e); if( additionalmemory<1 ) { // // No additional memory can be used // rmatrixbdmultiplybyq(a, n, n, tauq, u, m, n, true, false); result = rmatrixbdsvd(w, e, n, isupper, false, u, m, a, 0, vt, ncvt); } else { // // Large U. Transforming intermediate matrix T2 // work.setbounds(1, ap::maxint(m, n)); rmatrixbdunpackq(a, n, n, tauq, n, t2); copymatrix(u, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1); inplacetranspose(t2, 0, n-1, 0, n-1, work); result = rmatrixbdsvd(w, e, n, isupper, false, u, 0, t2, n, vt, ncvt); matrixmatrixmultiply(a, 0, m-1, 0, n-1, false, t2, 0, n-1, 0, n-1, true, 1.0, u, 0, m-1, 0, n-1, 0.0, work); } return result; } } // // N much larger than M // Use bidiagonal reduction with LQ-decomposition // if( ap::fp_greater(n,1.6*m) ) { if( vtneeded==0 ) { // // No right singular vectors to be computed // rmatrixlq(a, m, n, tau); for(i = 0; i <= m-1; i++) { for(j = i+1; j <= m-1; j++) { a(i,j) = 0; } } rmatrixbd(a, m, m, tauq, taup); rmatrixbdunpackq(a, m, m, tauq, ncu, u); rmatrixbdunpackdiagonals(a, m, m, isupper, w, e); work.setbounds(1, m); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, vt, 0); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); return result; } else { // // Right singular vectors (may be full matrix VT) to be computed // rmatrixlq(a, m, n, tau); rmatrixlqunpackq(a, m, n, tau, nrvt, vt); for(i = 0; i <= m-1; i++) { for(j = i+1; j <= m-1; j++) { a(i,j) = 0; } } rmatrixbd(a, m, m, tauq, taup); rmatrixbdunpackq(a, m, m, tauq, ncu, u); rmatrixbdunpackdiagonals(a, m, m, isupper, w, e); work.setbounds(1, ap::maxint(m, n)); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); if( additionalmemory<1 ) { // // No additional memory available // rmatrixbdmultiplybyp(a, m, m, taup, vt, m, n, false, true); result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, vt, n); } else { // // Large VT. Transforming intermediate matrix T2 // rmatrixbdunpackpt(a, m, m, taup, m, t2); result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, t2, m); copymatrix(vt, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1); matrixmatrixmultiply(t2, 0, m-1, 0, m-1, false, a, 0, m-1, 0, n-1, false, 1.0, vt, 0, m-1, 0, n-1, 0.0, work); } inplacetranspose(u, 0, nru-1, 0, ncu-1, work); return result; } } // // M<=N // We can use inplace transposition of U to get rid of columnwise operations // if( m<=n ) { rmatrixbd(a, m, n, tauq, taup); rmatrixbdunpackq(a, m, n, tauq, ncu, u); rmatrixbdunpackpt(a, m, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, m, n, isupper, w, e); work.setbounds(1, m); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); result = rmatrixbdsvd(w, e, minmn, isupper, false, a, 0, u, nru, vt, ncvt); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); return result; } // // Simple bidiagonal reduction // rmatrixbd(a, m, n, tauq, taup); rmatrixbdunpackq(a, m, n, tauq, ncu, u); rmatrixbdunpackpt(a, m, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, m, n, isupper, w, e); if( additionalmemory<2||uneeded==0 ) { // // We cant use additional memory or there is no need in such operations // result = rmatrixbdsvd(w, e, minmn, isupper, false, u, nru, a, 0, vt, ncvt); } else { // // We can use additional memory // t2.setbounds(0, minmn-1, 0, m-1); copyandtranspose(u, 0, m-1, 0, minmn-1, t2, 0, minmn-1, 0, m-1); result = rmatrixbdsvd(w, e, minmn, isupper, false, u, 0, t2, m, vt, ncvt); copyandtranspose(t2, 0, minmn-1, 0, m-1, u, 0, m-1, 0, minmn-1); } return result; }
/************************************************************************* 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 r; 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( ap::fp_greater(fabs(a(i,j)),mx) ) { mx = fabs(a(i,j)); } } } if( ap::fp_eq(mx,0) ) { mx = 1; } // // Test decompose-and-unpack error // makeacopy(a, m, n, b); rmatrixqr(b, m, n, taub); rmatrixqrunpackq(b, m, n, taub, m, q); rmatrixqrunpackr(b, m, n, r); for(i = 0; i <= m-1; i++) { for(j = 0; j <= n-1; j++) { v = ap::vdotproduct(q.getrow(i, 0, m-1), r.getcolumn(j, 0, m-1)); decomperrors = decomperrors||ap::fp_greater_eq(fabs(v-a(i,j)),threshold); } } for(i = 0; i <= m-1; i++) { for(j = 0; j <= ap::minint(i, n-1)-1; j++) { structerrors = structerrors||ap::fp_neq(r(i,j),0); } } for(i = 0; i <= m-1; i++) { for(j = 0; j <= m-1; j++) { v = ap::vdotproduct(&q(i, 0), &q(j, 0), ap::vlen(0,m-1)); if( i==j ) { structerrors = structerrors||ap::fp_greater_eq(fabs(v-1),threshold); } else { structerrors = structerrors||ap::fp_greater_eq(fabs(v),threshold); } } } // // Test for other errors // for(k = 1; k <= m-1; k++) { rmatrixqrunpackq(b, m, n, taub, k, q2); for(i = 0; i <= m-1; i++) { for(j = 0; j <= k-1; j++) { othererrors = othererrors||ap::fp_greater(fabs(q2(i,j)-q(i,j)),10*ap::machineepsilon); } } } }