view release on metacpan or  search on metacpan

perl/t/10_kcluster.t  view on Meta::CPAN

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, $error, $found);
my ($i,$j);

my %params = (
    nclusters =>         3,
    transpose =>         0,
    method    =>       'a',
    dist      =>       'e',
);

#----------
# test dataset 1
#
($clusters, $error, $found) = Algorithm::Cluster::kcluster(
    %params,
    data      =>    $data1,
    mask      =>    $mask1,
    weight    =>  $weight1,
    npass     =>       100,
);

#----------
# Make sure that the length of @clusters matches the length of @data
ok( scalar @$data1 == scalar @$clusters);

#----------
# Test the cluster coordinates
ok ( $clusters->[ 0] != $clusters->[ 1] );
ok ( $clusters->[ 1] == $clusters->[ 2] );
ok ( $clusters->[ 2] != $clusters->[ 3] );

# Test the within-cluster sum of errors
ok( sprintf ("%7.3f", $error) == '  1.300');


#----------
# test dataset 2
#
$i=0;$j=0;
($clusters, $error, $found) = Algorithm::Cluster::kcluster(
    %params,
    data      =>    $data2,
    mask      =>    $mask2,
    weight    =>  $weight2,
    npass     =>       100,
);


#----------
# Make sure that the length of @clusters matches the length of @data
ok (scalar @$data2 == scalar @$clusters);

#----------
# Test the cluster coordinates
ok ($clusters->[ 0] == $clusters->[ 3]);
ok ($clusters->[ 0] != $clusters->[ 6]);
ok ($clusters->[ 0] != $clusters->[ 9]);
ok ($clusters->[11] == $clusters->[12]);

# Test the within-cluster sum of errors
ok ( sprintf ("%7.3f", $error) == '  1.012');

#----------
# test kcluster with initial cluster assignments
#
$initialid = [0,1,2,0,1,2,0,1,2,0,1,2,0];

($clusters, $error, $found) = Algorithm::Cluster::kcluster(
    %params,
    data      =>     $data2,
    mask      =>     $mask2,
    weight    =>   $weight2,
    npass     =>          1, 
    initialid => $initialid, 
);

#----------
# Test the cluster coordinates
ok ( $clusters->[ 0] == 2 );
ok ( $clusters->[ 1] == 2 );
ok ( $clusters->[ 2] == 2 );
ok ( $clusters->[ 3] == 2 );
ok ( $clusters->[ 4] == 2 );
ok ( $clusters->[ 5] == 2 );
ok ( $clusters->[ 6] == 0 );
ok ( $clusters->[ 7] == 0 );
ok ( $clusters->[ 8] == 2 );
ok ( $clusters->[ 9] == 1 );
ok ( $clusters->[10] == 1 );
ok ( $clusters->[11] == 1 );
ok ( $clusters->[12] == 1 );

# Test the within-cluster sum of errors
ok ( sprintf ("%7.3f", $error) == '  3.036' );
   
ok ($found == 1 );
                 
__END__