bool in_out_variable(const ap::boolean_1d_array& in, const ap::real_2d_array& X, ap::real_2d_array& x, bool io)
{
	//////////////////////////////////////////////////////////////////
	// Section: Define variables
	int rows = in.gethighbound(0) + 1;
	bool flag;
	vector<int> stdVector;
	//////////////////////////////////////////////////////////////////
	// Section: Identify how many variables are in or out

	for (int i=0; i<rows; i++)
	{
		if (in(i)==io) 
			stdVector.push_back(i);
	}
	if (stdVector.size()>0)
	{
		// Routine to extract the in/out variables
		x.setbounds(0,X.gethighbound(1),0,static_cast<int>(stdVector.size())-1);
		for (size_t i=0; i<stdVector.size(); i++)
			ap::vmove(x.getcolumn(static_cast<int>(i),0,X.gethighbound(1)), X.getcolumn(stdVector[i],0,X.gethighbound(1)));
	
        flag=TRUE;
	}
	else
		flag=FALSE;

	return flag;
}
Esempio n. 2
0
void unpackqfromqr(const ap::real_2d_array& a,
     int m,
     int n,
     const ap::real_1d_array& tau,
     int qcolumns,
     ap::real_2d_array& q)
{
    int i;
    int j;
    int k;
    int minmn;
    ap::real_1d_array v;
    ap::real_1d_array work;
    int vm;

    ap::ap_error::make_assertion(qcolumns<=m, "UnpackQFromQR: QColumns>M!");
    if( m==0||n==0||qcolumns==0 )
    {
        return;
    }
    
    //
    // init
    //
    minmn = ap::minint(m, n);
    k = ap::minint(minmn, qcolumns);
    q.setbounds(1, m, 1, qcolumns);
    v.setbounds(1, m);
    work.setbounds(1, qcolumns);
    for(i = 1; i <= m; i++)
    {
        for(j = 1; j <= qcolumns; j++)
        {
            if( i==j )
            {
                q(i,j) = 1;
            }
            else
            {
                q(i,j) = 0;
            }
        }
    }
    
    //
    // unpack Q
    //
    for(i = k; i >= 1; i--)
    {
        
        //
        // Apply H(i)
        //
        vm = m-i+1;
        ap::vmove(v.getvector(1, vm), a.getcolumn(i, i, m));
        v(1) = 1;
        applyreflectionfromtheleft(q, tau(i), v, i, m, 1, qcolumns, work);
    }
}
Esempio n. 3
0
/*************************************************************************
LU-разложение матрицы общего вида размера M x N

Использует  LUDecomposition.   По  функциональности  отличается  тем,  что
выводит  матрицы  L  и  U не в компактной форме, а в виде отдельных матриц
общего вида, заполненных в соответствующих местах нулевыми элементами.

Подпрограмма приведена исключительно для демонстрации того, как
"распаковывается" результат работы подпрограммы LUDecomposition

  -- ALGLIB --
     Copyright 2005 by Bochkanov Sergey
*************************************************************************/
void ludecompositionunpacked(ap::real_2d_array a,
                             int m,
                             int n,
                             ap::real_2d_array& l,
                             ap::real_2d_array& u,
                             ap::integer_1d_array& pivots)
{
    int i;
    int j;
    int minmn;

    if( m==0||n==0 )
    {
        return;
    }
    minmn = ap::minint(m, n);
    l.setbounds(1, m, 1, minmn);
    u.setbounds(1, minmn, 1, n);
    ludecomposition(a, m, n, pivots);
    for(i = 1; i <= m; i++)
    {
        for(j = 1; j <= minmn; j++)
        {
            if( j>i )
            {
                l(i,j) = 0;
            }
            if( j==i )
            {
                l(i,j) = 1;
            }
            if( j<i )
            {
                l(i,j) = a(i,j);
            }
        }
    }
    for(i = 1; i <= minmn; i++)
    {
        for(j = 1; j <= n; j++)
        {
            if( j<i )
            {
                u(i,j) = 0;
            }
            if( j>=i )
            {
                u(i,j) = a(i,j);
            }
        }
    }
}
Esempio n. 4
0
void qrdecompositionunpacked(ap::real_2d_array a,
     int m,
     int n,
     ap::real_2d_array& q,
     ap::real_2d_array& r)
{
    int i;
    int k;
    ap::real_1d_array tau;
    ap::real_1d_array work;
    ap::real_1d_array v;

    k = ap::minint(m, n);
    if( n<=0 )
    {
        return;
    }
    work.setbounds(1, m);
    v.setbounds(1, m);
    q.setbounds(1, m, 1, m);
    r.setbounds(1, m, 1, n);
    
    //
    // QRDecomposition
    //
    qrdecomposition(a, m, n, tau);
    
    //
    // R
    //
    for(i = 1; i <= n; i++)
    {
        r(1,i) = 0;
    }
    for(i = 2; i <= m; i++)
    {
        ap::vmove(&r(i, 1), &r(1, 1), ap::vlen(1,n));
    }
    for(i = 1; i <= k; i++)
    {
        ap::vmove(&r(i, i), &a(i, i), ap::vlen(i,n));
    }
    
    //
    // Q
    //
    unpackqfromqr(a, m, n, tau, m, q);
}
Esempio n. 5
0
/*************************************************************************
Unpacking of matrix R from the QR decomposition of a matrix A

Input parameters:
    A       -   matrices Q and R in compact form.
                Output of RMatrixQR subroutine.
    M       -   number of rows in given matrix A. M>=0.
    N       -   number of columns in given matrix A. N>=0.

Output parameters:
    R       -   matrix R, array[0..M-1, 0..N-1].

  -- ALGLIB --
     Copyright 2005 by Bochkanov Sergey
*************************************************************************/
void rmatrixqrunpackr(const ap::real_2d_array& a,
     int m,
     int n,
     ap::real_2d_array& r)
{
    int i;
    int k;

    if( m<=0||n<=0 )
    {
        return;
    }
    k = ap::minint(m, n);
    r.setbounds(0, m-1, 0, n-1);
    for(i = 0; i <= n-1; i++)
    {
        r(0,i) = 0;
    }
    for(i = 1; i <= m-1; i++)
    {
        ap::vmove(&r(i, 0), &r(0, 0), ap::vlen(0,n-1));
    }
    for(i = 0; i <= k-1; i++)
    {
        ap::vmove(&r(i, i), &a(i, i), ap::vlen(i,n-1));
    }
}
Esempio n. 6
0
void qrdecomposition(ap::real_2d_array& a,
     int m,
     int n,
     ap::real_1d_array& tau)
{
    ap::real_1d_array work;
    ap::real_1d_array t;
    int i;
    int k;
    int mmip1;
    int minmn;
    double tmp;

    minmn = ap::minint(m, n);
    work.setbounds(1, n);
    t.setbounds(1, m);
    tau.setbounds(1, minmn);
    
    //
    // Test the input arguments
    //
    k = ap::minint(m, n);
    for(i = 1; i <= k; i++)
    {
        
        //
        // Generate elementary reflector H(i) to annihilate A(i+1:m,i)
        //
        mmip1 = m-i+1;
        ap::vmove(t.getvector(1, mmip1), a.getcolumn(i, i, m));
        generatereflection(t, mmip1, tmp);
        tau(i) = tmp;
        ap::vmove(a.getcolumn(i, i, m), t.getvector(1, mmip1));
        t(1) = 1;
        if( i<n )
        {
            
            //
            // Apply H(i) to A(i:m,i+1:n) from the left
            //
            applyreflectionfromtheleft(a, tau(i), t, i, m, i+1, n, work);
        }
    }
}
Esempio n. 7
0
/*************************************************************************
QR decomposition of a rectangular matrix of size MxN

Input parameters:
    A   -   matrix A whose indexes range within [0..M-1, 0..N-1].
    M   -   number of rows in matrix A.
    N   -   number of columns in matrix A.

Output parameters:
    A   -   matrices Q and R in compact form (see below).
    Tau -   array of scalar factors which are used to form
            matrix Q. Array whose index ranges within [0.. Min(M-1,N-1)].

Matrix A is represented as A = QR, where Q is an orthogonal matrix of size
MxM, R - upper triangular (or upper trapezoid) matrix of size M x N.

The elements of matrix R are located on and above the main diagonal of
matrix A. The elements which are located in Tau array and below the main
diagonal of matrix A are used to form matrix Q as follows:

Matrix Q is represented as a product of elementary reflections

Q = H(0)*H(2)*...*H(k-1),

where k = min(m,n), and each H(i) is in the form

H(i) = 1 - tau * v * (v^T)

where tau is a scalar stored in Tau[I]; v - real vector,
so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in A(i+1:m-1,i).

  -- LAPACK routine (version 3.0) --
     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
     Courant Institute, Argonne National Lab, and Rice University
     February 29, 1992.
     Translation from FORTRAN to pseudocode (AlgoPascal)
     by Sergey Bochkanov, ALGLIB project, 2005-2007.
*************************************************************************/
void rmatrixqr(ap::real_2d_array& a, int m, int n, ap::real_1d_array& tau)
{
    ap::real_1d_array work;
    ap::real_1d_array t;
    int i;
    int k;
    int minmn;
    double tmp;

    if( m<=0||n<=0 )
    {
        return;
    }
    minmn = ap::minint(m, n);
    work.setbounds(0, n-1);
    t.setbounds(1, m);
    tau.setbounds(0, minmn-1);
    
    //
    // Test the input arguments
    //
    k = minmn;
    for(i = 0; i <= k-1; i++)
    {
        
        //
        // Generate elementary reflector H(i) to annihilate A(i+1:m,i)
        //
        ap::vmove(t.getvector(1, m-i), a.getcolumn(i, i, m-1));
        generatereflection(t, m-i, tmp);
        tau(i) = tmp;
        ap::vmove(a.getcolumn(i, i, m-1), t.getvector(1, m-i));
        t(1) = 1;
        if( i<n )
        {
            
            //
            // Apply H(i) to A(i:m-1,i+1:n-1) from the left
            //
            applyreflectionfromtheleft(a, tau(i), t, i, m-1, i+1, n-1, work);
        }
    }
}
/*************************************************************************
Obsolete 1-based subroutine
*************************************************************************/
void shermanmorrisonupdaterow(ap::real_2d_array& inva,
     int n,
     int updrow,
     const ap::real_1d_array& v)
{
    ap::real_1d_array t1;
    ap::real_1d_array t2;
    int i;
    int j;
    double lambda;
    double vt;

    t1.setbounds(1, n);
    t2.setbounds(1, n);
    
    //
    // T1 = InvA * U
    //
    ap::vmove(t1.getvector(1, n), inva.getcolumn(updrow, 1, n));
    
    //
    // T2 = v*InvA
    // Lambda = v * InvA * U
    //
    for(j = 1; j <= n; j++)
    {
        vt = ap::vdotproduct(v.getvector(1, n), inva.getcolumn(j, 1, n));
        t2(j) = vt;
    }
    lambda = t2(updrow);
    
    //
    // InvA = InvA - correction
    //
    for(i = 1; i <= n; i++)
    {
        vt = t1(i)/(1+lambda);
        ap::vsub(&inva(i, 1), &t2(1), ap::vlen(1,n), vt);
    }
}
/*************************************************************************
Inverse matrix update by the Sherman-Morrison formula

The algorithm updates matrix A^-1 when adding a vector to a row
of matrix A.

Input parameters:
    InvA    -   inverse of matrix A.
                Array whose indexes range within [0..N-1, 0..N-1].
    N       -   size of matrix A.
    UpdRow  -   the row of A whose vector V was added.
                0 <= Row <= N-1
    V       -   the vector to be added to a row.
                Array whose index ranges within [0..N-1].

Output parameters:
    InvA    -   inverse of modified matrix A.

  -- ALGLIB --
     Copyright 2005 by Bochkanov Sergey
*************************************************************************/
void rmatrixinvupdaterow(ap::real_2d_array& inva,
     int n,
     int updrow,
     const ap::real_1d_array& v)
{
    ap::real_1d_array t1;
    ap::real_1d_array t2;
    int i;
    int j;
    double lambda;
    double vt;

    t1.setbounds(0, n-1);
    t2.setbounds(0, n-1);
    
    //
    // T1 = InvA * U
    //
    ap::vmove(t1.getvector(0, n-1), inva.getcolumn(updrow, 0, n-1));
    
    //
    // T2 = v*InvA
    // Lambda = v * InvA * U
    //
    for(j = 0; j <= n-1; j++)
    {
        vt = ap::vdotproduct(v.getvector(0, n-1), inva.getcolumn(j, 0, n-1));
        t2(j) = vt;
    }
    lambda = t2(updrow);
    
    //
    // InvA = InvA - correction
    //
    for(i = 0; i <= n-1; i++)
    {
        vt = t1(i)/(1+lambda);
        ap::vsub(&inva(i, 0), &t2(0), ap::vlen(0,n-1), vt);
    }
}
/*************************************************************************
Tests Z*Z' against diag(1...1)
Returns absolute error.
*************************************************************************/
static double testort(const ap::real_2d_array& z, int n)
{
    double result;
    int i;
    int j;
    double v;

    result = 0;
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            v = ap::vdotproduct(z.getcolumn(i, 0, n-1), z.getcolumn(j, 0, n-1));
            if( i==j )
            {
                v = v-1;
            }
            result = ap::maxreal(result, fabs(v));
        }
    }
    return result;
}
Esempio n. 11
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;
        }
    }
}
Esempio n. 12
0
/*************************************************************************
Copy
*************************************************************************/
static void rmatrixmakeacopy(const ap::real_2d_array& a,
     int m,
     int n,
     ap::real_2d_array& b)
{
    int i;
    int j;

    b.setbounds(0, m-1, 0, n-1);
    for(i = 0; i <= m-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            b(i,j) = a(i,j);
        }
    }
}
Esempio n. 13
0
/*************************************************************************
Generation of random NxN symmetric positive definite matrix with given
condition number and norm2(A)=1

INPUT PARAMETERS:
    N   -   matrix size
    C   -   condition number (in 2-norm)

OUTPUT PARAMETERS:
    A   -   random SPD matrix with norm2(A)=1 and cond(A)=C

  -- ALGLIB routine --
     04.12.2009
     Bochkanov Sergey
*************************************************************************/
void spdmatrixrndcond(int n, double c, ap::real_2d_array& a)
{
    int i;
    int j;
    double l1;
    double l2;

    
    //
    // Special cases
    //
    if( n<=0||ap::fp_less(c,1) )
    {
        return;
    }
    a.setbounds(0, n-1, 0, n-1);
    if( n==1 )
    {
        a(0,0) = 1;
        return;
    }
    
    //
    // Prepare matrix
    //
    l1 = 0;
    l2 = log(1/c);
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            a(i,j) = 0;
        }
    }
    a(0,0) = exp(l1);
    for(i = 1; i <= n-2; i++)
    {
        a(i,i) = exp(ap::randomreal()*(l2-l1)+l1);
    }
    a(n-1,n-1) = exp(l2);
    
    //
    // Multiply
    //
    smatrixrndmultiply(a, n);
}
Esempio n. 14
0
/*************************************************************************
Generation of random NxN symmetric matrix with given condition number  and
norm2(A)=1

INPUT PARAMETERS:
    N   -   matrix size
    C   -   condition number (in 2-norm)

OUTPUT PARAMETERS:
    A   -   random matrix with norm2(A)=1 and cond(A)=C

  -- ALGLIB routine --
     04.12.2009
     Bochkanov Sergey
*************************************************************************/
void smatrixrndcond(int n, double c, ap::real_2d_array& a)
{
    int i;
    int j;
    double l1;
    double l2;

    ap::ap_error::make_assertion(n>=1&&ap::fp_greater_eq(c,1), "SMatrixRndCond: N<1 or C<1!");
    a.setbounds(0, n-1, 0, n-1);
    if( n==1 )
    {
        
        //
        // special case
        //
        a(0,0) = 2*ap::randominteger(2)-1;
        return;
    }
    
    //
    // Prepare matrix
    //
    l1 = 0;
    l2 = log(1/c);
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            a(i,j) = 0;
        }
    }
    a(0,0) = exp(l1);
    for(i = 1; i <= n-2; i++)
    {
        a(i,i) = (2*ap::randominteger(2)-1)*exp(ap::randomreal()*(l2-l1)+l1);
    }
    a(n-1,n-1) = exp(l2);
    
    //
    // Multiply
    //
    smatrixrndmultiply(a, n);
}
/*************************************************************************
Inverse matrix update by the Sherman-Morrison formula

The algorithm updates matrix A^-1 when adding a number to an element
of matrix A.

Input parameters:
    InvA    -   inverse of matrix A.
                Array whose indexes range within [0..N-1, 0..N-1].
    N       -   size of matrix A.
    UpdRow  -   row where the element to be updated is stored.
    UpdColumn - column where the element to be updated is stored.
    UpdVal  -   a number to be added to the element.


Output parameters:
    InvA    -   inverse of modified matrix A.

  -- ALGLIB --
     Copyright 2005 by Bochkanov Sergey
*************************************************************************/
void rmatrixinvupdatesimple(ap::real_2d_array& inva,
     int n,
     int updrow,
     int updcolumn,
     double updval)
{
    ap::real_1d_array t1;
    ap::real_1d_array t2;
    int i;
    int j;
    double lambda;
    double vt;

    ap::ap_error::make_assertion(updrow>=0&&updrow<n, "RMatrixInvUpdateSimple: incorrect UpdRow!");
    ap::ap_error::make_assertion(updcolumn>=0&&updcolumn<n, "RMatrixInvUpdateSimple: incorrect UpdColumn!");
    t1.setbounds(0, n-1);
    t2.setbounds(0, n-1);
    
    //
    // T1 = InvA * U
    //
    ap::vmove(t1.getvector(0, n-1), inva.getcolumn(updrow, 0, n-1));
    
    //
    // T2 = v*InvA
    //
    ap::vmove(&t2(0), &inva(updcolumn, 0), ap::vlen(0,n-1));
    
    //
    // Lambda = v * InvA * U
    //
    lambda = updval*inva(updcolumn,updrow);
    
    //
    // InvA = InvA - correction
    //
    for(i = 0; i <= n-1; i++)
    {
        vt = updval*t1(i);
        vt = vt/(1+lambda);
        ap::vsub(&inva(i, 0), &t2(0), ap::vlen(0,n-1), vt);
    }
}
Esempio n. 16
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;
}
Esempio n. 17
0
/*************************************************************************
Unpacking matrix Q which reduces a matrix to bidiagonal form.

Input parameters:
    QP          -   matrices Q and P in compact form.
                    Output of ToBidiagonal subroutine.
    M           -   number of rows in matrix A.
    N           -   number of columns in matrix A.
    TAUQ        -   scalar factors which are used to form Q.
                    Output of ToBidiagonal subroutine.
    QColumns    -   required number of columns in matrix Q.
                    M>=QColumns>=0.

Output parameters:
    Q           -   first QColumns columns of matrix Q.
                    Array[0..M-1, 0..QColumns-1]
                    If QColumns=0, the array is not modified.

  -- ALGLIB --
     Copyright 2005 by Bochkanov Sergey
*************************************************************************/
void rmatrixbdunpackq(const ap::real_2d_array& qp,
     int m,
     int n,
     const ap::real_1d_array& tauq,
     int qcolumns,
     ap::real_2d_array& q)
{
    int i;
    int j;

    ap::ap_error::make_assertion(qcolumns<=m, "RMatrixBDUnpackQ: QColumns>M!");
    ap::ap_error::make_assertion(qcolumns>=0, "RMatrixBDUnpackQ: QColumns<0!");
    if( m==0||n==0||qcolumns==0 )
    {
        return;
    }
    
    //
    // prepare Q
    //
    q.setbounds(0, m-1, 0, qcolumns-1);
    for(i = 0; i <= m-1; i++)
    {
        for(j = 0; j <= qcolumns-1; j++)
        {
            if( i==j )
            {
                q(i,j) = 1;
            }
            else
            {
                q(i,j) = 0;
            }
        }
    }
    
    //
    // Calculate
    //
    rmatrixbdmultiplybyq(qp, m, n, tauq, q, m, qcolumns, false, false);
}
/*************************************************************************
Obsolete 1-based subroutine
*************************************************************************/
void shermanmorrisonsimpleupdate(ap::real_2d_array& inva,
     int n,
     int updrow,
     int updcolumn,
     double updval)
{
    ap::real_1d_array t1;
    ap::real_1d_array t2;
    int i;
    int j;
    double lambda;
    double vt;

    t1.setbounds(1, n);
    t2.setbounds(1, n);
    
    //
    // T1 = InvA * U
    //
    ap::vmove(t1.getvector(1, n), inva.getcolumn(updrow, 1, n));
    
    //
    // T2 = v*InvA
    //
    ap::vmove(&t2(1), &inva(updcolumn, 1), ap::vlen(1,n));
    
    //
    // Lambda = v * InvA * U
    //
    lambda = updval*inva(updcolumn,updrow);
    
    //
    // InvA = InvA - correction
    //
    for(i = 1; i <= n; i++)
    {
        vt = updval*t1(i);
        vt = vt/(1+lambda);
        ap::vsub(&inva(i, 1), &t2(1), ap::vlen(1,n), vt);
    }
}
Esempio n. 19
0
/*************************************************************************
Unpacking matrix P which reduces matrix A to bidiagonal form.
The subroutine returns transposed matrix P.

Input parameters:
    QP      -   matrices Q and P in compact form.
                Output of ToBidiagonal subroutine.
    M       -   number of rows in matrix A.
    N       -   number of columns in matrix A.
    TAUP    -   scalar factors which are used to form P.
                Output of ToBidiagonal subroutine.
    PTRows  -   required number of rows of matrix P^T. N >= PTRows >= 0.

Output parameters:
    PT      -   first PTRows columns of matrix P^T
                Array[0..PTRows-1, 0..N-1]
                If PTRows=0, the array is not modified.

  -- ALGLIB --
     Copyright 2005-2007 by Bochkanov Sergey
*************************************************************************/
void rmatrixbdunpackpt(const ap::real_2d_array& qp,
     int m,
     int n,
     const ap::real_1d_array& taup,
     int ptrows,
     ap::real_2d_array& pt)
{
    int i;
    int j;

    ap::ap_error::make_assertion(ptrows<=n, "RMatrixBDUnpackPT: PTRows>N!");
    ap::ap_error::make_assertion(ptrows>=0, "RMatrixBDUnpackPT: PTRows<0!");
    if( m==0||n==0||ptrows==0 )
    {
        return;
    }
    
    //
    // prepare PT
    //
    pt.setbounds(0, ptrows-1, 0, n-1);
    for(i = 0; i <= ptrows-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            if( i==j )
            {
                pt(i,j) = 1;
            }
            else
            {
                pt(i,j) = 0;
            }
        }
    }
    
    //
    // Calculate
    //
    rmatrixbdmultiplybyp(qp, m, n, taup, pt, ptrows, n, true, true);
}
Esempio n. 20
0
static void fillidentity(ap::real_2d_array& a, int n)
{
    int i;
    int j;

    a.setbounds(0, n-1, 0, n-1);
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            if( i==j )
            {
                a(i,j) = 1;
            }
            else
            {
                a(i,j) = 0;
            }
        }
    }
}
Esempio n. 21
0
/*************************************************************************
Generation of a random uniformly distributed (Haar) orthogonal matrix

INPUT PARAMETERS:
    N   -   matrix size, N>=1
    
OUTPUT PARAMETERS:
    A   -   orthogonal NxN matrix, array[0..N-1,0..N-1]

  -- ALGLIB routine --
     04.12.2009
     Bochkanov Sergey
*************************************************************************/
void rmatrixrndorthogonal(int n, ap::real_2d_array& a)
{
    int i;
    int j;

    ap::ap_error::make_assertion(n>=1, "RMatrixRndOrthogonal: N<1!");
    a.setbounds(0, n-1, 0, n-1);
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            if( i==j )
            {
                a(i,j) = 1;
            }
            else
            {
                a(i,j) = 0;
            }
        }
    }
    rmatrixrndorthogonalfromtheright(a, n, n);
}
Esempio n. 22
0
/*************************************************************************
Example of usage of an IterativeEstimateNorm subroutine

Input parameters:
    A   -   matrix.
            Array whose indexes range within [1..N, 1..N].

Return:
    Matrix norm estimated by the subroutine.

  -- ALGLIB --
     Copyright 2005 by Bochkanov Sergey
*************************************************************************/
double demoiterativeestimate1norm(const ap::real_2d_array& a, int n)
{
    double result;
    int i;
    double s;
    ap::real_1d_array x;
    ap::real_1d_array t;
    ap::real_1d_array v;
    ap::integer_1d_array iv;
    int kase;

    kase = 0;
    t.setbounds(1, n);
    iterativeestimate1norm(n, v, x, iv, result, kase);
    while(kase!=0)
    {
        if( kase==1 )
        {
            for(i = 1; i <= n; i++)
            {
                s = ap::vdotproduct(&a(i, 1), 1, &x(1), 1, ap::vlen(1,n));
                t(i) = s;
            }
        }
        else
        {
            for(i = 1; i <= n; i++)
            {
                s = ap::vdotproduct(&a(1, i), a.getstride(), &x(1), 1, ap::vlen(1,n));
                t(i) = s;
            }
        }
        ap::vmove(&x(1), 1, &t(1), 1, ap::vlen(1,n));
        iterativeestimate1norm(n, v, x, iv, result, kase);
    }
    return result;
}
Esempio n. 23
0
/*************************************************************************
Generation of random NxN matrix with given condition number and norm2(A)=1

INPUT PARAMETERS:
    N   -   matrix size
    C   -   condition number (in 2-norm)

OUTPUT PARAMETERS:
    A   -   random matrix with norm2(A)=1 and cond(A)=C

  -- ALGLIB routine --
     04.12.2009
     Bochkanov Sergey
*************************************************************************/
void rmatrixrndcond(int n, double c, ap::real_2d_array& a)
{
    int i;
    int j;
    double l1;
    double l2;

    ap::ap_error::make_assertion(n>=1&&ap::fp_greater_eq(c,1), "RMatrixRndCond: N<1 or C<1!");
    a.setbounds(0, n-1, 0, n-1);
    if( n==1 )
    {
        
        //
        // special case
        //
        a(0,0) = 2*ap::randominteger(2)-1;
        return;
    }
    l1 = 0;
    l2 = log(1/c);
    for(i = 0; i <= n-1; i++)
    {
        for(j = 0; j <= n-1; j++)
        {
            a(i,j) = 0;
        }
    }
    a(0,0) = exp(l1);
    for(i = 1; i <= n-2; i++)
    {
        a(i,i) = exp(ap::randomreal()*(l2-l1)+l1);
    }
    a(n-1,n-1) = exp(l2);
    rmatrixrndorthogonalfromtheleft(a, n, n);
    rmatrixrndorthogonalfromtheright(a, n, n);
}
Esempio n. 24
0
/*************************************************************************
Symmetric multiplication of NxN matrix by random Haar distributed
orthogonal  matrix

INPUT PARAMETERS:
    A   -   matrix, array[0..N-1, 0..N-1]
    N   -   matrix size

OUTPUT PARAMETERS:
    A   -   Q'*A*Q, where Q is random NxN orthogonal matrix

  -- ALGLIB routine --
     04.12.2009
     Bochkanov Sergey
*************************************************************************/
void smatrixrndmultiply(ap::real_2d_array& a, int n)
{
    double tau;
    double lambda;
    int s;
    int i;
    int j;
    double u1;
    double u2;
    ap::real_1d_array w;
    ap::real_1d_array v;
    double sm;
    hqrndstate state;

    
    //
    // General case.
    //
    w.setbounds(0, n-1);
    v.setbounds(1, n);
    hqrndrandomize(state);
    for(s = 2; s <= n; s++)
    {
        
        //
        // Prepare random normal v
        //
        do
        {
            i = 1;
            while(i<=s)
            {
                hqrndnormal2(state, u1, u2);
                v(i) = u1;
                if( i+1<=s )
                {
                    v(i+1) = u2;
                }
                i = i+2;
            }
            lambda = ap::vdotproduct(&v(1), &v(1), ap::vlen(1,s));
        }
        while(ap::fp_eq(lambda,0));
        
        //
        // Prepare and apply reflection
        //
        generatereflection(v, s, tau);
        v(1) = 1;
        applyreflectionfromtheright(a, tau, v, 0, n-1, n-s, n-1, w);
        applyreflectionfromtheleft(a, tau, v, n-s, n-1, 0, n-1, w);
    }
    
    //
    // Second pass.
    //
    for(i = 0; i <= n-1; i++)
    {
        tau = 2*ap::randominteger(2)-1;
        ap::vmul(a.getcolumn(i, 0, n-1), tau);
        ap::vmul(&a(i, 0), ap::vlen(0,n-1), tau);
    }
}
Esempio n. 25
0
/*************************************************************************
Multiplication of MxN matrix by NxN random Haar distributed orthogonal matrix

INPUT PARAMETERS:
    A   -   matrix, array[0..M-1, 0..N-1]
    M, N-   matrix size

OUTPUT PARAMETERS:
    A   -   A*Q, where Q is random NxN orthogonal matrix

  -- ALGLIB routine --
     04.12.2009
     Bochkanov Sergey
*************************************************************************/
void rmatrixrndorthogonalfromtheright(ap::real_2d_array& a, int m, int n)
{
    double tau;
    double lambda;
    int s;
    int i;
    int j;
    double u1;
    double u2;
    ap::real_1d_array w;
    ap::real_1d_array v;
    double sm;
    hqrndstate state;

    ap::ap_error::make_assertion(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!");
    if( n==1 )
    {
        
        //
        // Special case
        //
        tau = 2*ap::randominteger(2)-1;
        for(i = 0; i <= m-1; i++)
        {
            a(i,0) = a(i,0)*tau;
        }
        return;
    }
    
    //
    // General case.
    // First pass.
    //
    w.setbounds(0, m-1);
    v.setbounds(1, n);
    hqrndrandomize(state);
    for(s = 2; s <= n; s++)
    {
        
        //
        // Prepare random normal v
        //
        do
        {
            i = 1;
            while(i<=s)
            {
                hqrndnormal2(state, u1, u2);
                v(i) = u1;
                if( i+1<=s )
                {
                    v(i+1) = u2;
                }
                i = i+2;
            }
            lambda = ap::vdotproduct(&v(1), &v(1), ap::vlen(1,s));
        }
        while(ap::fp_eq(lambda,0));
        
        //
        // Prepare and apply reflection
        //
        generatereflection(v, s, tau);
        v(1) = 1;
        applyreflectionfromtheright(a, tau, v, 0, m-1, n-s, n-1, w);
    }
    
    //
    // Second pass.
    //
    for(i = 0; i <= n-1; i++)
    {
        tau = 2*ap::randominteger(2)-1;
        ap::vmul(a.getcolumn(i, 0, m-1), tau);
    }
}
Esempio n. 26
0
void internalschurdecomposition(ap::real_2d_array& h,
     int n,
     int tneeded,
     int zneeded,
     ap::real_1d_array& wr,
     ap::real_1d_array& wi,
     ap::real_2d_array& z,
     int& info)
{
    ap::real_1d_array work;
    int i;
    int i1;
    int i2;
    int ierr;
    int ii;
    int itemp;
    int itn;
    int its;
    int j;
    int k;
    int l;
    int maxb;
    int nr;
    int ns;
    int nv;
    double absw;
    double ovfl;
    double smlnum;
    double tau;
    double temp;
    double tst1;
    double ulp;
    double unfl;
    ap::real_2d_array s;
    ap::real_1d_array v;
    ap::real_1d_array vv;
    ap::real_1d_array workc1;
    ap::real_1d_array works1;
    ap::real_1d_array workv3;
    ap::real_1d_array tmpwr;
    ap::real_1d_array tmpwi;
    bool initz;
    bool wantt;
    bool wantz;
    double cnst;
    bool failflag;
    int p1;
    int p2;
    int p3;
    int p4;
    double vt;

    
    //
    // Set the order of the multi-shift QR algorithm to be used.
    // If you want to tune algorithm, change this values
    //
    ns = 12;
    maxb = 50;
    
    //
    // Now 2 < NS <= MAXB < NH.
    //
    maxb = ap::maxint(3, maxb);
    ns = ap::minint(maxb, ns);
    
    //
    // Initialize
    //
    cnst = 1.5;
    work.setbounds(1, ap::maxint(n, 1));
    s.setbounds(1, ns, 1, ns);
    v.setbounds(1, ns+1);
    vv.setbounds(1, ns+1);
    wr.setbounds(1, ap::maxint(n, 1));
    wi.setbounds(1, ap::maxint(n, 1));
    workc1.setbounds(1, 1);
    works1.setbounds(1, 1);
    workv3.setbounds(1, 3);
    tmpwr.setbounds(1, ap::maxint(n, 1));
    tmpwi.setbounds(1, ap::maxint(n, 1));
    ap::ap_error::make_assertion(n>=0, "InternalSchurDecomposition: incorrect N!");
    ap::ap_error::make_assertion(tneeded==0||tneeded==1, "InternalSchurDecomposition: incorrect TNeeded!");
    ap::ap_error::make_assertion(zneeded==0||zneeded==1||zneeded==2, "InternalSchurDecomposition: incorrect ZNeeded!");
    wantt = tneeded==1;
    initz = zneeded==2;
    wantz = zneeded!=0;
    info = 0;
    
    //
    // Initialize Z, if necessary
    //
    if( initz )
    {
        z.setbounds(1, n, 1, n);
        for(i = 1; i <= n; i++)
        {
            for(j = 1; j <= n; j++)
            {
                if( i==j )
                {
                    z(i,j) = 1;
                }
                else
                {
                    z(i,j) = 0;
                }
            }
        }
    }
    
    //
    // Quick return if possible
    //
    if( n==0 )
    {
        return;
    }
    if( n==1 )
    {
        wr(1) = h(1,1);
        wi(1) = 0;
        return;
    }
    
    //
    // Set rows and columns 1 to N to zero below the first
    // subdiagonal.
    //
    for(j = 1; j <= n-2; j++)
    {
        for(i = j+2; i <= n; i++)
        {
            h(i,j) = 0;
        }
    }
    
    //
    // Test if N is sufficiently small
    //
    if( ns<=2||ns>n||maxb>=n )
    {
        
        //
        // Use the standard double-shift algorithm
        //
        internalauxschur(wantt, wantz, n, 1, n, h, wr, wi, 1, n, z, work, workv3, workc1, works1, info);
        
        //
        // fill entries under diagonal blocks of T with zeros
        //
        if( wantt )
        {
            j = 1;
            while(j<=n)
            {
                if( wi(j)==0 )
                {
                    for(i = j+1; i <= n; i++)
                    {
                        h(i,j) = 0;
                    }
                    j = j+1;
                }
                else
                {
                    for(i = j+2; i <= n; i++)
                    {
                        h(i,j) = 0;
                        h(i,j+1) = 0;
                    }
                    j = j+2;
                }
            }
        }
        return;
    }
    unfl = ap::minrealnumber;
    ovfl = 1/unfl;
    ulp = 2*ap::machineepsilon;
    smlnum = unfl*(n/ulp);
    
    //
    // I1 and I2 are the indices of the first row and last column of H
    // to which transformations must be applied. If eigenvalues only are
    // being computed, I1 and I2 are set inside the main loop.
    //
    if( wantt )
    {
        i1 = 1;
        i2 = n;
    }
    
    //
    // ITN is the total number of multiple-shift QR iterations allowed.
    //
    itn = 30*n;
    
    //
    // The main loop begins here. I is the loop index and decreases from
    // IHI to ILO in steps of at most MAXB. Each iteration of the loop
    // works with the active submatrix in rows and columns L to I.
    // Eigenvalues I+1 to IHI have already converged. Either L = ILO or
    // H(L,L-1) is negligible so that the matrix splits.
    //
    i = n;
    while(true)
    {
        l = 1;
        if( i<1 )
        {
            
            //
            // fill entries under diagonal blocks of T with zeros
            //
            if( wantt )
            {
                j = 1;
                while(j<=n)
                {
                    if( wi(j)==0 )
                    {
                        for(i = j+1; i <= n; i++)
                        {
                            h(i,j) = 0;
                        }
                        j = j+1;
                    }
                    else
                    {
                        for(i = j+2; i <= n; i++)
                        {
                            h(i,j) = 0;
                            h(i,j+1) = 0;
                        }
                        j = j+2;
                    }
                }
            }
            
            //
            // Exit
            //
            return;
        }
        
        //
        // Perform multiple-shift QR iterations on rows and columns ILO to I
        // until a submatrix of order at most MAXB splits off at the bottom
        // because a subdiagonal element has become negligible.
        //
        failflag = true;
        for(its = 0; its <= itn; its++)
        {
            
            //
            // Look for a single small subdiagonal element.
            //
            for(k = i; k >= l+1; k--)
            {
                tst1 = fabs(h(k-1,k-1))+fabs(h(k,k));
                if( tst1==0 )
                {
                    tst1 = upperhessenberg1norm(h, l, i, l, i, work);
                }
                if( fabs(h(k,k-1))<=ap::maxreal(ulp*tst1, smlnum) )
                {
                    break;
                }
            }
            l = k;
            if( l>1 )
            {
                
                //
                // H(L,L-1) is negligible.
                //
                h(l,l-1) = 0;
            }
            
            //
            // Exit from loop if a submatrix of order <= MAXB has split off.
            //
            if( l>=i-maxb+1 )
            {
                failflag = false;
                break;
            }
            
            //
            // Now the active submatrix is in rows and columns L to I. If
            // eigenvalues only are being computed, only the active submatrix
            // need be transformed.
            //
            if( !wantt )
            {
                i1 = l;
                i2 = i;
            }
            if( its==20||its==30 )
            {
                
                //
                // Exceptional shifts.
                //
                for(ii = i-ns+1; ii <= i; ii++)
                {
                    wr(ii) = cnst*(fabs(h(ii,ii-1))+fabs(h(ii,ii)));
                    wi(ii) = 0;
                }
            }
            else
            {
                
                //
                // Use eigenvalues of trailing submatrix of order NS as shifts.
                //
                copymatrix(h, i-ns+1, i, i-ns+1, i, s, 1, ns, 1, ns);
                internalauxschur(false, false, ns, 1, ns, s, tmpwr, tmpwi, 1, ns, z, work, workv3, workc1, works1, ierr);
                for(p1 = 1; p1 <= ns; p1++)
                {
                    wr(i-ns+p1) = tmpwr(p1);
                    wi(i-ns+p1) = tmpwi(p1);
                }
                if( ierr>0 )
                {
                    
                    //
                    // If DLAHQR failed to compute all NS eigenvalues, use the
                    // unconverged diagonal elements as the remaining shifts.
                    //
                    for(ii = 1; ii <= ierr; ii++)
                    {
                        wr(i-ns+ii) = s(ii,ii);
                        wi(i-ns+ii) = 0;
                    }
                }
            }
            
            //
            // Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns))
            // where G is the Hessenberg submatrix H(L:I,L:I) and w is
            // the vector of shifts (stored in WR and WI). The result is
            // stored in the local array V.
            //
            v(1) = 1;
            for(ii = 2; ii <= ns+1; ii++)
            {
                v(ii) = 0;
            }
            nv = 1;
            for(j = i-ns+1; j <= i; j++)
            {
                if( wi(j)>=0 )
                {
                    if( wi(j)==0 )
                    {
                        
                        //
                        // real shift
                        //
                        p1 = nv+1;
                        ap::vmove(&vv(1), &v(1), ap::vlen(1,p1));
                        matrixvectormultiply(h, l, l+nv, l, l+nv-1, false, vv, 1, nv, 1.0, v, 1, nv+1, -wr(j));
                        nv = nv+1;
                    }
                    else
                    {
                        if( wi(j)>0 )
                        {
                            
                            //
                            // complex conjugate pair of shifts
                            //
                            p1 = nv+1;
                            ap::vmove(&vv(1), &v(1), ap::vlen(1,p1));
                            matrixvectormultiply(h, l, l+nv, l, l+nv-1, false, v, 1, nv, 1.0, vv, 1, nv+1, -2*wr(j));
                            itemp = vectoridxabsmax(vv, 1, nv+1);
                            temp = 1/ap::maxreal(fabs(vv(itemp)), smlnum);
                            p1 = nv+1;
                            ap::vmul(&vv(1), ap::vlen(1,p1), temp);
                            absw = pythag2(wr(j), wi(j));
                            temp = temp*absw*absw;
                            matrixvectormultiply(h, l, l+nv+1, l, l+nv, false, vv, 1, nv+1, 1.0, v, 1, nv+2, temp);
                            nv = nv+2;
                        }
                    }
                    
                    //
                    // Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero,
                    // reset it to the unit vector.
                    //
                    itemp = vectoridxabsmax(v, 1, nv);
                    temp = fabs(v(itemp));
                    if( temp==0 )
                    {
                        v(1) = 1;
                        for(ii = 2; ii <= nv; ii++)
                        {
                            v(ii) = 0;
                        }
                    }
                    else
                    {
                        temp = ap::maxreal(temp, smlnum);
                        vt = 1/temp;
                        ap::vmul(&v(1), ap::vlen(1,nv), vt);
                    }
                }
            }
            
            //
            // Multiple-shift QR step
            //
            for(k = l; k <= i-1; k++)
            {
                
                //
                // The first iteration of this loop determines a reflection G
                // from the vector V and applies it from left and right to H,
                // thus creating a nonzero bulge below the subdiagonal.
                //
                // Each subsequent iteration determines a reflection G to
                // restore the Hessenberg form in the (K-1)th column, and thus
                // chases the bulge one step toward the bottom of the active
                // submatrix. NR is the order of G.
                //
                nr = ap::minint(ns+1, i-k+1);
                if( k>l )
                {
                    p1 = k-1;
                    p2 = k+nr-1;
                    ap::vmove(v.getvector(1, nr), h.getcolumn(p1, k, p2));
                }
                generatereflection(v, nr, tau);
                if( k>l )
                {
                    h(k,k-1) = v(1);
                    for(ii = k+1; ii <= i; ii++)
                    {
                        h(ii,k-1) = 0;
                    }
                }
                v(1) = 1;
                
                //
                // Apply G from the left to transform the rows of the matrix in
                // columns K to I2.
                //
                applyreflectionfromtheleft(h, tau, v, k, k+nr-1, k, i2, work);
                
                //
                // Apply G from the right to transform the columns of the
                // matrix in rows I1 to min(K+NR,I).
                //
                applyreflectionfromtheright(h, tau, v, i1, ap::minint(k+nr, i), k, k+nr-1, work);
                if( wantz )
                {
                    
                    //
                    // Accumulate transformations in the matrix Z
                    //
                    applyreflectionfromtheright(z, tau, v, 1, n, k, k+nr-1, work);
                }
            }
        }
        
        //
        // Failure to converge in remaining number of iterations
        //
        if( failflag )
        {
            info = i;
            return;
        }
        
        //
        // A submatrix of order <= MAXB in rows and columns L to I has split
        // off. Use the double-shift QR algorithm to handle it.
        //
        internalauxschur(wantt, wantz, n, l, i, h, wr, wi, 1, n, z, work, workv3, workc1, works1, info);
        if( info>0 )
        {
            return;
        }
        
        //
        // Decrement number of remaining iterations, and return to start of
        // the main loop with a new value of I.
        //
        itn = itn-its;
        i = l-1;
    }
}
Esempio n. 27
0
/*************************************************************************
Algorithm for solving the following generalized symmetric positive-definite
eigenproblem:
    A*x = lambda*B*x (1) or
    A*B*x = lambda*x (2) or
    B*A*x = lambda*x (3).
where A is a symmetric matrix, B - symmetric positive-definite matrix.
The problem is solved by reducing it to an ordinary  symmetric  eigenvalue
problem.

Input parameters:
    A           -   symmetric matrix which is given by its upper or lower
                    triangular part.
                    Array whose indexes range within [0..N-1, 0..N-1].
    N           -   size of matrices A and B.
    IsUpperA    -   storage format of matrix A.
    B           -   symmetric positive-definite matrix which is given by
                    its upper or lower triangular part.
                    Array whose indexes range within [0..N-1, 0..N-1].
    IsUpperB    -   storage format of matrix B.
    ZNeeded     -   if ZNeeded is equal to:
                     * 0, the eigenvectors are not returned;
                     * 1, the eigenvectors are returned.
    ProblemType -   if ProblemType is equal to:
                     * 1, the following problem is solved: A*x = lambda*B*x;
                     * 2, the following problem is solved: A*B*x = lambda*x;
                     * 3, the following problem is solved: B*A*x = lambda*x.

Output parameters:
    D           -   eigenvalues in ascending order.
                    Array whose index ranges within [0..N-1].
    Z           -   if ZNeeded is equal to:
                     * 0, Z hasn’t changed;
                     * 1, Z contains eigenvectors.
                    Array whose indexes range within [0..N-1, 0..N-1].
                    The eigenvectors are stored in matrix columns. It should
                    be noted that the eigenvectors in such problems do not
                    form an orthogonal system.

Result:
    True, if the problem was solved successfully.
    False, if the error occurred during the Cholesky decomposition of matrix
    B (the matrix isn’t positive-definite) or during the work of the iterative
    algorithm for solving the symmetric eigenproblem.

See also the GeneralizedSymmetricDefiniteEVDReduce subroutine.

  -- ALGLIB --
     Copyright 1.28.2006 by Bochkanov Sergey
*************************************************************************/
bool smatrixgevd(ap::real_2d_array a,
                 int n,
                 bool isuppera,
                 const ap::real_2d_array& b,
                 bool isupperb,
                 int zneeded,
                 int problemtype,
                 ap::real_1d_array& d,
                 ap::real_2d_array& z)
{
    bool result;
    ap::real_2d_array r;
    ap::real_2d_array t;
    bool isupperr;
    int j1;
    int j2;
    int j1inc;
    int j2inc;
    int i;
    int j;
    double v;


    //
    // Reduce and solve
    //
    result = smatrixgevdreduce(a, n, isuppera, b, isupperb, problemtype, r, isupperr);
    if( !result )
    {
        return result;
    }
    result = smatrixevd(a, n, zneeded, isuppera, d, t);
    if( !result )
    {
        return result;
    }

    //
    // Transform eigenvectors if needed
    //
    if( zneeded!=0 )
    {

        //
        // fill Z with zeros
        //
        z.setbounds(0, n-1, 0, n-1);
        for(j = 0; j <= n-1; j++)
        {
            z(0,j) = 0.0;
        }
        for(i = 1; i <= n-1; i++)
        {
            ap::vmove(&z(i, 0), &z(0, 0), ap::vlen(0,n-1));
        }

        //
        // Setup R properties
        //
        if( isupperr )
        {
            j1 = 0;
            j2 = n-1;
            j1inc = +1;
            j2inc = 0;
        }
        else
        {
            j1 = 0;
            j2 = 0;
            j1inc = 0;
            j2inc = +1;
        }

        //
        // Calculate R*Z
        //
        for(i = 0; i <= n-1; i++)
        {
            for(j = j1; j <= j2; j++)
            {
                v = r(i,j);
                ap::vadd(&z(i, 0), &t(j, 0), ap::vlen(0,n-1), v);
            }
            j1 = j1+j1inc;
            j2 = j2+j2inc;
        }
    }
    return result;
}
Esempio n. 28
0
bool generalizedsymmetricdefiniteevdreduce(ap::real_2d_array& a,
        int n,
        bool isuppera,
        const ap::real_2d_array& b,
        bool isupperb,
        int problemtype,
        ap::real_2d_array& r,
        bool& isupperr)
{
    bool result;
    ap::real_2d_array t;
    ap::real_1d_array w1;
    ap::real_1d_array w2;
    ap::real_1d_array w3;
    int i;
    int j;
    double v;

    ap::ap_error::make_assertion(n>0, "GeneralizedSymmetricDefiniteEVDReduce: N<=0!");
    ap::ap_error::make_assertion(problemtype==1||problemtype==2||problemtype==3, "GeneralizedSymmetricDefiniteEVDReduce: incorrect ProblemType!");
    result = true;

    //
    // Problem 1:  A*x = lambda*B*x
    //
    // Reducing to:
    //     C*y = lambda*y
    //     C = L^(-1) * A * L^(-T)
    //     x = L^(-T) * y
    //
    if( problemtype==1 )
    {

        //
        // Factorize B in T: B = LL'
        //
        t.setbounds(1, n, 1, n);
        if( isupperb )
        {
            for(i = 1; i <= n; i++)
            {
                ap::vmove(t.getcolumn(i, i, n), b.getrow(i, i, n));
            }
        }
        else
        {
            for(i = 1; i <= n; i++)
            {
                ap::vmove(&t(i, 1), &b(i, 1), ap::vlen(1,i));
            }
        }
        if( !choleskydecomposition(t, n, false) )
        {
            result = false;
            return result;
        }

        //
        // Invert L in T
        //
        if( !invtriangular(t, n, false, false) )
        {
            result = false;
            return result;
        }

        //
        // Build L^(-1) * A * L^(-T) in R
        //
        w1.setbounds(1, n);
        w2.setbounds(1, n);
        r.setbounds(1, n, 1, n);
        for(j = 1; j <= n; j++)
        {

            //
            // Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T))
            //
            ap::vmove(&w1(1), &t(j, 1), ap::vlen(1,j));
            symmetricmatrixvectormultiply(a, isuppera, 1, j, w1, 1.0, w2);
            if( isuppera )
            {
                matrixvectormultiply(a, 1, j, j+1, n, true, w1, 1, j, 1.0, w2, j+1, n, 0.0);
            }
            else
            {
                matrixvectormultiply(a, j+1, n, 1, j, false, w1, 1, j, 1.0, w2, j+1, n, 0.0);
            }

            //
            // Form l(i)*w2 (here l(i) is i-th row of L^(-1))
            //
            for(i = 1; i <= n; i++)
            {
                v = ap::vdotproduct(&t(i, 1), &w2(1), ap::vlen(1,i));
                r(i,j) = v;
            }
        }

        //
        // Copy R to A
        //
        for(i = 1; i <= n; i++)
        {
            ap::vmove(&a(i, 1), &r(i, 1), ap::vlen(1,n));
        }

        //
        // Copy L^(-1) from T to R and transpose
        //
        isupperr = true;
        for(i = 1; i <= n; i++)
        {
            for(j = 1; j <= i-1; j++)
            {
                r(i,j) = 0;
            }
        }
        for(i = 1; i <= n; i++)
        {
            ap::vmove(r.getrow(i, i, n), t.getcolumn(i, i, n));
        }
        return result;
    }

    //
    // Problem 2:  A*B*x = lambda*x
    // or
    // problem 3:  B*A*x = lambda*x
    //
    // Reducing to:
    //     C*y = lambda*y
    //     C = U * A * U'
    //     B = U'* U
    //
    if( problemtype==2||problemtype==3 )
    {

        //
        // Factorize B in T: B = U'*U
        //
        t.setbounds(1, n, 1, n);
        if( isupperb )
        {
            for(i = 1; i <= n; i++)
            {
                ap::vmove(&t(i, i), &b(i, i), ap::vlen(i,n));
            }
        }
        else
        {
            for(i = 1; i <= n; i++)
            {
                ap::vmove(t.getrow(i, i, n), b.getcolumn(i, i, n));
            }
        }
        if( !choleskydecomposition(t, n, true) )
        {
            result = false;
            return result;
        }

        //
        // Build U * A * U' in R
        //
        w1.setbounds(1, n);
        w2.setbounds(1, n);
        w3.setbounds(1, n);
        r.setbounds(1, n, 1, n);
        for(j = 1; j <= n; j++)
        {

            //
            // Form w2 = A * u'(j) (here u'(j) is j-th column of U')
            //
            ap::vmove(&w1(1), &t(j, j), ap::vlen(1,n-j+1));
            symmetricmatrixvectormultiply(a, isuppera, j, n, w1, 1.0, w3);
            ap::vmove(&w2(j), &w3(1), ap::vlen(j,n));
            ap::vmove(&w1(j), &t(j, j), ap::vlen(j,n));
            if( isuppera )
            {
                matrixvectormultiply(a, 1, j-1, j, n, false, w1, j, n, 1.0, w2, 1, j-1, 0.0);
            }
            else
            {
                matrixvectormultiply(a, j, n, 1, j-1, true, w1, j, n, 1.0, w2, 1, j-1, 0.0);
            }

            //
            // Form u(i)*w2 (here u(i) is i-th row of U)
            //
            for(i = 1; i <= n; i++)
            {
                v = ap::vdotproduct(&t(i, i), &w2(i), ap::vlen(i,n));
                r(i,j) = v;
            }
        }

        //
        // Copy R to A
        //
        for(i = 1; i <= n; i++)
        {
            ap::vmove(&a(i, 1), &r(i, 1), ap::vlen(1,n));
        }
        if( problemtype==2 )
        {

            //
            // Invert U in T
            //
            if( !invtriangular(t, n, true, false) )
            {
                result = false;
                return result;
            }

            //
            // Copy U^-1 from T to R
            //
            isupperr = true;
            for(i = 1; i <= n; i++)
            {
                for(j = 1; j <= i-1; j++)
                {
                    r(i,j) = 0;
                }
            }
            for(i = 1; i <= n; i++)
            {
                ap::vmove(&r(i, i), &t(i, i), ap::vlen(i,n));
            }
        }
        else
        {

            //
            // Copy U from T to R and transpose
            //
            isupperr = false;
            for(i = 1; i <= n; i++)
            {
                for(j = i+1; j <= n; j++)
                {
                    r(i,j) = 0;
                }
            }
            for(i = 1; i <= n; i++)
            {
                ap::vmove(r.getcolumn(i, i, n), t.getrow(i, i, n));
            }
        }
    }
    return result;
}
Esempio n. 29
0
bool GetScore(ap::template_2d_array<float,true>& Responses, 
              ap::template_1d_array<unsigned short int, true>& Code,
              parameters tMUD,
              ap::template_1d_array<short int,true>& trialnr,
              ap::template_1d_array<double,true>& windowlen, 
              int numchannels,
              int NumberOfSequences,
              int NumberOfChoices,
              int mode,
              ap::real_2d_array &pscore)

{
///////////////////////////////////////////////////////////////////////
// Section: Define variables
int row_Responses, col_Responses, row_MUD, col_MUD,
  dslen, count, max, NumberOfEpochs, numVariables;

bool flag = true;

ap::real_2d_array Responses_double;
ap::template_2d_array<float, true> Responses_copy;
ap::real_2d_array DATA;
ap::real_2d_array tmp_MUD;
ap::real_1d_array score;
ap::real_1d_array weights;

vector<short int> trial;
//vector<short int> trial_copy;
vector<int> range;
vector<int> code_indx;
vector<short int>::iterator it;

///////////////////////////////////////////////////////////////////////
// Section: Get Dimmensions 
row_Responses = Responses.gethighbound(1)+1;
col_Responses = Responses.gethighbound(0)+1;
row_MUD = tMUD.MUD.gethighbound(1)+1;
col_MUD = tMUD.MUD.gethighbound(0)+1;

///////////////////////////////////////////////////////////////////////
// Section: Extract from the signal only the channels containing the "in" variables
numVariables = static_cast<int>( col_Responses/static_cast<double>( numchannels ) );
Responses_copy.setbounds(0, row_Responses-1, 0, numVariables*(tMUD.channels.gethighbound(1)+1)-1);
Responses_double.setbounds(0, row_Responses-1, 0, numVariables*(tMUD.channels.gethighbound(1)+1)-1);

for (int i=0; i<row_Responses; i++)
{
  for (int j=0; j<tMUD.channels.gethighbound(1)+1; j++)
  {
    ap::vmove(Responses_copy.getrow(i, j*numVariables, ((j+1)*numVariables)-1), 
              Responses.getrow(i, static_cast<int>(tMUD.channels(j)-1)*numVariables, 
                                  static_cast<int>(tMUD.channels(j)*numVariables)-1));
  }
}

for (int i=0; i<row_Responses; i++)
{
    for (int j=0; j<numVariables*(tMUD.channels.gethighbound(1)+1); j++) 
      Responses_double(i,j) = static_cast<double>( Responses_copy(i,j) );
}

for (int i=0; i<row_Responses; i++)
   trial.push_back(trialnr(i)); 

///////////////////////////////////////////////////////////////////////
// Section: Downsampling the MUD  
dslen = ap::iceil((row_MUD-1)/tMUD.DF)+1;
tmp_MUD.setbounds(0, dslen, 0, col_MUD-1);
for (int j=0; j<col_MUD; j++)
{
  for (int i=0; i<dslen; i++)
  {
    if (j==0)
      tmp_MUD(i,0) = tMUD.MUD(i*tMUD.DF, 0)-1;

    if (j==1)
    {
      tmp_MUD(i,1) = tMUD.MUD(i*tMUD.DF, 1) - windowlen(0);
      tmp_MUD(i,1) = ap::ifloor(tmp_MUD(i,1)/tMUD.DF)+1;
      tmp_MUD(i,1) = tmp_MUD(i,1) + (tmp_MUD(i,0)*numVariables);
    }
    if (j==2)
      tmp_MUD(i,2) = tMUD.MUD(i*tMUD.DF, 2);
  }
}
///////////////////////////////////////////////////////////////////////
// Section: Computing the score 
DATA.setbounds(0, row_Responses-1, 0, dslen-1);
score.setbounds(0, row_Responses-1);
weights.setbounds(0, dslen-1);

double valor;
for (int i=0; i<dslen; i++)
{
  valor = tmp_MUD(i,1); 
  ap::vmove(DATA.getcolumn(i, 0, row_Responses-1), Responses_double.getcolumn(static_cast<int>( tmp_MUD(i,1) ), 0, row_Responses-1));
  valor = DATA(0,i); 
  weights(i) = tmp_MUD(i,2);
}

matrixvectormultiply(DATA, 0, row_Responses-1, 0, dslen-1, FALSE, weights, 0, dslen-1, 1, score, 0, row_Responses-1, 0);


///////////////////////////////////////////////////////////////////////
// Section: Make sure that the epochs are not outside of the boundaries 
#if 0 // jm Mar 18, 2011
trial_copy = trial;
it = unique(trial_copy.begin(), trial_copy.end());
trial_copy.resize(it-trial_copy.begin());

max = *max_element(trial_copy.begin(), trial_copy.end());
#else // jm
max = *max_element(trial.begin(), trial.end());
#endif // jm

count = 0;
for (size_t i=0; i<trial.size(); i++)
{
  if (trial[i] == max)
    count++;
}

if (count == NumberOfSequences*NumberOfChoices)
  NumberOfEpochs = *max_element(trial.begin(), trial.end());
else
  NumberOfEpochs = *max_element(trial.begin(), trial.end())-1;

///////////////////////////////////////////////////////////////////////
// Section: Create a matrix with the scores for each sequence 
pscore.setbounds(0, NumberOfChoices-1, 0, (NumberOfEpochs*NumberOfSequences)-1);
for (int i=0; i<NumberOfEpochs; i++)
{
  for (size_t j=0; j<trial.size(); j++)
  {
    if (trial[j] == i+1)
      range.push_back(static_cast<int>(j));
  }
  if ((range.size() != 0) && (range.size() == NumberOfSequences*NumberOfChoices))
  {
    for (int k=0; k<NumberOfChoices; k++)
    {
      for (size_t j=0; j<range.size(); j++)
      {
        if (Code(range[j]) == k+1)
          code_indx.push_back(range[j]);
      }
      for (size_t j=0; j<code_indx.size(); j++)
      {
        if (code_indx.size() == NumberOfSequences)
          pscore(k,static_cast<int>((i*NumberOfSequences)+j)) = score(code_indx[j]);
      }
      code_indx.clear();
    }
	flag = true;
  }
  else
  {
	  flag = false;
	  break;
  }
  range.clear(); 
}
return flag;
}
Esempio n. 30
0
/*************************************************************************
LU-разложение матрицы общего вида размера M x N

Подпрограмма вычисляет LU-разложение прямоугольной матрицы общего  вида  с
частичным выбором ведущего элемента (с перестановками строк).

Входные параметры:
    A       -   матрица A. Нумерация элементов: [1..M, 1..N]
    M       -   число строк в матрице A
    N       -   число столбцов в матрице A

Выходные параметры:
    A       -   матрицы L и U в компактной форме (см. ниже).
                Нумерация элементов: [1..M, 1..N]
    Pivots  -   матрица перестановок в компактной форме (см. ниже).
                Нумерация элементов: [1..Min(M,N)]

Матрица A представляется, как A = P * L * U, где P - матрица перестановок,
матрица L - нижнетреугольная (или нижнетрапецоидальная, если M>N) матрица,
U - верхнетреугольная (или верхнетрапецоидальная, если M<N) матрица.

Рассмотрим разложение более подробно на примере при M=4, N=3:

                   (  1          )    ( U11 U12 U13  )
A = P1 * P2 * P3 * ( L21  1      )  * (     U22 U23  )
                   ( L31 L32  1  )    (         U33  )
                   ( L41 L42 L43 )

Здесь матрица L  имеет  размер  M  x  Min(M,N),  матрица  U  имеет  размер
Min(M,N) x N, матрица  P(i)  получается  путем  перестановки  в  единичной
матрице размером M x M строк с номерами I и Pivots[I]

Результатом работы алгоритма являются массив Pivots  и  следующая матрица,
замещающая  матрицу  A,  и  сохраняющая  в компактной форме матрицы L и U
(пример приведен для M=4, N=3):

 ( U11 U12 U13 )
 ( L21 U22 U23 )
 ( L31 L32 U33 )
 ( L41 L42 L43 )

Как видно, единичная диагональ матрицы L  не  сохраняется.
Если N>M, то соответственно меняются размеры матриц и расположение
элементов.

  -- LAPACK routine (version 3.0) --
     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
     Courant Institute, Argonne National Lab, and Rice University
     June 30, 1992
*************************************************************************/
void ludecomposition(ap::real_2d_array& a,
                     int m,
                     int n,
                     ap::integer_1d_array& pivots)
{
    int i;
    int j;
    int jp;
    ap::real_1d_array t1;
    double s;

    pivots.setbounds(1, ap::minint(m, n));
    t1.setbounds(1, ap::maxint(m, n));
    ap::ap_error::make_assertion(m>=0&&n>=0);

    //
    // Quick return if possible
    //
    if( m==0||n==0 )
    {
        return;
    }
    for(j = 1; j <= ap::minint(m, n); j++)
    {

        //
        // Find pivot and test for singularity.
        //
        jp = j;
        for(i = j+1; i <= m; i++)
        {
            if( fabs(a(i,j))>fabs(a(jp,j)) )
            {
                jp = i;
            }
        }
        pivots(j) = jp;
        if( a(jp,j)!=0 )
        {

            //
            //Apply the interchange to rows
            //
            if( jp!=j )
            {
                ap::vmove(t1.getvector(1, n), a.getrow(j, 1, n));
                ap::vmove(a.getrow(j, 1, n), a.getrow(jp, 1, n));
                ap::vmove(a.getrow(jp, 1, n), t1.getvector(1, n));
            }

            //
            //Compute elements J+1:M of J-th column.
            //
            if( j<m )
            {

                //
                // CALL DSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
                //
                jp = j+1;
                s = 1/a(j,j);
                ap::vmul(a.getcolumn(j, jp, m), s);
            }
        }
        if( j<ap::minint(m, n) )
        {

            //
            //Update trailing submatrix.
            //CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,A( J+1, J+1 ), LDA )
            //
            jp = j+1;
            for(i = j+1; i <= m; i++)
            {
                s = a(i,j);
                ap::vsub(a.getrow(i, jp, n), a.getrow(j, jp, n), s);
            }
        }
    }
}