int main ( )
/******************************************************************************/
/*
Purpose:
MAIN is the main program for RECTANGLE.
Discussion:
This driver computes the interpolation of the Franke function
on the rectangle R(A,B) = [A1,B1] x [A2,B2] with A=(A1,A2)=(0,0)
and B=(B1,B2)=(1,1) (unit square) at the FAMILY = 1 of Padua points.
The degree of interpolation is DEG = 60 and the number of target
points is NTG = NTG1^2, NTG1 = 100.
The maps from the reference square [-1,1]^2 to the rectangle
are SIGMA1 and SIGMA2 with inverses ISIGM1 and ISIGM2.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
16 February 2014
Author:
Original FORTRAN77 version by Marco Caliari, Stefano De Marchi,
Marco Vianello.
This C version by John Burkardt.
Reference:
Marco Caliari, Stefano de Marchi, Marco Vianello,
Algorithm 886:
Padua2D: Lagrange Interpolation at Padua Points on Bivariate Domains,
ACM Transactions on Mathematical Software,
Volume 35, Number 3, October 2008, Article 21, 11 pages.
Parameters:
Local, int DEGMAX, the maximum degree of interpolation.
Local, int NPDMAX, the maximum number of Padua points
= (DEGMAX + 1) * (DEGMAX + 2) / 2.
Local, int NTG1MX, the maximum value of the parameter determining
the number of target points.
Local, int NTGMAX, the maximum number of target points,
dependent on NTG1MX.
Local, int DEG, the degree of interpolation,
Local, int NTG1, the parameter determining the number
of target points.
Local, int FAMILY, specifies the desired family of Padua points.
Local, int NPD, the number of Padua points = (DEG + 1) * (DEG + 2) / 2.
Local, int NTG, the number of target points, dependent on NTG1.
Local, double PD1[NPDMAX], the first coordinates of
the Padua points.
Local, double PD2[NPDMAX], the second coordinates of the
Padua points.
Local, double WPD[NPDMAX], the weights.
Local, double FPD[NPDMAX], the function at the Padua points.
Workspace, double RAUX1[(DEGMAX+1)*(DEGMAX+2)].
Workspace, double RAUX2[(DEGMAX+1)*(DEGMAX+2)].
Local, double C0[(0:DEGMAX+1)*(0:DEGMAX+1)], the coefficient matrix.
Local, double TG1[NTGMAX], the first coordinates of the
target points.
Local, double TG2[NTGMAX], the second coordinates of the
target points.
Local, double INTFTG[NTGMAX], the values of the
interpolated function.
Local, double MAXERR, the maximum norm of the error at target
points.
Local, double ESTERR, the estimated error.
*/
{
# define DEGMAX 60
# define NTG1MX 100
# define NPDMAX ( ( DEGMAX + 1 ) * ( DEGMAX + 2 ) / 2 )
# define NTGMAX ( NTG1MX * NTG1MX )
double a1;
double a2;
double b1;
double b2;
double c0[(DEGMAX+2)*(DEGMAX+2)];
int deg;
int degmax = DEGMAX;
double esterr;
int family;
char filename[255];
double fmax;
double fmin;
double fpd[NPDMAX];
double fxy;
int i;
double intftg[NTGMAX];
double ixy;
double maxdev;
double maxerr;
double mean;
int npd;
int npdmax = NPDMAX;
int ntg;
int ntg1;
int ntg1mx = NTG1MX;
int ntgmax = NTGMAX;
FILE *output;
double pd1[NPDMAX];
double pd2[NPDMAX];
double raux1[(DEGMAX+1)*(DEGMAX+2)];
double raux2[(DEGMAX+1)*(DEGMAX+2)];
double tg1[NTGMAX];
double tg2[NTGMAX];
double wpd[NPDMAX];
double x;
double y;
a1 = 0.0;
a2 = 0.0;
b1 = 1.0;
b2 = 1.0;
family = 1;
deg = 60;
ntg1 = 100;
timestamp ( );
printf ( "\n" );
printf ( "RECTANGLE:\n" );
printf ( " C version\n" );
printf ( " Interpolation of the Franke function\n" );
printf ( " on the unit square [0,1] x [0,1]\n" );
printf ( " of degree = %d\n", deg );
if ( degmax < deg )
{
fprintf ( stderr, "\n" );
fprintf ( stderr, "RECTANGLE - Fatal error!\n" );
fprintf ( stderr, " DEGMAX < DEG.\n" );
fprintf ( stderr, " DEG = %d\n", deg );
fprintf ( stderr, " DEGMAX = %d\n", degmax );
exit ( 1 );
}
/*
Build the first family of Padua points in the square [-1,1]^2
*/
pdpts ( deg, pd1, pd2, wpd, &npd );
/*
Compute the Franke function at Padua points mapped to the region.
*/
for ( i = 0; i < npd; i++ )
{
x = sigma1 ( pd1[i], pd2[i], a1, a2, b1, b2, family, deg );
y = sigma2 ( pd1[i], pd2[i], a1, a2, b1, b2, family, deg );
fpd[i] = franke ( x, y );
}
/*
Write X, Y, F(X,Y) to a file.
*/
strcpy ( filename, "rectangle_fpd.txt" );
output = fopen ( filename, "wt" );
for ( i = 0; i < npd; i++ )
{
x = sigma1 ( pd1[i], pd2[i], a1, a2, b1, b2, family, deg );
y = sigma2 ( pd1[i], pd2[i], a1, a2, b1, b2, family, deg );
fprintf ( output, "%g %g %g\n", x, y, fpd[i] );
}
fclose ( output );
printf ( "\n" );
printf ( " Wrote F(x,y) at Padua points in '%s'\n", filename );
/*
Compute the matrix C0 of the coefficients in the bivariate
orthonormal Chebyshev basis
*/
padua2 ( deg, degmax, npd, wpd, fpd, raux1, raux2, c0, &esterr );
/*
Evaluate the target points in the region.
*/
target ( a1, b1, a2, b2, ntg1, ntgmax, tg1, tg2, &ntg );
/*
Evaluate the interpolant at the target points.
*/
for ( i = 0; i < ntg; i++ )
{
x = isigm1 ( tg1[i], tg2[i], a1, a2, b1, b2, family, deg );
y = isigm2 ( tg1[i], tg2[i], a1, a2, b1, b2, family, deg );
intftg[i] = pd2val ( deg, degmax, c0, x, y );
}
/*
Write the function value at target points to a file.
*/
strcpy ( filename, "rectangle_ftg.txt" );
output = fopen ( filename, "wt" );
for ( i = 0; i < ntg; i++ )
{
fprintf ( output, "%g %g %g\n",
tg1[i], tg2[i], franke ( tg1[i], tg2[i] ) );
}
fclose ( output );
printf ( " Wrote F(x,y) at target points in '%s'\n", filename );
/*
Write the interpolated function value at target points to a file.
*/
strcpy ( filename, "ellipse_itg.txt" );
output = fopen ( filename, "wt" );
for ( i = 0; i < ntg; i++ )
{
fprintf ( output, "%g %g %g\n", tg1[i], tg2[i], intftg[i] );
}
fclose ( output );
printf ( " Wrote I(F)(x,y) at target points in '%s'\n", filename );
/*
Compute the error relative to the max deviation from the mean.
*/
maxerr = 0.0;
mean = 0.0;
fmax = - r8_huge ( );
fmin = + r8_huge ( );
for ( i = 0; i < ntg; i++ )
{
fxy = franke ( tg1[i], tg2[i] );
ixy = intftg[i];
maxerr = r8_max ( maxerr, fabs ( fxy - ixy ) );
mean = mean + fxy;
fmax = r8_max ( fmax, fxy );
fmin = r8_min ( fmin, fxy );
}
if ( fmax == fmin )
{
maxdev = 1.0;
}
else
{
mean = mean / ( double ) ( ntg );
maxdev = r8_max ( fmax - mean, mean - fmin );
}
/*
Print error ratios.
*/
printf ( "\n" );
printf ( " Estimated error: %g\n", esterr / maxdev );
printf ( " Actual error: %g\n", maxerr / maxdev );
printf ( " Expected error: %g\n", 0.2468E-10 );
/*
Terminate.
*/
printf ( "\n" );
printf ( "RECTANGLE:\n" );
printf ( " Normal end of execution.\n" );
printf ( "\n" );
timestamp ( );
return 0;
# undef DEGMAX
# undef NTG1MX
# undef NPDMAX
# undef NTGMAX
}
void test02 ( void )
/******************************************************************************/
/*
Purpose:
TEST02 tests R8MAT_FLOYD.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 July 2011
Author:
John Burkardt
*/
{
# define N 6
double a[N*N] = {
0.0, -1.0, -1.0, -1.0, -1.0, -1.0,
2.0, 0.0, -1.0, -1.0, -1.0, 5.0,
5.0, 7.0, 0.0, -1.0, 2.0, -1.0,
-1.0, 1.0, 4.0, 0.0, -1.0, 2.0,
-1.0, -1.0, -1.0, 3.0, 0.0, 4.0,
-1.0, 8.0, -1.0, -1.0, 3.0, 0.0 };
double huge;
int i;
int j;
int n = N;
printf ( "\n" );
printf ( "TEST02\n" );
printf ( " R8MAT_FLOYO uses Floyd's algorithm to find the\n" );
printf ( " shortest distance between all pairs of nodes\n" );
printf ( " in a directed graph, starting from the initial array\n" );
printf ( " of direct node-to-node distances.\n" );
printf ( "\n" );
printf ( " In the initial direct distance array, if\n" );
printf ( " A(I,J) = -1,\n" );
printf ( " this indicates there is NO directed link from\n" );
printf ( " node I to node J. In that case, the value of\n" );
printf ( " of A(I,J) is essentially \"infinity\".\n" );
r8mat_print ( n, n, a, " Initial direct distance array:" );
huge = r8_huge ( );
for ( j = 0; j < n; j++ )
{
for ( i = 0; i < n; i++ )
{
if ( a[i+j*n] == - 1.0 )
{
a[i+j*n] = huge;
}
}
}
r8mat_floyd ( n, a );
for ( j = 0; j < n; j++ )
{
for ( i = 0; i < n; i++ )
{
if ( a[i+j*n] == huge )
{
a[i+j*n] = - 1.0;
}
}
}
printf ( "\n" );
printf ( " In the final shortest distance array, if\n" );
printf ( " A(I,J) = -1,\n" );
printf ( " this indicates there is NO directed path from\n" );
printf ( " node I to node J.\n" );
r8mat_print ( n, n, a, " Final shortest distance array:" );
return;
# undef N
}
double r8_normal_01_cdf_inverse ( double p )
// Purpose: inverts the standard normal CDF. The result is accurate to about 1 part in 10^16.
// Author: Original FORTRAN77 version by Michael Wichura. C version by John Burkardt.
{
static double a[8] = {
3.3871328727963666080, 1.3314166789178437745e+2,
1.9715909503065514427e+3, 1.3731693765509461125e+4,
4.5921953931549871457e+4, 6.7265770927008700853e+4,
3.3430575583588128105e+4, 2.5090809287301226727e+3 };
static double b[8] = {
1.0, 4.2313330701600911252e+1,
6.8718700749205790830e+2, 5.3941960214247511077e+3,
2.1213794301586595867e+4, 3.9307895800092710610e+4,
2.8729085735721942674e+4, 5.2264952788528545610e+3 };
static double c[8] = {
1.42343711074968357734, 4.63033784615654529590,
5.76949722146069140550, 3.64784832476320460504,
1.27045825245236838258, 2.41780725177450611770e-1,
2.27238449892691845833e-2, 7.74545014278341407640e-4 };
static double const1 = 0.180625;
static double const2 = 1.6;
static double d[8] = {
1.0, 2.05319162663775882187,
1.67638483018380384940, 6.89767334985100004550e-1,
1.48103976427480074590e-1, 1.51986665636164571966e-2,
5.47593808499534494600e-4, 1.05075007164441684324e-9 };
static double e[8] = {
6.65790464350110377720, 5.46378491116411436990,
1.78482653991729133580, 2.96560571828504891230e-1,
2.65321895265761230930e-2, 1.24266094738807843860e-3,
2.71155556874348757815e-5, 2.01033439929228813265e-7 };
static double f[8] = {
1.0, 5.99832206555887937690e-1,
1.36929880922735805310e-1, 1.48753612908506148525e-2,
7.86869131145613259100e-4, 1.84631831751005468180e-5,
1.42151175831644588870e-7, 2.04426310338993978564e-15 };
double q;
double r;
static double split1 = 0.425;
static double split2 = 5.0;
double value;
if ( p <= 0.0 )
{
value = - r8_huge ( );
return value;
}
if ( 1.0 <= p )
{
value = r8_huge ( );
return value;
}
q = p - 0.5;
if ( fabs ( q ) <= split1 )
{
r = const1 - q * q;
value = q * r8poly_value ( 8, a, r ) / r8poly_value ( 8, b, r );
}
else
{
if ( q < 0.0 )
{
r = p;
}
else
{
r = 1.0 - p;
}
if ( r <= 0.0 )
{
value = - 1.0;
exit ( 1 );
}
r = sqrt ( -log ( r ) );
if ( r <= split2 )
{
r = r - const2;
value = r8poly_value ( 8, c, r ) / r8poly_value ( 8, d, r );
}
else
{
r = r - split2;
value = r8poly_value ( 8, e, r ) / r8poly_value ( 8, f, r );
}
if ( q < 0.0 )
{
value = - value;
}
}
return value;
}
void kmns ( double a[], int m, int n, double c[], int k, int ic1[], int nc[],
int iter, double wss[], int *ifault )
/******************************************************************************/
/*
Purpose:
KMNS carries out the K-means algorithm.
Discussion:
This routine attempts to divide M points in N-dimensional space into
K clusters so that the within cluster sum of squares is minimized.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
09 November 2010
Author:
Original FORTRAN77 version by John Hartigan, Manchek Wong.
C version by John Burkardt.
Reference:
John Hartigan, Manchek Wong,
Algorithm AS 136:
A K-Means Clustering Algorithm,
Applied Statistics,
Volume 28, Number 1, 1979, pages 100-108.
Parameters:
Input, double A(M,N), the points.
Input, int M, the number of points.
Input, int N, the number of spatial dimensions.
Input/output, double C(K,N), the cluster centers.
Input, int K, the number of clusters.
Output, int IC1(M), the cluster to which each point
is assigned.
Output, int NC(K), the number of points in each cluster.
Input, int ITER, the maximum number of iterations allowed.
Output, double WSS(K), the within-cluster sum of squares
of each cluster.
Output, int *IFAULT, error indicator.
0, no error was detected.
1, at least one cluster is empty after the initial assignment. A better
set of initial cluster centers is needed.
2, the allowed maximum number off iterations was exceeded.
3, K is less than or equal to 1, or greater than or equal to M.
*/
{
double aa;
double *an1;
double *an2;
double *d;
double da;
double db;
double dc;
double dt[2];
int i;
int *ic2;
int ii;
int ij;
int il;
int indx;
int *itran;
int j;
int l;
int *live;
int *ncp;
double temp;
*ifault = 0;
if ( k <= 1 || m <= k )
{
*ifault = 3;
return;
}
ic2 = ( int * ) malloc ( m * sizeof ( int ) );
an1 = ( double * ) malloc ( k * sizeof ( double ) );
an2 = ( double * ) malloc ( k * sizeof ( double ) );
ncp = ( int * ) malloc ( k * sizeof ( int ) );
d = ( double * ) malloc ( m * sizeof ( double ) );
itran = ( int * ) malloc ( k * sizeof ( int ) );
live = ( int * ) malloc ( k * sizeof ( int ) );
/*
For each point I, find its two closest centers, IC1(I) and
IC2(I). Assign the point to IC1(I).
*/
for ( i = 1; i <= m; i++ )
{
ic1[i-1] = 1;
ic2[i-1] = 2;
for ( il = 1; il <= 2; il++ )
{
dt[il-1] = 0.0;
for ( j = 1; j <= n; j++ )
{
da = a[i-1+(j-1)*m] - c[il-1+(j-1)*k];
dt[il-1] = dt[il-1] + da * da;
}
}
if ( dt[1] < dt[0] )
{
ic1[i-1] = 2;
ic2[i-1] = 1;
temp = dt[0];
dt[0] = dt[1];
dt[1] = temp;
}
for ( l = 3; l <= k; l++ )
{
db = 0.0;
for ( j = 1; j <= n; j++ )
{
dc = a[i-1+(j-1)*m] - c[l-1+(j-1)*k];
db = db + dc * dc;
}
if ( db < dt[1] )
{
if ( dt[0] <= db )
{
dt[1] = db;
ic2[i-1] = l;
}
else
{
dt[1] = dt[0];
ic2[i-1] = ic1[i-1];
dt[0] = db;
ic1[i-1] = l;
}
}
}
}
/*
Update cluster centers to be the average of points contained within them.
*/
for ( l = 1; l <= k; l++ )
{
nc[l-1] = 0;
for ( j = 1; j <= n; j++ )
{
c[l-1+(j-1)*k] = 0.0;
}
}
for ( i = 1; i <= m; i++ )
{
l = ic1[i-1];
nc[l-1] = nc[l-1] + 1;
for ( j = 1; j <= n; j++ )
{
c[l-1+(j-1)*k] = c[l-1+(j-1)*k] + a[i-1+(j-1)*m];
}
}
/*
Check to see if there is any empty cluster at this stage.
*/
*ifault = 1;
for ( l = 1; l <= k; l++ )
{
if ( nc[l-1] == 0 )
{
*ifault = 1;
return;
}
}
*ifault = 0;
for ( l = 1; l <= k; l++ )
{
aa = ( double ) ( nc[l-1] );
for ( j = 1; j <= n; j++ )
{
c[l-1+(j-1)*k] = c[l-1+(j-1)*k] / aa;
}
/*
Initialize AN1, AN2, ITRAN and NCP.
AN1(L) = NC(L) / (NC(L) - 1)
AN2(L) = NC(L) / (NC(L) + 1)
ITRAN(L) = 1 if cluster L is updated in the quick-transfer stage,
= 0 otherwise
In the optimal-transfer stage, NCP(L) stores the step at which
cluster L is last updated.
In the quick-transfer stage, NCP(L) stores the step at which
cluster L is last updated plus M.
*/
an2[l-1] = aa / ( aa + 1.0 );
if ( 1.0 < aa )
{
an1[l-1] = aa / ( aa - 1.0 );
}
else
{
an1[l-1] = r8_huge ( );
}
itran[l-1] = 1;
ncp[l-1] = -1;
}
indx = 0;
*ifault = 2;
for ( ij = 1; ij <= iter; ij++ )
{
/*
In this stage, there is only one pass through the data. Each
point is re-allocated, if necessary, to the cluster that will
induce the maximum reduction in within-cluster sum of squares.
*/
optra ( a, m, n, c, k, ic1, ic2, nc, an1, an2, ncp, d, itran, live, &indx );
/*
Stop if no transfer took place in the last M optimal transfer steps.
*/
if ( indx == m )
{
*ifault = 0;
break;
}
/*
Each point is tested in turn to see if it should be re-allocated
to the cluster to which it is most likely to be transferred,
IC2(I), from its present cluster, IC1(I). Loop through the
data until no further change is to take place.
*/
qtran ( a, m, n, c, k, ic1, ic2, nc, an1, an2, ncp, d, itran, &indx );
/*
If there are only two clusters, there is no need to re-enter the
optimal transfer stage.
*/
if ( k == 2 )
{
*ifault = 0;
break;
}
/*
NCP has to be set to 0 before entering OPTRA.
*/
for ( l = 1; l <= k; l++ )
{
ncp[l-1] = 0;
}
}
/*
If the maximum number of iterations was taken without convergence,
IFAULT is 2 now. This may indicate unforeseen looping.
*/
if ( *ifault == 2 )
{
printf ( "\n" );
printf ( "KMNS - Warning!\n" );
printf ( " Maximum number of iterations reached\n" );
printf ( " without convergence.\n" );
}
/*
Compute the within-cluster sum of squares for each cluster.
*/
for ( l = 1; l <= k; l++ )
{
wss[l-1] = 0.0;
for ( j = 1; j <= n; j++ )
{
c[l-1+(j-1)*k] = 0.0;
}
}
for ( i = 1; i <= m; i++ )
{
ii = ic1[i-1];
for ( j = 1; j <= n; j++ )
{
c[ii-1+(j-1)*k] = c[ii-1+(j-1)*k] + a[i-1+(j-1)*m];
}
}
for ( j = 1; j <= n; j++ )
{
for ( l = 1; l <= k; l++ )
{
c[l-1+(j-1)*k] = c[l-1+(j-1)*k] / ( double ) ( nc[l-1] );
}
for ( i = 1; i <= m; i++ )
{
ii = ic1[i-1];
da = a[i-1+(j-1)*m] - c[ii-1+(j-1)*k];
wss[ii-1] = wss[ii-1] + da * da;
}
}
free ( ic2 );
free ( an1 );
free ( an2 );
free ( ncp );
free ( d );
free ( itran );
free ( live );
return;
}
void qtran ( double a[], int m, int n, double c[], int k, int ic1[],
int ic2[], int nc[], double an1[], double an2[], int ncp[], double d[],
int itran[], int *indx )
/******************************************************************************/
/*
Purpose:
QTRAN carries out the quick transfer stage.
Discussion:
This is the quick transfer stage.
IC1(I) is the cluster which point I belongs to.
IC2(I) is the cluster which point I is most likely to be
transferred to.
For each point I, IC1(I) and IC2(I) are switched, if necessary, to
reduce within-cluster sum of squares. The cluster centers are
updated after each step.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
09 November 2010
Author:
Original FORTRAN77 version by John Hartigan, Manchek Wong.
C version by John Burkardt.
Reference:
John Hartigan, Manchek Wong,
Algorithm AS 136:
A K-Means Clustering Algorithm,
Applied Statistics,
Volume 28, Number 1, 1979, pages 100-108.
Parameters:
Input, double A(M,N), the points.
Input, int M, the number of points.
Input, int N, the number of spatial dimensions.
Input/output, double C(K,N), the cluster centers.
Input, int K, the number of clusters.
Input/output, int IC1(M), the cluster to which each
point is assigned.
Input/output, int IC2(M), used to store the cluster
which each point is most likely to be transferred to at each step.
Input/output, int NC(K), the number of points in
each cluster.
Input/output, double AN1(K).
Input/output, double AN2(K).
Input/output, int NCP(K).
Input/output, double D(M).
Input/output, int ITRAN(K).
Input/output, int INDX, counts the number of steps
since the last transfer.
*/
{
double al1;
double al2;
double alt;
double alw;
double da;
double db;
double dd;
double de;
int i;
int icoun;
int istep;
int j;
int l1;
int l2;
double r2;
/*
In the optimal transfer stage, NCP(L) indicates the step at which
cluster L is last updated. In the quick transfer stage, NCP(L)
is equal to the step at which cluster L is last updated plus M.
*/
icoun = 0;
istep = 0;
for ( ; ; )
{
for ( i = 1; i <= m; i++ )
{
icoun = icoun + 1;
istep = istep + 1;
l1 = ic1[i-1];
l2 = ic2[i-1];
/*
If point I is the only member of cluster L1, no transfer.
*/
if ( 1 < nc[l1-1] )
{
/*
If NCP(L1) < ISTEP, no need to re-compute distance from point I to
cluster L1. Note that if cluster L1 is last updated exactly M
steps ago, we still need to compute the distance from point I to
cluster L1.
*/
if ( istep <= ncp[l1-1] )
{
da = 0.0;
for ( j = 1; j <= n; j++ )
{
db = a[i-1+(j-1)*m] - c[l1-1+(j-1)*k];
da = da + db * db;
}
d[i-1] = da * an1[l1-1];
}
/*
If NCP(L1) <= ISTEP and NCP(L2) <= ISTEP, there will be no transfer of
point I at this step.
*/
if ( istep < ncp[l1-1] || istep < ncp[l2-1] )
{
r2 = d[i-1] / an2[l2-1];
dd = 0.0;
for ( j = 1; j <= n; j++ )
{
de = a[i-1+(j-1)*m] - c[l2-1+(j-1)*k];
dd = dd + de * de;
}
/*
Update cluster centers, NCP, NC, ITRAN, AN1 and AN2 for clusters
L1 and L2. Also update IC1(I) and IC2(I). Note that if any
updating occurs in this stage, INDX is set back to 0.
*/
if ( dd < r2 )
{
icoun = 0;
*indx = 0;
itran[l1-1] = 1;
itran[l2-1] = 1;
ncp[l1-1] = istep + m;
ncp[l2-1] = istep + m;
al1 = ( double ) ( nc[l1-1] );
alw = al1 - 1.0;
al2 = ( double ) ( nc[l2-1] );
alt = al2 + 1.0;
for ( j = 1; j <= n; j++ )
{
c[l1-1+(j-1)*k] = ( c[l1-1+(j-1)*k] * al1 - a[i-1+(j-1)*m] ) / alw;
c[l2-1+(j-1)*k] = ( c[l2-1+(j-1)*k] * al2 + a[i-1+(j-1)*m] ) / alt;
}
nc[l1-1] = nc[l1-1] - 1;
nc[l2-1] = nc[l2-1] + 1;
an2[l1-1] = alw / al1;
if ( 1.0 < alw )
{
an1[l1-1] = alw / ( alw - 1.0 );
}
else
{
an1[l1-1] = r8_huge ( );
}
an1[l2-1] = alt / al2;
an2[l2-1] = alt / ( alt + 1.0 );
ic1[i-1] = l2;
ic2[i-1] = l1;
}
}
}
/*
If no re-allocation took place in the last M steps, return.
*/
if ( icoun == m )
{
return;
}
}
}
}
void optra ( double a[], int m, int n, double c[], int k, int ic1[],
int ic2[], int nc[], double an1[], double an2[], int ncp[], double d[],
int itran[], int live[], int *indx )
/******************************************************************************/
/*
Purpose:
OPTRA carries out the optimal transfer stage.
Discussion:
This is the optimal transfer stage.
Each point is re-allocated, if necessary, to the cluster that
will induce a maximum reduction in the within-cluster sum of
squares.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
09 November 2010
Author:
Original FORTRAN77 version by John Hartigan, Manchek Wong.
C version by John Burkardt.
Reference:
John Hartigan, Manchek Wong,
Algorithm AS 136:
A K-Means Clustering Algorithm,
Applied Statistics,
Volume 28, Number 1, 1979, pages 100-108.
Parameters:
Input, double A(M,N), the points.
Input, int M, the number of points.
Input, int N, the number of spatial dimensions.
Input/output, double C(K,N), the cluster centers.
Input, int K, the number of clusters.
Input/output, int IC1(M), the cluster to which each
point is assigned.
Input/output, int IC2(M), used to store the cluster
which each point is most likely to be transferred to at each step.
Input/output, int NC(K), the number of points in
each cluster.
Input/output, double AN1(K).
Input/output, double AN2(K).
Input/output, int NCP(K).
Input/output, double D(M).
Input/output, int ITRAN(K).
Input/output, int LIVE(K).
Input/output, int *INDX, the number of steps since a
transfer took place.
*/
{
double al1;
double al2;
double alt;
double alw;
double da;
double db;
double dc;
double dd;
double de;
double df;
int i;
int j;
int l;
int l1;
int l2;
int ll;
double r2;
double rr;
/*
If cluster L is updated in the last quick-transfer stage, it
belongs to the live set throughout this stage. Otherwise, at
each step, it is not in the live set if it has not been updated
in the last M optimal transfer steps.
*/
for ( l = 1; l <= k; l++ )
{
if ( itran[l-1] == 1)
{
live[l-1] = m + 1;
}
}
for ( i = 1; i <= m; i++ )
{
*indx = *indx + 1;
l1 = ic1[i-1];
l2 = ic2[i-1];
ll = l2;
/*
If point I is the only member of cluster L1, no transfer.
*/
if ( 1 < nc[l1-1] )
{
/*
If L1 has not yet been updated in this stage, no need to
re-compute D(I).
*/
if ( ncp[l1-1] != 0 )
{
de = 0.0;
for ( j = 1; j <= n; j++ )
{
df = a[i-1+(j-1)*m] - c[l1-1+(j-1)*k];
de = de + df * df;
}
d[i-1] = de * an1[l1-1];
}
/*
Find the cluster with minimum R2.
*/
da = 0.0;
for ( j = 1; j <= n; j++ )
{
db = a[i-1+(j-1)*m] - c[l2-1+(j-1)*k];
da = da + db * db;
}
r2 = da * an2[l2-1];
for ( l = 1; l <= k; l++ )
{
/*
If LIVE(L1) <= I, then L1 is not in the live set. If this is
true, we only need to consider clusters that are in the live set
for possible transfer of point I. Otherwise, we need to consider
all possible clusters.
*/
if ( ( i < live[l1-1] || i < live[l2-1] ) && l != l1 && l != ll )
{
rr = r2 / an2[l-1];
dc = 0.0;
for ( j = 1; j <= n; j++ )
{
dd = a[i-1+(j-1)*m] - c[l-1+(j-1)*k];
dc = dc + dd * dd;
}
if ( dc < rr )
{
r2 = dc * an2[l-1];
l2 = l;
}
}
}
/*
If no transfer is necessary, L2 is the new IC2(I).
*/
if ( d[i-1] <= r2 )
{
ic2[i-1] = l2;
}
/*
Update cluster centers, LIVE, NCP, AN1 and AN2 for clusters L1 and
L2, and update IC1(I) and IC2(I).
*/
else
{
*indx = 0;
live[l1-1] = m + i;
live[l2-1] = m + i;
ncp[l1-1] = i;
ncp[l2-1] = i;
al1 = ( double ) ( nc[l1-1] );
alw = al1 - 1.0;
al2 = ( double ) ( nc[l2-1] );
alt = al2 + 1.0;
for ( j = 1; j <= n; j++ )
{
c[l1-1+(j-1)*k] = ( c[l1-1+(j-1)*k] * al1 - a[i-1+(j-1)*m] ) / alw;
c[l2-1+(j-1)*k] = ( c[l2-1+(j-1)*k] * al2 + a[i-1+(j-1)*m] ) / alt;
}
nc[l1-1] = nc[l1-1] - 1;
nc[l2-1] = nc[l2-1] + 1;
an2[l1-1] = alw / al1;
if ( 1.0 < alw )
{
an1[l1-1] = alw / ( alw - 1.0 );
}
else
{
an1[l1-1] = r8_huge ( );
}
an1[l2-1] = alt / al2;
an2[l2-1] = alt / ( alt + 1.0 );
ic1[i-1] = l2;
ic2[i-1] = l1;
}
}
if ( *indx == m )
{
return;
}
}
/*
ITRAN(L) = 0 before entering QTRAN. Also, LIVE(L) has to be
decreased by M before re-entering OPTRA.
*/
for ( l = 1; l <= k; l++ )
{
itran[l-1] = 0;
live[l-1] = live[l-1] - m;
}
return;
}
