my ($last_test,$loaded);
######################### We start with some black magic to print on failure.
use lib '../blib/lib','../blib/arch';
BEGIN { $last_test = 34; $| = 1; print "1..$last_test\n"; }
END { print "not ok 1 Can't load Algorithm::Cluster\n" unless $loaded; }
use Algorithm::Cluster;
no warnings 'Algorithm::Cluster';
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
sub test; # Predeclare the test function (defined below)
my $tcounter = 1;
my $want = '';
#------------------------------------------------------
# Data for Tests
#
#----------
# dataset 1
#
my $weight1 = [ 1,1,1,1,1 ];
my $data1 = [
[ 1.1, 2.2, 3.3, 4.4, 5.5, ],
[ 3.1, 3.2, 1.3, 2.4, 1.5, ],
[ 4.1, 2.2, 0.3, 5.4, 0.5, ],
[ 12.1, 2.0, 0.0, 5.0, 0.0, ],
];
my $mask1 = [
[ 1, 1, 1, 1, 1, ],
[ 1, 1, 1, 1, 1, ],
[ 1, 1, 1, 1, 1, ],
[ 1, 1, 1, 1, 1, ],
];
#----------
# dataset 2
#
my $weight2 = [ 1,1 ];
my $data2 = [
[ 1.1, 1.2 ],
[ 1.4, 1.3 ],
[ 1.1, 1.5 ],
[ 2.0, 1.5 ],
[ 1.7, 1.9 ],
[ 1.7, 1.9 ],
[ 5.7, 5.9 ],
[ 5.7, 5.9 ],
[ 3.1, 3.3 ],
[ 5.4, 5.3 ],
[ 5.1, 5.5 ],
[ 5.0, 5.5 ],
[ 5.1, 5.2 ],
];
my $mask2 = [
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
[ 1, 1 ],
];
#------------------------------------------------------
# Tests
#
my ($clusters, $centroids, $found);
my ($i,$j);
my %params = (
nclusters => 3,
transpose => 0,
npass => 100,
method => 'a',
dist => 'e',
);
#----------
# test dataset 1
#
($clusters, $centroids, $found) = Algorithm::Cluster::kcluster(
%params,
data => $data1,
mask => $mask1,
weight => $weight1,
);
#$i=0;$j=0;
#foreach(@{$centroids}) {
# $j=0;
# foreach(@{$_}) {
# printf("%2d,%2d: %7.3f\n",$i,$j++,$_);
# }
# ++$i;
#}
#
#$i=0;$j=0;
#foreach(@{$clusters}) {
# printf("%2d: %2d\n",$i++,$_);
#}
#----------
# Make sure that the length of @clusters matches the length of @data
$want = scalar @$data1; test q( scalar @$clusters );
# Make sure that we got the right number of clusters (in @centroids)
$want = $params{nclusters}; test q( scalar @$centroids );
#----------
# Test the cluster coordinates
$want = '1'; test q( $clusters->[ 0] != $clusters->[ 1] );
$want = '1'; test q( $clusters->[ 1] == $clusters->[ 2] );
$want = '1'; test q( $clusters->[ 2] != $clusters->[ 3] );
$want = ' 1.100'; test q( sprintf "%7.3f", $centroids->[$clusters->[0]]->[0] );
$want = ' 2.200'; test q( sprintf "%7.3f", $centroids->[$clusters->[0]]->[1] );
$want = ' 3.300'; test q( sprintf "%7.3f", $centroids->[$clusters->[0]]->[2] );
$want = ' 4.400'; test q( sprintf "%7.3f", $centroids->[$clusters->[0]]->[3] );
$want = ' 3.600'; test q( sprintf "%7.3f", $centroids->[$clusters->[1]]->[0] );
$want = ' 2.700'; test q( sprintf "%7.3f", $centroids->[$clusters->[1]]->[1] );
$want = ' 0.800'; test q( sprintf "%7.3f", $centroids->[$clusters->[1]]->[2] );
$want = ' 3.900'; test q( sprintf "%7.3f", $centroids->[$clusters->[1]]->[3] );
$want = ' 12.100'; test q( sprintf "%7.3f", $centroids->[$clusters->[3]]->[0] );
$want = ' 2.000'; test q( sprintf "%7.3f", $centroids->[$clusters->[3]]->[1] );
$want = ' 0.000'; test q( sprintf "%7.3f", $centroids->[$clusters->[3]]->[2] );
$want = ' 5.000'; test q( sprintf "%7.3f", $centroids->[$clusters->[3]]->[3] );
#----------
# test dataset 2
#
$i=0;$j=0;
($clusters, $centroids, $found) = Algorithm::Cluster::kcluster(
%params,
data => $data2,
mask => $mask2,
weight => $weight2,
);
#$i=0;$j=0;
#foreach(@{$centroids}) {
# $j=0;
# foreach(@{$_}) {
# printf("%2d,%2d: %7.3f\n",$i,$j++,$_);
# }
# ++$i;
#}
#
#$i=0;$j=0;
#foreach(@{$clusters}) {
# printf("%2d: %2d\n",$i++,$_);
#}
#----------
# Make sure that the length of @clusters matches the length of @data
$want = scalar @$data2; test q( scalar @$clusters );
# Make sure that we got the right number of clusters (in @centroids)
$want = $params{nclusters}; test q( scalar @$centroids );
#----------
# Test the cluster coordinates
$want = '1'; test q( $clusters->[ 0] == $clusters->[ 3] );
$want = '1'; test q( $clusters->[ 0] != $clusters->[ 6] );
$want = '1'; test q( $clusters->[ 0] != $clusters->[ 9] );
$want = '1'; test q( $clusters->[11] == $clusters->[12] );
$want = ' 1.500'; test q( sprintf "%7.3f", $centroids->[$clusters->[0]]->[0] );
$want = ' 1.550'; test q( sprintf "%7.3f", $centroids->[$clusters->[0]]->[1] );
$want = ' 1.500'; test q( sprintf "%7.3f", $centroids->[$clusters->[1]]->[0] );
$want = ' 1.550'; test q( sprintf "%7.3f", $centroids->[$clusters->[1]]->[1] );
$want = ' 5.333'; test q( sprintf "%7.3f", $centroids->[$clusters->[6]]->[0] );
$want = ' 5.550'; test q( sprintf "%7.3f", $centroids->[$clusters->[6]]->[1] );
$want = ' 5.333'; test q( sprintf "%7.3f", $centroids->[$clusters->[7]]->[0] );
$want = ' 5.550'; test q( sprintf "%7.3f", $centroids->[$clusters->[7]]->[1] );
$want = ' 3.100'; test q( sprintf "%7.3f", $centroids->[$clusters->[8]]->[0] );
$want = ' 3.300'; test q( sprintf "%7.3f", $centroids->[$clusters->[8]]->[1] );
#------------------------------------------------------
# Test function
#
sub test {
$tcounter++;
my $string = shift;
my $ret = eval $string;
$ret = 'undef' if not defined $ret;
if("$ret" =~ /^$want$/sm) {
print "ok $tcounter\n";
} else {
print "not ok $tcounter\n",
" -- '$string' returned '$ret'\n",
" -- expected =~ /$want/\n"
}
}
__END__