/*************************************************************************
Matrix inverse
*************************************************************************/
static bool rmatrixinvmat(ap::real_2d_array& a, int n)
{
bool result;
ap::integer_1d_array pivots;
rmatrixlu(a, n, n, pivots);
result = rmatrixinvmatlu(a, pivots, n);
return result;
}
/*************************************************************************
Calculation of the determinant of a general matrix
Input parameters:
A - matrix, array[0..N-1, 0..N-1]
N - size of matrix A.
Result: determinant of matrix A.
-- ALGLIB --
Copyright 2005 by Bochkanov Sergey
*************************************************************************/
double rmatrixdet(ap::real_2d_array a, int n)
{
double result;
ap::integer_1d_array pivots;
rmatrixlu(a, n, n, pivots);
result = rmatrixludet(a, pivots, n);
return result;
}
/*************************************************************************
Solving a system of linear equations.
The algorithm solves a system of linear equations by using the
LU decomposition. The algorithm solves systems with a square matrix only.
Input parameters:
A - system matrix.
Array whose indexes range within [0..N-1, 0..N-1].
B - right side of a system.
Array whose indexes range within [0..N-1].
N - size of matrix A.
Output parameters:
X - solution of a system.
Array whose index ranges within [0..N-1].
Result:
True, if the matrix is not singular.
False, if the matrix is singular. In this case, X doesn't contain a
solution.
-- ALGLIB --
Copyright 2005-2008 by Bochkanov Sergey
*************************************************************************/
bool rmatrixsolve(ap::real_2d_array a,
ap::real_1d_array b,
int n,
ap::real_1d_array& x)
{
bool result;
ap::integer_1d_array pivots;
int i;
rmatrixlu(a, n, n, pivots);
result = rmatrixlusolve(a, pivots, b, n, x);
return result;
}
/*************************************************************************
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));
}
}
static void testluproblem(const ap::real_2d_array& a,
int m,
int n,
double& diffpu,
double& luerr)
{
ap::real_2d_array t1;
ap::real_2d_array t2;
ap::real_2d_array t3;
ap::integer_1d_array it1;
ap::integer_1d_array it2;
int i;
int j;
int k;
double v;
double mx;
ap::real_2d_array a0;
ap::integer_1d_array p0;
mx = 0;
for(i = 1; i <= m; i++)
{
for(j = 1; j <= n; j++)
{
if( ap::fp_greater(fabs(a(i,j)),mx) )
{
mx = fabs(a(i,j));
}
}
}
if( ap::fp_eq(mx,0) )
{
mx = 1;
}
//
// Compare LU and unpacked LU
//
t1.setbounds(1, m, 1, n);
for(i = 1; i <= m; i++)
{
ap::vmove(&t1(i, 1), &a(i, 1), ap::vlen(1,n));
}
ludecomposition(t1, m, n, it1);
ludecompositionunpacked(a, m, n, t2, t3, it2);
for(i = 1; i <= m; i++)
{
for(j = 1; j <= ap::minint(m, n); j++)
{
if( i>j )
{
diffpu = ap::maxreal(diffpu, fabs(t1(i,j)-t2(i,j))/mx);
}
if( i==j )
{
diffpu = ap::maxreal(diffpu, fabs(1-t2(i,j))/mx);
}
if( i<j )
{
diffpu = ap::maxreal(diffpu, fabs(0-t2(i,j))/mx);
}
}
}
for(i = 1; i <= ap::minint(m, n); i++)
{
for(j = 1; j <= n; j++)
{
if( i>j )
{
diffpu = ap::maxreal(diffpu, fabs(0-t3(i,j))/mx);
}
if( i<=j )
{
diffpu = ap::maxreal(diffpu, fabs(t1(i,j)-t3(i,j))/mx);
}
}
}
for(i = 1; i <= ap::minint(m, n); i++)
{
diffpu = ap::maxreal(diffpu, fabs(double(it1(i)-it2(i))));
}
//
// Test unpacked LU
//
ludecompositionunpacked(a, m, n, t1, t2, it1);
t3.setbounds(1, m, 1, n);
k = ap::minint(m, n);
for(i = 1; i <= m; i++)
{
for(j = 1; j <= n; j++)
{
v = ap::vdotproduct(t1.getrow(i, 1, k), t2.getcolumn(j, 1, k));
t3(i,j) = v;
}
}
for(i = ap::minint(m, n); i >= 1; i--)
{
if( i!=it1(i) )
{
for(j = 1; j <= n; j++)
{
v = t3(i,j);
t3(i,j) = t3(it1(i),j);
t3(it1(i),j) = v;
}
}
}
for(i = 1; i <= m; i++)
{
for(j = 1; j <= n; j++)
{
luerr = ap::maxreal(luerr, fabs(a(i,j)-t3(i,j))/mx);
}
}
//
// Test 0-based LU
//
t1.setbounds(1, m, 1, n);
for(i = 1; i <= m; i++)
{
ap::vmove(&t1(i, 1), &a(i, 1), ap::vlen(1,n));
}
ludecomposition(t1, m, n, it1);
a0.setbounds(0, m-1, 0, n-1);
for(i = 0; i <= m-1; i++)
{
for(j = 0; j <= n-1; j++)
{
a0(i,j) = a(i+1,j+1);
}
}
rmatrixlu(a0, m, n, p0);
for(i = 0; i <= m-1; i++)
{
for(j = 0; j <= n-1; j++)
{
diffpu = ap::maxreal(diffpu, fabs(a0(i,j)-t1(i+1,j+1)));
}
}
for(i = 0; i <= ap::minint(m-1, n-1); i++)
{
diffpu = ap::maxreal(diffpu, fabs(double(p0(i)+1-it1(i+1))));
}
}
