/*************************************************************************
Subroutine prepares K-fold split of the training set.
NOTES:
"NClasses>0" means that we have classification task.
"NClasses<0" means regression task with -NClasses real outputs.
*************************************************************************/
static void mlpkfoldsplit(const ap::real_2d_array& xy,
int npoints,
int nclasses,
int foldscount,
bool stratifiedsplits,
ap::integer_1d_array& folds)
{
int i;
int j;
int k;
//
// test parameters
//
ap::ap_error::make_assertion(npoints>0, "MLPKFoldSplit: wrong NPoints!");
ap::ap_error::make_assertion(nclasses>1||nclasses<0, "MLPKFoldSplit: wrong NClasses!");
ap::ap_error::make_assertion(foldscount>=2&&foldscount<=npoints, "MLPKFoldSplit: wrong FoldsCount!");
ap::ap_error::make_assertion(!stratifiedsplits, "MLPKFoldSplit: stratified splits are not supported!");
//
// Folds
//
folds.setbounds(0, npoints-1);
for(i = 0; i <= npoints-1; i++)
{
folds(i) = i*foldscount/npoints;
}
for(i = 0; i <= npoints-2; i++)
{
j = i+ap::randominteger(npoints-i);
if( j!=i )
{
k = folds(i);
folds(i) = folds(j);
folds(j) = k;
}
}
}
/*************************************************************************
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);
}
}
}
}
void tagsort(ap::real_1d_array& a,
int n,
ap::integer_1d_array& p1,
ap::integer_1d_array& p2)
{
int i;
int j;
int k;
int t;
double tmp;
int tmpi;
ap::integer_1d_array pv;
ap::integer_1d_array vp;
int lv;
int lp;
int rv;
int rp;
//
// Special cases
//
if( n<=0 )
{
return;
}
if( n==1 )
{
p1.setbounds(0, 0);
p2.setbounds(0, 0);
p1(0) = 0;
p2(0) = 0;
return;
}
//
// General case, N>1: prepare permutations table P1
//
p1.setbounds(0, n-1);
for(i = 0; i <= n-1; i++)
{
p1(i) = i;
}
//
// General case, N>1: sort, update P1
//
tagsortfasti(a, p1, n);
//
// General case, N>1: fill permutations table P2
//
// To fill P2 we maintain two arrays:
// * PV, Position(Value). PV[i] contains position of I-th key at the moment
// * VP, Value(Position). VP[i] contains key which has position I at the moment
//
// At each step we making permutation of two items:
// Left, which is given by position/value pair LP/LV
// and Right, which is given by RP/RV
// and updating PV[] and VP[] correspondingly.
//
pv.setbounds(0, n-1);
vp.setbounds(0, n-1);
p2.setbounds(0, n-1);
for(i = 0; i <= n-1; i++)
{
pv(i) = i;
vp(i) = i;
}
for(i = 0; i <= n-1; i++)
{
//
// calculate LP, LV, RP, RV
//
lp = i;
lv = vp(lp);
rv = p1(i);
rp = pv(rv);
//
// Fill P2
//
p2(i) = rp;
//
// update PV and VP
//
vp(lp) = rv;
vp(rp) = lv;
pv(lv) = rp;
pv(rv) = lp;
}
}
/*************************************************************************
Matrix norm estimation
The algorithm estimates the 1-norm of square matrix A on the assumption
that the multiplication of matrix A by the vector is available (the
iterative method is used). It is recommended to use this algorithm if it
is hard to calculate matrix elements explicitly (for example, when
estimating the inverse matrix norm).
The algorithm uses back communication for multiplying the vector by the
matrix. If KASE=0 after returning from a subroutine, its execution was
completed successfully, otherwise it is required to multiply the returned
vector by matrix A and call the subroutine again.
The DemoIterativeEstimateNorm subroutine shows a simple example.
Parameters:
N - size of matrix A.
V - vector. It is initialized by the subroutine on the first
call. It is then passed into it on repeated calls.
X - if KASE<>0, it contains the vector to be replaced by:
A * X, if KASE=1
A^T * X, if KASE=2
Array whose index ranges within [1..N].
ISGN - vector. It is initialized by the subroutine on the first
call. It is then passed into it on repeated calls.
EST - if KASE=0, it contains the lower boundary of the matrix
norm estimate.
KASE - on the first call, it should be equal to 0. After the last
return, it is equal to 0 (EST contains the matrix norm),
on intermediate returns it can be equal to 1 or 2 depending
on the operation to be performed on vector X.
-- LAPACK auxiliary routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
*************************************************************************/
void iterativeestimate1norm(int n,
ap::real_1d_array& v,
ap::real_1d_array& x,
ap::integer_1d_array& isgn,
double& est,
int& kase)
{
int itmax;
int i;
double t;
bool flg;
int positer;
int posj;
int posjlast;
int posjump;
int posaltsgn;
int posestold;
int postemp;
itmax = 5;
posaltsgn = n+1;
posestold = n+2;
postemp = n+3;
positer = n+1;
posj = n+2;
posjlast = n+3;
posjump = n+4;
if( kase==0 )
{
v.setbounds(1, n+3);
x.setbounds(1, n);
isgn.setbounds(1, n+4);
t = double(1)/double(n);
for(i = 1; i <= n; i++)
{
x(i) = t;
}
kase = 1;
isgn(posjump) = 1;
return;
}
//
// ................ ENTRY (JUMP = 1)
// FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
//
if( isgn(posjump)==1 )
{
if( n==1 )
{
v(1) = x(1);
est = fabs(v(1));
kase = 0;
return;
}
est = 0;
for(i = 1; i <= n; i++)
{
est = est+fabs(x(i));
}
for(i = 1; i <= n; i++)
{
if( ap::fp_greater_eq(x(i),0) )
{
x(i) = 1;
}
else
{
x(i) = -1;
}
isgn(i) = ap::sign(x(i));
}
kase = 2;
isgn(posjump) = 2;
return;
}
//
// ................ ENTRY (JUMP = 2)
// FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X.
//
if( isgn(posjump)==2 )
{
isgn(posj) = 1;
for(i = 2; i <= n; i++)
{
if( ap::fp_greater(fabs(x(i)),fabs(x(isgn(posj)))) )
{
isgn(posj) = i;
}
}
isgn(positer) = 2;
//
// MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
//
for(i = 1; i <= n; i++)
{
x(i) = 0;
}
x(isgn(posj)) = 1;
kase = 1;
isgn(posjump) = 3;
return;
}
//
// ................ ENTRY (JUMP = 3)
// X HAS BEEN OVERWRITTEN BY A*X.
//
if( isgn(posjump)==3 )
{
ap::vmove(&v(1), 1, &x(1), 1, ap::vlen(1,n));
v(posestold) = est;
est = 0;
for(i = 1; i <= n; i++)
{
est = est+fabs(v(i));
}
flg = false;
for(i = 1; i <= n; i++)
{
if( ap::fp_greater_eq(x(i),0)&&isgn(i)<0||ap::fp_less(x(i),0)&&isgn(i)>=0 )
{
flg = true;
}
}
//
// REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
// OR MAY BE CYCLING.
//
if( !flg||ap::fp_less_eq(est,v(posestold)) )
{
v(posaltsgn) = 1;
for(i = 1; i <= n; i++)
{
x(i) = v(posaltsgn)*(1+double(i-1)/double(n-1));
v(posaltsgn) = -v(posaltsgn);
}
kase = 1;
isgn(posjump) = 5;
return;
}
for(i = 1; i <= n; i++)
{
if( ap::fp_greater_eq(x(i),0) )
{
x(i) = 1;
isgn(i) = 1;
}
else
{
x(i) = -1;
isgn(i) = -1;
}
}
kase = 2;
isgn(posjump) = 4;
return;
}
//
// ................ ENTRY (JUMP = 4)
// X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X.
//
if( isgn(posjump)==4 )
{
isgn(posjlast) = isgn(posj);
isgn(posj) = 1;
for(i = 2; i <= n; i++)
{
if( ap::fp_greater(fabs(x(i)),fabs(x(isgn(posj)))) )
{
isgn(posj) = i;
}
}
if( ap::fp_neq(x(isgn(posjlast)),fabs(x(isgn(posj))))&&isgn(positer)<itmax )
{
isgn(positer) = isgn(positer)+1;
for(i = 1; i <= n; i++)
{
x(i) = 0;
}
x(isgn(posj)) = 1;
kase = 1;
isgn(posjump) = 3;
return;
}
//
// ITERATION COMPLETE. FINAL STAGE.
//
v(posaltsgn) = 1;
for(i = 1; i <= n; i++)
{
x(i) = v(posaltsgn)*(1+double(i-1)/double(n-1));
v(posaltsgn) = -v(posaltsgn);
}
kase = 1;
isgn(posjump) = 5;
return;
}
//
// ................ ENTRY (JUMP = 5)
// X HAS BEEN OVERWRITTEN BY A*X.
//
if( isgn(posjump)==5 )
{
v(postemp) = 0;
for(i = 1; i <= n; i++)
{
v(postemp) = v(postemp)+fabs(x(i));
}
v(postemp) = 2*v(postemp)/(3*n);
if( ap::fp_greater(v(postemp),est) )
{
ap::vmove(&v(1), 1, &x(1), 1, ap::vlen(1,n));
est = v(postemp);
}
kase = 0;
return;
}
}
/*************************************************************************
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);
}
/*************************************************************************
Unsets 1D array.
*************************************************************************/
static void unset1di(ap::integer_1d_array& a)
{
a.setbounds(0, 0);
a(0) = ap::randominteger(3)-1;
}
/*************************************************************************
LU decomposition of a complex general matrix of size MxN
The subroutine calculates the LU decomposition of a rectangular general
matrix with partial pivoting (with row permutations).
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 L and U in compact form (see below).
Array whose indexes range within [0..M-1, 0..N-1].
Pivots - permutation matrix in compact form (see below).
Array whose index ranges within [0..Min(M-1,N-1)].
Matrix A is represented as A = P * L * U, where P is a permutation matrix,
matrix L - lower triangular (or lower trapezoid, if M>N) matrix,
U - upper triangular (or upper trapezoid, if M<N) matrix.
Let M be equal to 4 and N be equal to 3:
( 1 ) ( U11 U12 U13 )
A = P1 * P2 * P3 * ( L21 1 ) * ( U22 U23 )
( L31 L32 1 ) ( U33 )
( L41 L42 L43 )
Matrix L has size MxMin(M,N), matrix U has size Min(M,N)xN, matrix P(i) is
a permutation of the identity matrix of size MxM with numbers I and Pivots[I].
The algorithm returns array Pivots and the following matrix which replaces
matrix A and contains matrices L and U in compact form (the example applies
to M=4, N=3).
( U11 U12 U13 )
( L21 U22 U23 )
( L31 L32 U33 )
( L41 L42 L43 )
As we can see, the unit diagonal isn't stored.
-- 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 cmatrixlu(ap::complex_2d_array& a,
int m,
int n,
ap::integer_1d_array& pivots)
{
int i;
int j;
int jp;
ap::complex_1d_array t1;
ap::complex s;
int i_;
pivots.setbounds(0, ap::minint(m-1, n-1));
t1.setbounds(0, ap::maxint(m-1, n-1));
ap::ap_error::make_assertion(m>=0&&n>=0, "Error in LUDecomposition: incorrect function arguments");
//
// Quick return if possible
//
if( m==0||n==0 )
{
return;
}
for(j = 0; j <= ap::minint(m-1, n-1); j++)
{
//
// Find pivot and test for singularity.
//
jp = j;
for(i = j+1; i <= m-1; i++)
{
if( ap::fp_greater(ap::abscomplex(a(i,j)),ap::abscomplex(a(jp,j))) )
{
jp = i;
}
}
pivots(j) = jp;
if( a(jp,j)!=0 )
{
//
//Apply the interchange to rows
//
if( jp!=j )
{
for(i_=0; i_<=n-1;i_++)
{
t1(i_) = a(j,i_);
}
for(i_=0; i_<=n-1;i_++)
{
a(j,i_) = a(jp,i_);
}
for(i_=0; i_<=n-1;i_++)
{
a(jp,i_) = t1(i_);
}
}
//
//Compute elements J+1:M of J-th column.
//
if( j<m )
{
jp = j+1;
s = 1/a(j,j);
for(i_=jp; i_<=m-1;i_++)
{
a(i_,j) = s*a(i_,j);
}
}
}
if( j<ap::minint(m, n)-1 )
{
//
//Update trailing submatrix.
//
jp = j+1;
for(i = j+1; i <= m-1; i++)
{
s = a(i,j);
for(i_=jp; i_<=n-1;i_++)
{
a(i,i_) = a(i,i_) - s*a(j,i_);
}
}
}
}
}
