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;
}
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);
}
}
/*************************************************************************
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);
}
}
}
}
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);
}
/*************************************************************************
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));
}
}
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);
}
}
}
/*************************************************************************
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;
}
/*************************************************************************
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;
}
}
}
/*************************************************************************
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);
}
}
}
/*************************************************************************
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);
}
/*************************************************************************
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);
}
}
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;
}
/*************************************************************************
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);
}
}
/*************************************************************************
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);
}
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;
}
}
}
}
/*************************************************************************
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);
}
/*************************************************************************
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;
}
/*************************************************************************
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);
}
/*************************************************************************
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);
}
}
/*************************************************************************
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);
}
}
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;
}
}
/*************************************************************************
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;
}
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;
}
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;
}
/*************************************************************************
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);
}
}
}
}