/*************************************************************************
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);
}
}
}
}
/*************************************************************************
Weighted constained linear least squares fitting.
This is variation of LSFitLinearW(), which searchs for min|A*x=b| given
that K additional constaints C*x=bc are satisfied. It reduces original
task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW()
is called.
INPUT PARAMETERS:
Y - array[0..N-1] Function values in N points.
W - array[0..N-1] Weights corresponding to function values.
Each summand in square sum of approximation deviations
from given values is multiplied by the square of
corresponding weight.
FMatrix - a table of basis functions values, array[0..N-1, 0..M-1].
FMatrix[I,J] - value of J-th basis function in I-th point.
CMatrix - a table of constaints, array[0..K-1,0..M].
I-th row of CMatrix corresponds to I-th linear constraint:
CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M]
N - number of points used. N>=1.
M - number of basis functions, M>=1.
K - number of constraints, 0 <= K < M
K=0 corresponds to absence of constraints.
OUTPUT PARAMETERS:
Info - error code:
* -4 internal SVD decomposition subroutine failed (very
rare and for degenerate systems only)
* -3 either too many constraints (M or more),
degenerate constraints (some constraints are
repetead twice) or inconsistent constraints were
specified.
* -1 incorrect N/M/K were specified
* 1 task is solved
C - decomposition coefficients, array[0..M-1]
Rep - fitting report. Following fields are set:
* RMSError rms error on the (X,Y).
* AvgError average error on the (X,Y).
* AvgRelError average relative error on the non-zero Y
* MaxError maximum error
NON-WEIGHTED ERRORS ARE CALCULATED
IMPORTANT:
this subroitine doesn't calculate task's condition number for K<>0.
SEE ALSO
LSFitLinear
LSFitLinearC
LSFitLinearWC
-- ALGLIB --
Copyright 07.09.2009 by Bochkanov Sergey
*************************************************************************/
void lsfitlinearwc(ap::real_1d_array y,
const ap::real_1d_array& w,
const ap::real_2d_array& fmatrix,
ap::real_2d_array cmatrix,
int n,
int m,
int k,
int& info,
ap::real_1d_array& c,
lsfitreport& rep)
{
int i;
int j;
ap::real_1d_array tau;
ap::real_2d_array q;
ap::real_2d_array f2;
ap::real_1d_array tmp;
ap::real_1d_array c0;
double v;
if( n<1||m<1||k<0 )
{
info = -1;
return;
}
if( k>=m )
{
info = -3;
return;
}
//
// Solve
//
if( k==0 )
{
//
// no constraints
//
lsfitlinearinternal(y, w, fmatrix, n, m, info, c, rep);
}
else
{
//
// First, find general form solution of constraints system:
// * factorize C = L*Q
// * unpack Q
// * fill upper part of C with zeros (for RCond)
//
// We got C=C0+Q2'*y where Q2 is lower M-K rows of Q.
//
rmatrixlq(cmatrix, k, m, tau);
rmatrixlqunpackq(cmatrix, k, m, tau, m, q);
for(i = 0; i <= k-1; i++)
{
for(j = i+1; j <= m-1; j++)
{
cmatrix(i,j) = 0.0;
}
}
if( ap::fp_less(rmatrixlurcondinf(cmatrix, k),1000*ap::machineepsilon) )
{
info = -3;
return;
}
tmp.setlength(k);
for(i = 0; i <= k-1; i++)
{
if( i>0 )
{
v = ap::vdotproduct(&cmatrix(i, 0), 1, &tmp(0), 1, ap::vlen(0,i-1));
}
else
{
v = 0;
}
tmp(i) = (cmatrix(i,m)-v)/cmatrix(i,i);
}
c0.setlength(m);
for(i = 0; i <= m-1; i++)
{
c0(i) = 0;
}
for(i = 0; i <= k-1; i++)
{
v = tmp(i);
ap::vadd(&c0(0), 1, &q(i, 0), 1, ap::vlen(0,m-1), v);
}
//
// Second, prepare modified matrix F2 = F*Q2' and solve modified task
//
tmp.setlength(ap::maxint(n, m)+1);
f2.setlength(n, m-k);
matrixvectormultiply(fmatrix, 0, n-1, 0, m-1, false, c0, 0, m-1, -1.0, y, 0, n-1, 1.0);
matrixmatrixmultiply(fmatrix, 0, n-1, 0, m-1, false, q, k, m-1, 0, m-1, true, 1.0, f2, 0, n-1, 0, m-k-1, 0.0, tmp);
lsfitlinearinternal(y, w, f2, n, m-k, info, tmp, rep);
rep.taskrcond = -1;
if( info<=0 )
{
return;
}
//
// then, convert back to original answer: C = C0 + Q2'*Y0
//
c.setlength(m);
ap::vmove(&c(0), 1, &c0(0), 1, ap::vlen(0,m-1));
matrixvectormultiply(q, k, m-1, 0, m-1, true, tmp, 0, m-k-1, 1.0, c, 0, m-1, 1.0);
}
}
/*************************************************************************
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;
}
/*************************************************************************
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;
}
}