Example #1
0
/*************************************************************************
Generate matrix with given condition number C (2-norm)
*************************************************************************/
static void rmatrixgenzero(ap::real_2d_array& a0, int n)
{
    int i;
    int j;

    a0.setlength(n, n);
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            a0(i,j) = 0;
        }
    }
}
Example #2
0
static void mheapresize(ap::real_2d_array& heap,
     int& heapsize,
     int newheapsize,
     int heapwidth)
{
    ap::real_2d_array tmp;
    int i;

    tmp.setlength(heapsize, heapwidth);
    for(i = 0; i <= heapsize-1; i++)
    {
        ap::vmove(&tmp(i, 0), &heap(i, 0), ap::vlen(0,heapwidth-1));
    }
    heap.setlength(newheapsize, heapwidth);
    for(i = 0; i <= heapsize-1; i++)
    {
        ap::vmove(&heap(i, 0), &tmp(i, 0), ap::vlen(0,heapwidth-1));
    }
    heapsize = newheapsize;
}
/*************************************************************************
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));
    }
}