/*************************************************************************
Returns True for successful test, False - for failed test
*************************************************************************/
static bool testrmatrixrcond(int maxn, int passcount)
{
bool result;
ap::real_2d_array a;
ap::real_2d_array lua;
ap::integer_1d_array p;
int n;
int i;
int j;
int pass;
bool err50;
bool err90;
bool errspec;
bool errless;
double erc1;
double ercinf;
ap::real_1d_array q50;
ap::real_1d_array q90;
double v;
err50 = false;
err90 = false;
errless = false;
errspec = false;
q50.setbounds(0, 3);
q90.setbounds(0, 3);
for(n = 1; n <= maxn; n++)
{
//
// special test for zero matrix
//
rmatrixgenzero(a, n);
rmatrixmakeacopy(a, n, n, lua);
rmatrixlu(lua, n, n, p);
errspec = errspec||ap::fp_neq(rmatrixrcond1(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixrcondinf(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixlurcond1(lua, n),0);
errspec = errspec||ap::fp_neq(rmatrixlurcondinf(lua, n),0);
//
// general test
//
a.setbounds(0, n-1, 0, n-1);
for(i = 0; i <= 3; i++)
{
q50(i) = 0;
q90(i) = 0;
}
for(pass = 1; pass <= passcount; pass++)
{
rmatrixrndcond(n, exp(ap::randomreal()*log(double(1000))), a);
rmatrixmakeacopy(a, n, n, lua);
rmatrixlu(lua, n, n, p);
rmatrixrefrcond(a, n, erc1, ercinf);
//
// 1-norm, normal
//
v = 1/rmatrixrcond1(a, n);
if( ap::fp_greater_eq(v,threshold50*erc1) )
{
q50(0) = q50(0)+double(1)/double(passcount);
}
if( ap::fp_greater_eq(v,threshold90*erc1) )
{
q90(0) = q90(0)+double(1)/double(passcount);
}
errless = errless||ap::fp_greater(v,erc1*1.001);
//
// 1-norm, LU
//
v = 1/rmatrixlurcond1(lua, n);
if( ap::fp_greater_eq(v,threshold50*erc1) )
{
q50(1) = q50(1)+double(1)/double(passcount);
}
if( ap::fp_greater_eq(v,threshold90*erc1) )
{
q90(1) = q90(1)+double(1)/double(passcount);
}
errless = errless||ap::fp_greater(v,erc1*1.001);
//
// Inf-norm, normal
//
v = 1/rmatrixrcondinf(a, n);
if( ap::fp_greater_eq(v,threshold50*ercinf) )
{
q50(2) = q50(2)+double(1)/double(passcount);
}
if( ap::fp_greater_eq(v,threshold90*ercinf) )
{
q90(2) = q90(2)+double(1)/double(passcount);
}
errless = errless||ap::fp_greater(v,ercinf*1.001);
//
// Inf-norm, LU
//
v = 1/rmatrixlurcondinf(lua, n);
if( ap::fp_greater_eq(v,threshold50*ercinf) )
{
q50(3) = q50(3)+double(1)/double(passcount);
}
if( ap::fp_greater_eq(v,threshold90*ercinf) )
{
q90(3) = q90(3)+double(1)/double(passcount);
}
errless = errless||ap::fp_greater(v,ercinf*1.001);
}
for(i = 0; i <= 3; i++)
{
err50 = err50||ap::fp_less(q50(i),0.50);
err90 = err90||ap::fp_less(q90(i),0.90);
}
//
// degenerate matrix test
//
if( n>=3 )
{
a.setlength(n, n);
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= n-1; j++)
{
a(i,j) = 0.0;
}
}
a(0,0) = 1;
a(n-1,n-1) = 1;
errspec = errspec||ap::fp_neq(rmatrixrcond1(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixrcondinf(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixlurcond1(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixlurcondinf(a, n),0);
}
//
// near-degenerate matrix test
//
if( n>=2 )
{
a.setlength(n, n);
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= n-1; j++)
{
a(i,j) = 0.0;
}
}
for(i = 0; i <= n-1; i++)
{
a(i,i) = 1;
}
i = ap::randominteger(n);
a(i,i) = 0.1*ap::maxrealnumber;
errspec = errspec||ap::fp_neq(rmatrixrcond1(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixrcondinf(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixlurcond1(a, n),0);
errspec = errspec||ap::fp_neq(rmatrixlurcondinf(a, n),0);
}
}
//
// report
//
result = !(err50||err90||errless||errspec);
return result;
}
/*************************************************************************
Dense solver.
This subroutine solves a system A*X=B, where A is NxN non-denegerate
real matrix, X and B are NxM real matrices.
Additional features include:
* automatic detection of degenerate cases
* iterative improvement
INPUT PARAMETERS
A - array[0..N-1,0..N-1], system matrix
N - size of A
B - array[0..N-1,0..M-1], right part
M - size of right part
OUTPUT PARAMETERS
Info - return code:
* -3 if A is singular, or VERY close to singular.
X is filled by zeros in such cases.
* -1 if N<=0 or M<=0 was passed
* 1 if task is solved (matrix A may be near singular,
check R1/RInf parameters for condition numbers).
Rep - solver report, see below for more info
X - array[0..N-1,0..M-1], it contains:
* solution of A*X=B if A is non-singular (well-conditioned
or ill-conditioned, but not very close to singular)
* zeros, if A is singular or VERY close to singular
(in this case Info=-3).
SOLVER REPORT
Subroutine sets following fields of the Rep structure:
* R1 reciprocal of condition number: 1/cond(A), 1-norm.
* RInf reciprocal of condition number: 1/cond(A), inf-norm.
SEE ALSO:
DenseSolverR() - solves A*x = b, where x and b are Nx1 matrices.
-- ALGLIB --
Copyright 24.08.2009 by Bochkanov Sergey
*************************************************************************/
void rmatrixsolvem(const ap::real_2d_array& a,
int n,
const ap::real_2d_array& b,
int m,
int& info,
densesolverreport& rep,
ap::real_2d_array& x)
{
int i;
int j;
int k;
int rfs;
int nrfs;
ap::integer_1d_array p;
ap::real_1d_array xc;
ap::real_1d_array y;
ap::real_1d_array bc;
ap::real_1d_array xa;
ap::real_1d_array xb;
ap::real_1d_array tx;
ap::real_2d_array da;
double v;
double verr;
bool smallerr;
bool terminatenexttime;
//
// prepare: check inputs, allocate space...
//
if( n<=0||m<=0 )
{
info = -1;
return;
}
da.setlength(n, n);
x.setlength(n, m);
y.setlength(n);
xc.setlength(n);
bc.setlength(n);
tx.setlength(n+1);
xa.setlength(n+1);
xb.setlength(n+1);
//
// factorize matrix, test for exact/near singularity
//
for(i = 0; i <= n-1; i++)
{
ap::vmove(&da(i, 0), &a(i, 0), ap::vlen(0,n-1));
}
rmatrixlu(da, n, n, p);
rep.r1 = rmatrixlurcond1(da, n);
rep.rinf = rmatrixlurcondinf(da, n);
if( ap::fp_less(rep.r1,10*ap::machineepsilon)||ap::fp_less(rep.rinf,10*ap::machineepsilon) )
{
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= m-1; j++)
{
x(i,j) = 0;
}
}
rep.r1 = 0;
rep.rinf = 0;
info = -3;
return;
}
info = 1;
//
// solve
//
for(k = 0; k <= m-1; k++)
{
//
// First, non-iterative part of solution process:
// * pivots
// * L*y = b
// * U*x = y
//
ap::vmove(bc.getvector(0, n-1), b.getcolumn(k, 0, n-1));
for(i = 0; i <= n-1; i++)
{
if( p(i)!=i )
{
v = bc(i);
bc(i) = bc(p(i));
bc(p(i)) = v;
}
}
y(0) = bc(0);
for(i = 1; i <= n-1; i++)
{
v = ap::vdotproduct(&da(i, 0), &y(0), ap::vlen(0,i-1));
y(i) = bc(i)-v;
}
xc(n-1) = y(n-1)/da(n-1,n-1);
for(i = n-2; i >= 0; i--)
{
v = ap::vdotproduct(&da(i, i+1), &xc(i+1), ap::vlen(i+1,n-1));
xc(i) = (y(i)-v)/da(i,i);
}
//
// Iterative improvement of xc:
// * calculate r = bc-A*xc using extra-precise dot product
// * solve A*y = r
// * update x:=x+r
//
// This cycle is executed until one of two things happens:
// 1. maximum number of iterations reached
// 2. last iteration decreased error to the lower limit
//
nrfs = densesolverrfsmax(n, rep.r1, rep.rinf);
terminatenexttime = false;
for(rfs = 0; rfs <= nrfs-1; rfs++)
{
if( terminatenexttime )
{
break;
}
//
// generate right part
//
smallerr = true;
for(i = 0; i <= n-1; i++)
{
ap::vmove(&xa(0), &a(i, 0), ap::vlen(0,n-1));
xa(n) = -1;
ap::vmove(&xb(0), &xc(0), ap::vlen(0,n-1));
xb(n) = b(i,k);
xdot(xa, xb, n+1, tx, v, verr);
bc(i) = -v;
smallerr = smallerr&&ap::fp_less(fabs(v),4*verr);
}
if( smallerr )
{
terminatenexttime = true;
}
//
// solve
//
for(i = 0; i <= n-1; i++)
{
if( p(i)!=i )
{
v = bc(i);
bc(i) = bc(p(i));
bc(p(i)) = v;
}
}
y(0) = bc(0);
for(i = 1; i <= n-1; i++)
{
v = ap::vdotproduct(&da(i, 0), &y(0), ap::vlen(0,i-1));
y(i) = bc(i)-v;
}
tx(n-1) = y(n-1)/da(n-1,n-1);
for(i = n-2; i >= 0; i--)
{
v = ap::vdotproduct(&da(i, i+1), &tx(i+1), ap::vlen(i+1,n-1));
tx(i) = (y(i)-v)/da(i,i);
}
//
// update
//
ap::vadd(&xc(0), &tx(0), ap::vlen(0,n-1));
}
//
// Store xc
//
ap::vmove(x.getcolumn(k, 0, n-1), xc.getvector(0, n-1));
}
}
