/*************************************************************************
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));
}
}
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);
}
}
/*************************************************************************
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);
}
/*************************************************************************
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);
}
/*************************************************************************
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);
}
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);
}
/*************************************************************************
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);
}
/*************************************************************************
Unpacking matrix Q which reduces symmetric matrix to a tridiagonal
form.
Input parameters:
A - the result of a SMatrixTD subroutine
N - size of matrix A.
IsUpper - storage format (a parameter of SMatrixTD subroutine)
Tau - the result of a SMatrixTD subroutine
Output parameters:
Q - transformation matrix.
array with elements [0..N-1, 0..N-1].
-- ALGLIB --
Copyright 2005-2008 by Bochkanov Sergey
*************************************************************************/
void smatrixtdunpackq(const ap::real_2d_array& a,
const int& n,
const bool& isupper,
const ap::real_1d_array& tau,
ap::real_2d_array& q)
{
int i;
int j;
ap::real_1d_array v;
ap::real_1d_array work;
if( n==0 )
{
return;
}
//
// init
//
q.setbounds(0, n-1, 0, n-1);
v.setbounds(1, n);
work.setbounds(0, n-1);
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= n-1; j++)
{
if( i==j )
{
q(i,j) = 1;
}
else
{
q(i,j) = 0;
}
}
}
//
// unpack Q
//
if( isupper )
{
for(i = 0; i <= n-2; i++)
{
//
// Apply H(i)
//
ap::vmove(v.getvector(1, i+1), a.getcolumn(i+1, 0, i));
v(i+1) = 1;
applyreflectionfromtheleft(q, tau(i), v, 0, i, 0, n-1, work);
}
}
else
{
for(i = n-2; i >= 0; i--)
{
//
// Apply H(i)
//
ap::vmove(v.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1));
v(1) = 1;
applyreflectionfromtheleft(q, tau(i), v, i+1, n-1, 0, n-1, work);
}
}
}
bool obsoletesvddecomposition(ap::real_2d_array& a,
int m,
int n,
ap::real_1d_array& w,
ap::real_2d_array& v)
{
bool result;
int nm;
int minmn;
int l;
int k;
int j;
int jj;
int its;
int i;
double z;
double y;
double x;
double vscale;
double s;
double h;
double g;
double f;
double c;
double anorm;
ap::real_1d_array rv1;
bool flag;
rv1.setbounds(1, n);
w.setbounds(1, n);
v.setbounds(1, n, 1, n);
result = true;
if( m<n )
{
minmn = m;
}
else
{
minmn = n;
}
g = 0.0;
vscale = 0.0;
anorm = 0.0;
for(i = 1; i <= n; i++)
{
l = i+1;
rv1(i) = vscale*g;
g = 0;
s = 0;
vscale = 0;
if( i<=m )
{
for(k = i; k <= m; k++)
{
vscale = vscale+fabs(a(k,i));
}
if( ap::fp_neq(vscale,0.0) )
{
for(k = i; k <= m; k++)
{
a(k,i) = a(k,i)/vscale;
s = s+a(k,i)*a(k,i);
}
f = a(i,i);
g = -extsign(sqrt(s), f);
h = f*g-s;
a(i,i) = f-g;
if( i!=n )
{
for(j = l; j <= n; j++)
{
s = 0.0;
for(k = i; k <= m; k++)
{
s = s+a(k,i)*a(k,j);
}
f = s/h;
for(k = i; k <= m; k++)
{
a(k,j) = a(k,j)+f*a(k,i);
}
}
}
for(k = i; k <= m; k++)
{
a(k,i) = vscale*a(k,i);
}
}
}
w(i) = vscale*g;
g = 0.0;
s = 0.0;
vscale = 0.0;
if( i<=m&&i!=n )
{
for(k = l; k <= n; k++)
{
vscale = vscale+fabs(a(i,k));
}
if( ap::fp_neq(vscale,0.0) )
{
for(k = l; k <= n; k++)
{
a(i,k) = a(i,k)/vscale;
s = s+a(i,k)*a(i,k);
}
f = a(i,l);
g = -extsign(sqrt(s), f);
h = f*g-s;
a(i,l) = f-g;
for(k = l; k <= n; k++)
{
rv1(k) = a(i,k)/h;
}
if( i!=m )
{
for(j = l; j <= m; j++)
{
s = 0.0;
for(k = l; k <= n; k++)
{
s = s+a(j,k)*a(i,k);
}
for(k = l; k <= n; k++)
{
a(j,k) = a(j,k)+s*rv1(k);
}
}
}
for(k = l; k <= n; k++)
{
a(i,k) = vscale*a(i,k);
}
}
}
anorm = mymax(anorm, fabs(w(i))+fabs(rv1(i)));
}
for(i = n; i >= 1; i--)
{
if( i<n )
{
if( ap::fp_neq(g,0.0) )
{
for(j = l; j <= n; j++)
{
v(j,i) = a(i,j)/a(i,l)/g;
}
for(j = l; j <= n; j++)
{
s = 0.0;
for(k = l; k <= n; k++)
{
s = s+a(i,k)*v(k,j);
}
for(k = l; k <= n; k++)
{
v(k,j) = v(k,j)+s*v(k,i);
}
}
}
for(j = l; j <= n; j++)
{
v(i,j) = 0.0;
v(j,i) = 0.0;
}
}
v(i,i) = 1.0;
g = rv1(i);
l = i;
}
for(i = minmn; i >= 1; i--)
{
l = i+1;
g = w(i);
if( i<n )
{
for(j = l; j <= n; j++)
{
a(i,j) = 0.0;
}
}
if( ap::fp_neq(g,0.0) )
{
g = 1.0/g;
if( i!=n )
{
for(j = l; j <= n; j++)
{
s = 0.0;
for(k = l; k <= m; k++)
{
s = s+a(k,i)*a(k,j);
}
f = s/a(i,i)*g;
for(k = i; k <= m; k++)
{
a(k,j) = a(k,j)+f*a(k,i);
}
}
}
for(j = i; j <= m; j++)
{
a(j,i) = a(j,i)*g;
}
}
else
{
for(j = i; j <= m; j++)
{
a(j,i) = 0.0;
}
}
a(i,i) = a(i,i)+1.0;
}
for(k = n; k >= 1; k--)
{
for(its = 1; its <= maxsvditerations; its++)
{
flag = true;
for(l = k; l >= 1; l--)
{
nm = l-1;
if( ap::fp_eq(fabs(rv1(l))+anorm,anorm) )
{
flag = false;
break;
}
if( ap::fp_eq(fabs(w(nm))+anorm,anorm) )
{
break;
}
}
if( flag )
{
c = 0.0;
s = 1.0;
for(i = l; i <= k; i++)
{
f = s*rv1(i);
if( ap::fp_neq(fabs(f)+anorm,anorm) )
{
g = w(i);
h = pythag(f, g);
w(i) = h;
h = 1.0/h;
c = g*h;
s = -f*h;
for(j = 1; j <= m; j++)
{
y = a(j,nm);
z = a(j,i);
a(j,nm) = y*c+z*s;
a(j,i) = -y*s+z*c;
}
}
}
}
z = w(k);
if( l==k )
{
if( ap::fp_less(z,0.0) )
{
w(k) = -z;
for(j = 1; j <= n; j++)
{
v(j,k) = -v(j,k);
}
}
break;
}
if( its==maxsvditerations )
{
result = false;
return result;
}
x = w(l);
nm = k-1;
y = w(nm);
g = rv1(nm);
h = rv1(k);
f = ((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
g = pythag(f, double(1));
f = ((x-z)*(x+z)+h*(y/(f+extsign(g, f))-h))/x;
c = 1.0;
s = 1.0;
for(j = l; j <= nm; j++)
{
i = j+1;
g = rv1(i);
y = w(i);
h = s*g;
g = c*g;
z = pythag(f, h);
rv1(j) = z;
c = f/z;
s = h/z;
f = x*c+g*s;
g = -x*s+g*c;
h = y*s;
y = y*c;
for(jj = 1; jj <= n; jj++)
{
x = v(jj,j);
z = v(jj,i);
v(jj,j) = x*c+z*s;
v(jj,i) = -x*s+z*c;
}
z = pythag(f, h);
w(j) = z;
if( ap::fp_neq(z,0.0) )
{
z = 1.0/z;
c = f*z;
s = h*z;
}
f = c*g+s*y;
x = -s*g+c*y;
for(jj = 1; jj <= m; jj++)
{
y = a(jj,j);
z = a(jj,i);
a(jj,j) = y*c+z*s;
a(jj,i) = -y*s+z*c;
}
}
rv1(l) = 0.0;
rv1(k) = f;
w(k) = x;
}
}
return result;
}
/*************************************************************************
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;
}
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;
}
}
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;
}
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;
}
/*************************************************************************
Obsolete 1-based subroutine.
See RMatrixBDUnpackPT for 0-based replacement.
*************************************************************************/
void unpackptfrombidiagonal(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;
int ip1;
ap::real_1d_array v;
ap::real_1d_array work;
int vm;
ap::ap_error::make_assertion(ptrows<=n, "UnpackPTFromBidiagonal: PTRows>N!");
if( m==0||n==0||ptrows==0 )
{
return;
}
//
// init
//
pt.setbounds(1, ptrows, 1, n);
v.setbounds(1, n);
work.setbounds(1, ptrows);
//
// prepare PT
//
for(i = 1; i <= ptrows; i++)
{
for(j = 1; j <= n; j++)
{
if( i==j )
{
pt(i,j) = 1;
}
else
{
pt(i,j) = 0;
}
}
}
if( m>=n )
{
for(i = ap::minint(n-1, ptrows-1); i >= 1; i--)
{
vm = n-i;
ip1 = i+1;
ap::vmove(&v(1), &qp(i, ip1), ap::vlen(1,vm));
v(1) = 1;
applyreflectionfromtheright(pt, taup(i), v, 1, ptrows, i+1, n, work);
}
}
else
{
for(i = ap::minint(m, ptrows); i >= 1; i--)
{
vm = n-i+1;
ap::vmove(&v(1), &qp(i, i), ap::vlen(1,vm));
v(1) = 1;
applyreflectionfromtheright(pt, taup(i), v, 1, ptrows, i, n, work);
}
}
}
/*************************************************************************
Obsolete 1-based subroutine
*************************************************************************/
void unpackqfromtridiagonal(const ap::real_2d_array& a,
const int& n,
const bool& isupper,
const ap::real_1d_array& tau,
ap::real_2d_array& q)
{
int i;
int j;
int ip1;
int nmi;
ap::real_1d_array v;
ap::real_1d_array work;
if( n==0 )
{
return;
}
//
// init
//
q.setbounds(1, n, 1, n);
v.setbounds(1, n);
work.setbounds(1, n);
for(i = 1; i <= n; i++)
{
for(j = 1; j <= n; j++)
{
if( i==j )
{
q(i,j) = 1;
}
else
{
q(i,j) = 0;
}
}
}
//
// unpack Q
//
if( isupper )
{
for(i = 1; i <= n-1; i++)
{
//
// Apply H(i)
//
ip1 = i+1;
ap::vmove(v.getvector(1, i), a.getcolumn(ip1, 1, i));
v(i) = 1;
applyreflectionfromtheleft(q, tau(i), v, 1, i, 1, n, work);
}
}
else
{
for(i = n-1; i >= 1; i--)
{
//
// Apply H(i)
//
ip1 = i+1;
nmi = n-i;
ap::vmove(v.getvector(1, nmi), a.getcolumn(i, ip1, n));
v(1) = 1;
applyreflectionfromtheleft(q, tau(i), v, i+1, n, 1, n, work);
}
}
}
/*************************************************************************
Obsolete 1-based subroutine.
See RMatrixBDUnpackQ for 0-based replacement.
*************************************************************************/
void unpackqfrombidiagonal(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;
int ip1;
ap::real_1d_array v;
ap::real_1d_array work;
int vm;
ap::ap_error::make_assertion(qcolumns<=m, "UnpackQFromBidiagonal: QColumns>M!");
if( m==0||n==0||qcolumns==0 )
{
return;
}
//
// init
//
q.setbounds(1, m, 1, qcolumns);
v.setbounds(1, m);
work.setbounds(1, qcolumns);
//
// prepare Q
//
for(i = 1; i <= m; i++)
{
for(j = 1; j <= qcolumns; j++)
{
if( i==j )
{
q(i,j) = 1;
}
else
{
q(i,j) = 0;
}
}
}
if( m>=n )
{
for(i = ap::minint(n, qcolumns); i >= 1; i--)
{
vm = m-i+1;
ap::vmove(v.getvector(1, vm), qp.getcolumn(i, i, m));
v(1) = 1;
applyreflectionfromtheleft(q, tauq(i), v, i, m, 1, qcolumns, work);
}
}
else
{
for(i = ap::minint(m-1, qcolumns-1); i >= 1; i--)
{
vm = m-i;
ip1 = i+1;
ap::vmove(v.getvector(1, vm), qp.getcolumn(i, ip1, m));
v(1) = 1;
applyreflectionfromtheleft(q, tauq(i), v, i+1, m, 1, qcolumns, work);
}
}
}
/*************************************************************************
N-dimensional multiclass Fisher LDA
Subroutine finds coefficients of linear combinations which optimally separates
training set on classes. It returns N-dimensional basis whose vector are sorted
by quality of training set separation (in descending order).
INPUT PARAMETERS:
XY - training set, array[0..NPoints-1,0..NVars].
First NVars columns store values of independent
variables, next column stores number of class (from 0
to NClasses-1) which dataset element belongs to. Fractional
values are rounded to nearest integer.
NPoints - training set size, NPoints>=0
NVars - number of independent variables, NVars>=1
NClasses - number of classes, NClasses>=2
OUTPUT PARAMETERS:
Info - return code:
* -4, if internal EVD subroutine hasn't converged
* -2, if there is a point with class number
outside of [0..NClasses-1].
* -1, if incorrect parameters was passed (NPoints<0,
NVars<1, NClasses<2)
* 1, if task has been solved
* 2, if there was a multicollinearity in training set,
but task has been solved.
W - basis, array[0..NVars-1,0..NVars-1]
columns of matrix stores basis vectors, sorted by
quality of training set separation (in descending order)
-- ALGLIB --
Copyright 31.05.2008 by Bochkanov Sergey
*************************************************************************/
void fisherldan(const ap::real_2d_array& xy,
int npoints,
int nvars,
int nclasses,
int& info,
ap::real_2d_array& w)
{
int i;
int j;
int k;
int m;
double v;
ap::integer_1d_array c;
ap::real_1d_array mu;
ap::real_2d_array muc;
ap::integer_1d_array nc;
ap::real_2d_array sw;
ap::real_2d_array st;
ap::real_2d_array z;
ap::real_2d_array z2;
ap::real_2d_array tm;
ap::real_2d_array sbroot;
ap::real_2d_array a;
ap::real_2d_array xyproj;
ap::real_2d_array wproj;
ap::real_1d_array tf;
ap::real_1d_array d;
ap::real_1d_array d2;
ap::real_1d_array work;
//
// Test data
//
if( npoints<0||nvars<1||nclasses<2 )
{
info = -1;
return;
}
for(i = 0; i <= npoints-1; i++)
{
if( ap::round(xy(i,nvars))<0||ap::round(xy(i,nvars))>=nclasses )
{
info = -2;
return;
}
}
info = 1;
//
// Special case: NPoints<=1
// Degenerate task.
//
if( npoints<=1 )
{
info = 2;
w.setbounds(0, nvars-1, 0, nvars-1);
for(i = 0; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
if( i==j )
{
w(i,j) = 1;
}
else
{
w(i,j) = 0;
}
}
}
return;
}
//
// Prepare temporaries
//
tf.setbounds(0, nvars-1);
work.setbounds(1, ap::maxint(nvars, npoints));
//
// Convert class labels from reals to integers (just for convenience)
//
c.setbounds(0, npoints-1);
for(i = 0; i <= npoints-1; i++)
{
c(i) = ap::round(xy(i,nvars));
}
//
// Calculate class sizes and means
//
mu.setbounds(0, nvars-1);
muc.setbounds(0, nclasses-1, 0, nvars-1);
nc.setbounds(0, nclasses-1);
for(j = 0; j <= nvars-1; j++)
{
mu(j) = 0;
}
for(i = 0; i <= nclasses-1; i++)
{
nc(i) = 0;
for(j = 0; j <= nvars-1; j++)
{
muc(i,j) = 0;
}
}
for(i = 0; i <= npoints-1; i++)
{
ap::vadd(&mu(0), 1, &xy(i, 0), 1, ap::vlen(0,nvars-1));
ap::vadd(&muc(c(i), 0), 1, &xy(i, 0), 1, ap::vlen(0,nvars-1));
nc(c(i)) = nc(c(i))+1;
}
for(i = 0; i <= nclasses-1; i++)
{
v = double(1)/double(nc(i));
ap::vmul(&muc(i, 0), 1, ap::vlen(0,nvars-1), v);
}
v = double(1)/double(npoints);
ap::vmul(&mu(0), 1, ap::vlen(0,nvars-1), v);
//
// Create ST matrix
//
st.setbounds(0, nvars-1, 0, nvars-1);
for(i = 0; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
st(i,j) = 0;
}
}
for(k = 0; k <= npoints-1; k++)
{
ap::vmove(&tf(0), 1, &xy(k, 0), 1, ap::vlen(0,nvars-1));
ap::vsub(&tf(0), 1, &mu(0), 1, ap::vlen(0,nvars-1));
for(i = 0; i <= nvars-1; i++)
{
v = tf(i);
ap::vadd(&st(i, 0), 1, &tf(0), 1, ap::vlen(0,nvars-1), v);
}
}
//
// Create SW matrix
//
sw.setbounds(0, nvars-1, 0, nvars-1);
for(i = 0; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
sw(i,j) = 0;
}
}
for(k = 0; k <= npoints-1; k++)
{
ap::vmove(&tf(0), 1, &xy(k, 0), 1, ap::vlen(0,nvars-1));
ap::vsub(&tf(0), 1, &muc(c(k), 0), 1, ap::vlen(0,nvars-1));
for(i = 0; i <= nvars-1; i++)
{
v = tf(i);
ap::vadd(&sw(i, 0), 1, &tf(0), 1, ap::vlen(0,nvars-1), v);
}
}
//
// Maximize ratio J=(w'*ST*w)/(w'*SW*w).
//
// First, make transition from w to v such that w'*ST*w becomes v'*v:
// v = root(ST)*w = R*w
// R = root(D)*Z'
// w = (root(ST)^-1)*v = RI*v
// RI = Z*inv(root(D))
// J = (v'*v)/(v'*(RI'*SW*RI)*v)
// ST = Z*D*Z'
//
// so we have
//
// J = (v'*v) / (v'*(inv(root(D))*Z'*SW*Z*inv(root(D)))*v) =
// = (v'*v) / (v'*A*v)
//
if( !smatrixevd(st, nvars, 1, true, d, z) )
{
info = -4;
return;
}
w.setbounds(0, nvars-1, 0, nvars-1);
if( ap::fp_less_eq(d(nvars-1),0)||ap::fp_less_eq(d(0),1000*ap::machineepsilon*d(nvars-1)) )
{
//
// Special case: D[NVars-1]<=0
// Degenerate task (all variables takes the same value).
//
if( ap::fp_less_eq(d(nvars-1),0) )
{
info = 2;
for(i = 0; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
if( i==j )
{
w(i,j) = 1;
}
else
{
w(i,j) = 0;
}
}
}
return;
}
//
// Special case: degenerate ST matrix, multicollinearity found.
// Since we know ST eigenvalues/vectors we can translate task to
// non-degenerate form.
//
// Let WG is orthogonal basis of the non zero variance subspace
// of the ST and let WZ is orthogonal basis of the zero variance
// subspace.
//
// Projection on WG allows us to use LDA on reduced M-dimensional
// subspace, N-M vectors of WZ allows us to update reduced LDA
// factors to full N-dimensional subspace.
//
m = 0;
for(k = 0; k <= nvars-1; k++)
{
if( ap::fp_less_eq(d(k),1000*ap::machineepsilon*d(nvars-1)) )
{
m = k+1;
}
}
ap::ap_error::make_assertion(m!=0, "FisherLDAN: internal error #1");
xyproj.setbounds(0, npoints-1, 0, nvars-m);
matrixmatrixmultiply(xy, 0, npoints-1, 0, nvars-1, false, z, 0, nvars-1, m, nvars-1, false, 1.0, xyproj, 0, npoints-1, 0, nvars-m-1, 0.0, work);
for(i = 0; i <= npoints-1; i++)
{
xyproj(i,nvars-m) = xy(i,nvars);
}
fisherldan(xyproj, npoints, nvars-m, nclasses, info, wproj);
if( info<0 )
{
return;
}
matrixmatrixmultiply(z, 0, nvars-1, m, nvars-1, false, wproj, 0, nvars-m-1, 0, nvars-m-1, false, 1.0, w, 0, nvars-1, 0, nvars-m-1, 0.0, work);
for(k = nvars-m; k <= nvars-1; k++)
{
ap::vmove(&w(0, k), w.getstride(), &z(0, k-(nvars-m)), z.getstride(), ap::vlen(0,nvars-1));
}
info = 2;
}
else
{
//
// General case: no multicollinearity
//
tm.setbounds(0, nvars-1, 0, nvars-1);
a.setbounds(0, nvars-1, 0, nvars-1);
matrixmatrixmultiply(sw, 0, nvars-1, 0, nvars-1, false, z, 0, nvars-1, 0, nvars-1, false, 1.0, tm, 0, nvars-1, 0, nvars-1, 0.0, work);
matrixmatrixmultiply(z, 0, nvars-1, 0, nvars-1, true, tm, 0, nvars-1, 0, nvars-1, false, 1.0, a, 0, nvars-1, 0, nvars-1, 0.0, work);
for(i = 0; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
a(i,j) = a(i,j)/sqrt(d(i)*d(j));
}
}
if( !smatrixevd(a, nvars, 1, true, d2, z2) )
{
info = -4;
return;
}
for(k = 0; k <= nvars-1; k++)
{
for(i = 0; i <= nvars-1; i++)
{
tf(i) = z2(i,k)/sqrt(d(i));
}
for(i = 0; i <= nvars-1; i++)
{
v = ap::vdotproduct(&z(i, 0), 1, &tf(0), 1, ap::vlen(0,nvars-1));
w(i,k) = v;
}
}
}
//
// Post-processing:
// * normalization
// * converting to non-negative form, if possible
//
for(k = 0; k <= nvars-1; k++)
{
v = ap::vdotproduct(&w(0, k), w.getstride(), &w(0, k), w.getstride(), ap::vlen(0,nvars-1));
v = 1/sqrt(v);
ap::vmul(&w(0, k), w.getstride(), ap::vlen(0,nvars-1), v);
v = 0;
for(i = 0; i <= nvars-1; i++)
{
v = v+w(i,k);
}
if( ap::fp_less(v,0) )
{
ap::vmul(&w(0, k), w.getstride(), ap::vlen(0,nvars-1), -1);
}
}
}
/*************************************************************************
Principal components analysis
Subroutine builds orthogonal basis where first axis corresponds to
direction with maximum variance, second axis maximizes variance in subspace
orthogonal to first axis and so on.
It should be noted that, unlike LDA, PCA does not use class labels.
INPUT PARAMETERS:
X - dataset, array[0..NPoints-1,0..NVars-1].
matrix contains ONLY INDEPENDENT VARIABLES.
NPoints - dataset size, NPoints>=0
NVars - number of independent variables, NVars>=1
бшундмше оюпюлерпш:
Info - return code:
* -4, if SVD subroutine haven't converged
* -1, if wrong parameters has been passed (NPoints<0,
NVars<1)
* 1, if task is solved
S2 - array[0..NVars-1]. variance values corresponding
to basis vectors.
V - array[0..NVars-1,0..NVars-1]
matrix, whose columns store basis vectors.
-- ALGLIB --
Copyright 25.08.2008 by Bochkanov Sergey
*************************************************************************/
void pcabuildbasis(const ap::real_2d_array& x,
int npoints,
int nvars,
int& info,
ap::real_1d_array& s2,
ap::real_2d_array& v)
{
ap::real_2d_array a;
ap::real_2d_array u;
ap::real_2d_array vt;
ap::real_1d_array m;
ap::real_1d_array t;
int i;
int j;
double mean;
double variance;
double skewness;
double kurtosis;
//
// Check input data
//
if( npoints<0||nvars<1 )
{
info = -1;
return;
}
info = 1;
//
// Special case: NPoints=0
//
if( npoints==0 )
{
s2.setbounds(0, nvars-1);
v.setbounds(0, nvars-1, 0, nvars-1);
for(i = 0; i <= nvars-1; i++)
{
s2(i) = 0;
}
for(i = 0; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
if( i==j )
{
v(i,j) = 1;
}
else
{
v(i,j) = 0;
}
}
}
return;
}
//
// Calculate means
//
m.setbounds(0, nvars-1);
t.setbounds(0, npoints-1);
for(j = 0; j <= nvars-1; j++)
{
ap::vmove(t.getvector(0, npoints-1), x.getcolumn(j, 0, npoints-1));
calculatemoments(t, npoints, mean, variance, skewness, kurtosis);
m(j) = mean;
}
//
// Center, apply SVD, prepare output
//
a.setbounds(0, ap::maxint(npoints, nvars)-1, 0, nvars-1);
for(i = 0; i <= npoints-1; i++)
{
ap::vmove(&a(i, 0), &x(i, 0), ap::vlen(0,nvars-1));
ap::vsub(&a(i, 0), &m(0), ap::vlen(0,nvars-1));
}
for(i = npoints; i <= nvars-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
a(i,j) = 0;
}
}
if( !rmatrixsvd(a, ap::maxint(npoints, nvars), nvars, 0, 1, 2, s2, u, vt) )
{
info = -4;
return;
}
if( npoints!=1 )
{
for(i = 0; i <= nvars-1; i++)
{
s2(i) = ap::sqr(s2(i))/(npoints-1);
}
}
v.setbounds(0, nvars-1, 0, nvars-1);
copyandtranspose(vt, 0, nvars-1, 0, nvars-1, v, 0, nvars-1, 0, nvars-1);
}
/*************************************************************************
Singular value decomposition of a rectangular matrix.
The algorithm calculates the singular value decomposition of a matrix of
size MxN: A = U * S * V^T
The algorithm finds the singular values and, optionally, matrices U and V^T.
The algorithm can find both first min(M,N) columns of matrix U and rows of
matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM
and NxN respectively).
Take into account that the subroutine does not return matrix V but V^T.
Input parameters:
A - matrix to be decomposed.
Array whose indexes range within [0..M-1, 0..N-1].
M - number of rows in matrix A.
N - number of columns in matrix A.
UNeeded - 0, 1 or 2. See the description of the parameter U.
VTNeeded - 0, 1 or 2. See the description of the parameter VT.
AdditionalMemory -
If the parameter:
* equals 0, the algorithm doesn’t use additional
memory (lower requirements, lower performance).
* equals 1, the algorithm uses additional
memory of size min(M,N)*min(M,N) of real numbers.
It often speeds up the algorithm.
* equals 2, the algorithm uses additional
memory of size M*min(M,N) of real numbers.
It allows to get a maximum performance.
The recommended value of the parameter is 2.
Output parameters:
W - contains singular values in descending order.
U - if UNeeded=0, U isn't changed, the left singular vectors
are not calculated.
if Uneeded=1, U contains left singular vectors (first
min(M,N) columns of matrix U). Array whose indexes range
within [0..M-1, 0..Min(M,N)-1].
if UNeeded=2, U contains matrix U wholly. Array whose
indexes range within [0..M-1, 0..M-1].
VT - if VTNeeded=0, VT isn’t changed, the right singular vectors
are not calculated.
if VTNeeded=1, VT contains right singular vectors (first
min(M,N) rows of matrix V^T). Array whose indexes range
within [0..min(M,N)-1, 0..N-1].
if VTNeeded=2, VT contains matrix V^T wholly. Array whose
indexes range within [0..N-1, 0..N-1].
-- ALGLIB --
Copyright 2005 by Bochkanov Sergey
*************************************************************************/
bool rmatrixsvd(ap::real_2d_array a,
int m,
int n,
int uneeded,
int vtneeded,
int additionalmemory,
ap::real_1d_array& w,
ap::real_2d_array& u,
ap::real_2d_array& vt)
{
bool result;
ap::real_1d_array tauq;
ap::real_1d_array taup;
ap::real_1d_array tau;
ap::real_1d_array e;
ap::real_1d_array work;
ap::real_2d_array t2;
bool isupper;
int minmn;
int ncu;
int nrvt;
int nru;
int ncvt;
int i;
int j;
result = true;
if( m==0||n==0 )
{
return result;
}
ap::ap_error::make_assertion(uneeded>=0&&uneeded<=2, "SVDDecomposition: wrong parameters!");
ap::ap_error::make_assertion(vtneeded>=0&&vtneeded<=2, "SVDDecomposition: wrong parameters!");
ap::ap_error::make_assertion(additionalmemory>=0&&additionalmemory<=2, "SVDDecomposition: wrong parameters!");
//
// initialize
//
minmn = ap::minint(m, n);
w.setbounds(1, minmn);
ncu = 0;
nru = 0;
if( uneeded==1 )
{
nru = m;
ncu = minmn;
u.setbounds(0, nru-1, 0, ncu-1);
}
if( uneeded==2 )
{
nru = m;
ncu = m;
u.setbounds(0, nru-1, 0, ncu-1);
}
nrvt = 0;
ncvt = 0;
if( vtneeded==1 )
{
nrvt = minmn;
ncvt = n;
vt.setbounds(0, nrvt-1, 0, ncvt-1);
}
if( vtneeded==2 )
{
nrvt = n;
ncvt = n;
vt.setbounds(0, nrvt-1, 0, ncvt-1);
}
//
// M much larger than N
// Use bidiagonal reduction with QR-decomposition
//
if( ap::fp_greater(m,1.6*n) )
{
if( uneeded==0 )
{
//
// No left singular vectors to be computed
//
rmatrixqr(a, m, n, tau);
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= i-1; j++)
{
a(i,j) = 0;
}
}
rmatrixbd(a, n, n, tauq, taup);
rmatrixbdunpackpt(a, n, n, taup, nrvt, vt);
rmatrixbdunpackdiagonals(a, n, n, isupper, w, e);
result = rmatrixbdsvd(w, e, n, isupper, false, u, 0, a, 0, vt, ncvt);
return result;
}
else
{
//
// Left singular vectors (may be full matrix U) to be computed
//
rmatrixqr(a, m, n, tau);
rmatrixqrunpackq(a, m, n, tau, ncu, u);
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= i-1; j++)
{
a(i,j) = 0;
}
}
rmatrixbd(a, n, n, tauq, taup);
rmatrixbdunpackpt(a, n, n, taup, nrvt, vt);
rmatrixbdunpackdiagonals(a, n, n, isupper, w, e);
if( additionalmemory<1 )
{
//
// No additional memory can be used
//
rmatrixbdmultiplybyq(a, n, n, tauq, u, m, n, true, false);
result = rmatrixbdsvd(w, e, n, isupper, false, u, m, a, 0, vt, ncvt);
}
else
{
//
// Large U. Transforming intermediate matrix T2
//
work.setbounds(1, ap::maxint(m, n));
rmatrixbdunpackq(a, n, n, tauq, n, t2);
copymatrix(u, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1);
inplacetranspose(t2, 0, n-1, 0, n-1, work);
result = rmatrixbdsvd(w, e, n, isupper, false, u, 0, t2, n, vt, ncvt);
matrixmatrixmultiply(a, 0, m-1, 0, n-1, false, t2, 0, n-1, 0, n-1, true, 1.0, u, 0, m-1, 0, n-1, 0.0, work);
}
return result;
}
}
//
// N much larger than M
// Use bidiagonal reduction with LQ-decomposition
//
if( ap::fp_greater(n,1.6*m) )
{
if( vtneeded==0 )
{
//
// No right singular vectors to be computed
//
rmatrixlq(a, m, n, tau);
for(i = 0; i <= m-1; i++)
{
for(j = i+1; j <= m-1; j++)
{
a(i,j) = 0;
}
}
rmatrixbd(a, m, m, tauq, taup);
rmatrixbdunpackq(a, m, m, tauq, ncu, u);
rmatrixbdunpackdiagonals(a, m, m, isupper, w, e);
work.setbounds(1, m);
inplacetranspose(u, 0, nru-1, 0, ncu-1, work);
result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, vt, 0);
inplacetranspose(u, 0, nru-1, 0, ncu-1, work);
return result;
}
else
{
//
// Right singular vectors (may be full matrix VT) to be computed
//
rmatrixlq(a, m, n, tau);
rmatrixlqunpackq(a, m, n, tau, nrvt, vt);
for(i = 0; i <= m-1; i++)
{
for(j = i+1; j <= m-1; j++)
{
a(i,j) = 0;
}
}
rmatrixbd(a, m, m, tauq, taup);
rmatrixbdunpackq(a, m, m, tauq, ncu, u);
rmatrixbdunpackdiagonals(a, m, m, isupper, w, e);
work.setbounds(1, ap::maxint(m, n));
inplacetranspose(u, 0, nru-1, 0, ncu-1, work);
if( additionalmemory<1 )
{
//
// No additional memory available
//
rmatrixbdmultiplybyp(a, m, m, taup, vt, m, n, false, true);
result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, vt, n);
}
else
{
//
// Large VT. Transforming intermediate matrix T2
//
rmatrixbdunpackpt(a, m, m, taup, m, t2);
result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, t2, m);
copymatrix(vt, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1);
matrixmatrixmultiply(t2, 0, m-1, 0, m-1, false, a, 0, m-1, 0, n-1, false, 1.0, vt, 0, m-1, 0, n-1, 0.0, work);
}
inplacetranspose(u, 0, nru-1, 0, ncu-1, work);
return result;
}
}
//
// M<=N
// We can use inplace transposition of U to get rid of columnwise operations
//
if( m<=n )
{
rmatrixbd(a, m, n, tauq, taup);
rmatrixbdunpackq(a, m, n, tauq, ncu, u);
rmatrixbdunpackpt(a, m, n, taup, nrvt, vt);
rmatrixbdunpackdiagonals(a, m, n, isupper, w, e);
work.setbounds(1, m);
inplacetranspose(u, 0, nru-1, 0, ncu-1, work);
result = rmatrixbdsvd(w, e, minmn, isupper, false, a, 0, u, nru, vt, ncvt);
inplacetranspose(u, 0, nru-1, 0, ncu-1, work);
return result;
}
//
// Simple bidiagonal reduction
//
rmatrixbd(a, m, n, tauq, taup);
rmatrixbdunpackq(a, m, n, tauq, ncu, u);
rmatrixbdunpackpt(a, m, n, taup, nrvt, vt);
rmatrixbdunpackdiagonals(a, m, n, isupper, w, e);
if( additionalmemory<2||uneeded==0 )
{
//
// We cant use additional memory or there is no need in such operations
//
result = rmatrixbdsvd(w, e, minmn, isupper, false, u, nru, a, 0, vt, ncvt);
}
else
{
//
// We can use additional memory
//
t2.setbounds(0, minmn-1, 0, m-1);
copyandtranspose(u, 0, m-1, 0, minmn-1, t2, 0, minmn-1, 0, m-1);
result = rmatrixbdsvd(w, e, minmn, isupper, false, u, 0, t2, m, vt, ncvt);
copyandtranspose(t2, 0, minmn-1, 0, m-1, u, 0, m-1, 0, minmn-1);
}
return result;
}
/*************************************************************************
Unsets 2D array.
*************************************************************************/
static void unset2d(ap::real_2d_array& a)
{
a.setbounds(0, 0, 0, 0);
a(0,0) = 2*ap::randomreal()-1;
}
/*************************************************************************
k-means++ clusterization
INPUT PARAMETERS:
XY - dataset, array [0..NPoints-1,0..NVars-1].
NPoints - dataset size, NPoints>=K
NVars - number of variables, NVars>=1
K - desired number of clusters, K>=1
Restarts - number of restarts, Restarts>=1
OUTPUT PARAMETERS:
Info - return code:
* -3, if taskis degenerate (number of distinct points is
less than K)
* -1, if incorrect NPoints/NFeatures/K/Restarts was passed
* 1, if subroutine finished successfully
C - array[0..NVars-1,0..K-1].matrix whose columns store
cluster's centers
XYC - array which contains number of clusters dataset points
belong to.
-- ALGLIB --
Copyright 21.03.2009 by Bochkanov Sergey
*************************************************************************/
void kmeansgenerate(const ap::real_2d_array& xy,
int npoints,
int nvars,
int k,
int restarts,
int& info,
ap::real_2d_array& c,
ap::integer_1d_array& xyc)
{
int i;
int j;
ap::real_2d_array ct;
ap::real_2d_array ctbest;
double e;
double ebest;
ap::real_1d_array x;
ap::real_1d_array tmp;
int cc;
ap::real_1d_array d2;
ap::real_1d_array p;
ap::integer_1d_array csizes;
ap::boolean_1d_array cbusy;
double v;
double s;
int cclosest;
double dclosest;
ap::real_1d_array work;
bool waschanges;
bool zerosizeclusters;
int pass;
//
// Test parameters
//
if( npoints<k||nvars<1||k<1||restarts<1 )
{
info = -1;
return;
}
//
// TODO: special case K=1
// TODO: special case K=NPoints
//
info = 1;
//
// Multiple passes of k-means++ algorithm
//
ct.setbounds(0, k-1, 0, nvars-1);
ctbest.setbounds(0, k-1, 0, nvars-1);
xyc.setbounds(0, npoints-1);
d2.setbounds(0, npoints-1);
p.setbounds(0, npoints-1);
tmp.setbounds(0, nvars-1);
csizes.setbounds(0, k-1);
cbusy.setbounds(0, k-1);
ebest = ap::maxrealnumber;
for(pass = 1; pass <= restarts; pass++)
{
//
// Select initial centers using k-means++ algorithm
// 1. Choose first center at random
// 2. Choose next centers using their distance from centers already chosen
//
// Note that for performance reasons centers are stored in ROWS of CT, not
// in columns. We'll transpose CT in the end and store it in the C.
//
i = ap::randominteger(npoints);
ap::vmove(&ct(0, 0), &xy(i, 0), ap::vlen(0,nvars-1));
cbusy(0) = true;
for(i = 1; i <= k-1; i++)
{
cbusy(i) = false;
}
if( !selectcenterpp(xy, npoints, nvars, ct, cbusy, k, d2, p, tmp) )
{
info = -3;
return;
}
//
// Update centers:
// 2. update center positions
//
while(true)
{
//
// fill XYC with center numbers
//
waschanges = false;
for(i = 0; i <= npoints-1; i++)
{
cclosest = -1;
dclosest = ap::maxrealnumber;
for(j = 0; j <= k-1; j++)
{
ap::vmove(&tmp(0), &xy(i, 0), ap::vlen(0,nvars-1));
ap::vsub(&tmp(0), &ct(j, 0), ap::vlen(0,nvars-1));
v = ap::vdotproduct(&tmp(0), &tmp(0), ap::vlen(0,nvars-1));
if( v<dclosest )
{
cclosest = j;
dclosest = v;
}
}
if( xyc(i)!=cclosest )
{
waschanges = true;
}
xyc(i) = cclosest;
}
//
// Update centers
//
for(j = 0; j <= k-1; j++)
{
csizes(j) = 0;
}
for(i = 0; i <= k-1; i++)
{
for(j = 0; j <= nvars-1; j++)
{
ct(i,j) = 0;
}
}
for(i = 0; i <= npoints-1; i++)
{
csizes(xyc(i)) = csizes(xyc(i))+1;
ap::vadd(&ct(xyc(i), 0), &xy(i, 0), ap::vlen(0,nvars-1));
}
zerosizeclusters = false;
for(i = 0; i <= k-1; i++)
{
cbusy(i) = csizes(i)!=0;
zerosizeclusters = zerosizeclusters||csizes(i)==0;
}
if( zerosizeclusters )
{
//
// Some clusters have zero size - rare, but possible.
// We'll choose new centers for such clusters using k-means++ rule
// and restart algorithm
//
if( !selectcenterpp(xy, npoints, nvars, ct, cbusy, k, d2, p, tmp) )
{
info = -3;
return;
}
continue;
}
for(j = 0; j <= k-1; j++)
{
v = double(1)/double(csizes(j));
ap::vmul(&ct(j, 0), ap::vlen(0,nvars-1), v);
}
//
// if nothing has changed during iteration
//
if( !waschanges )
{
break;
}
}
//
// 3. Calculate E, compare with best centers found so far
//
e = 0;
for(i = 0; i <= npoints-1; i++)
{
ap::vmove(&tmp(0), &xy(i, 0), ap::vlen(0,nvars-1));
ap::vsub(&tmp(0), &ct(xyc(i), 0), ap::vlen(0,nvars-1));
v = ap::vdotproduct(&tmp(0), &tmp(0), ap::vlen(0,nvars-1));
e = e+v;
}
if( e<ebest )
{
//
// store partition
//
copymatrix(ct, 0, k-1, 0, nvars-1, ctbest, 0, k-1, 0, nvars-1);
}
}
//
// Copy and transpose
//
c.setbounds(0, nvars-1, 0, k-1);
copyandtranspose(ctbest, 0, k-1, 0, nvars-1, c, 0, nvars-1, 0, k-1);
}
/*************************************************************************
Reference EVD
*************************************************************************/
static bool refevd(const ap::real_1d_array& d,
const ap::real_1d_array& e,
int n,
ap::real_1d_array& lambda,
ap::real_2d_array& z)
{
bool result;
ap::real_2d_array z1;
ap::real_1d_array d1;
ap::real_1d_array e1;
int i;
int j;
int k;
double v;
z1.setbounds(1, n, 1, n);
for(i = 1; i <= n; i++)
{
for(j = 1; j <= n; j++)
{
z1(i,j) = 0;
}
}
for(i = 1; i <= n; i++)
{
z1(i,i) = 1;
}
d1.setbounds(1, n);
for(i = 1; i <= n; i++)
{
d1(i) = d(i-1);
}
e1.setbounds(1, n);
for(i = 2; i <= n; i++)
{
e1(i) = e(i-2);
}
result = tdbitridiagonalqlieigenvaluesandvectors(d1, e1, n, z1);
if( result )
{
//
// copy
//
lambda.setbounds(0, n-1);
for(i = 0; i <= n-1; i++)
{
lambda(i) = d1(i+1);
}
z.setbounds(0, n-1, 0, n-1);
for(i = 0; i <= n-1; i++)
{
for(j = 0; j <= n-1; j++)
{
z(i,j) = z1(i+1,j+1);
}
}
//
// Use Selection Sort to minimize swaps of eigenvectors
//
for(i = 0; i <= n-2; i++)
{
k = i;
for(j = i+1; j <= n-1; j++)
{
if( lambda(j)<lambda(k) )
{
k = j;
}
}
if( k!=i )
{
v = lambda(i);
lambda(i) = lambda(k);
lambda(k) = v;
for(j = 0; j <= n-1; j++)
{
v = z(j,i);
z(j,i) = z(j,k);
z(j,k) = v;
}
}
}
}
return result;
}