The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/perl/perl580/bin/perl -w

use Algorithm::Cluster qw/kcluster/;

use strict;

my $weight1 = [ 1,1 ];

my $data1 = [
    [ 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 $mask1 = [
    [ 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 ],
];


my $data2 = [
    [ 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 $mask2 =  [
    [ 1, 1, 1, 1, 1, ], 
    [ 1, 1, 1, 1, 1, ], 
    [ 1, 1, 1, 1, 1, ], 
    [ 1, 1, 1, 1, 1, ], 
];

my $weight2 =  [ 1,1,1,1,1 ];

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

my ($clusters, $error, $found);
my ($i);

$i=0;
($clusters, $error, $found) = kcluster(
    %params,
    data      =>    $data1,
    mask      =>    $mask1,
    weight    =>  $weight1,
);

printf("\n");
printf("Clustering first data set:\n\n");

$i=0;
foreach(@{$clusters}) {
    printf("Gene %2d belongs to cluster %2d\n",$i++,$_);
}

printf("\n");

printf("Within-cluster sum of distances is %f\n", $error);

printf("\n");
printf("Clustering second data set:\n\n");

($clusters, $error, $found) = kcluster(
    %params,
    data      =>    $data2,
    mask      =>    $mask2,
    weight    =>  $weight2,
);

$i=0;
foreach(@{$clusters}) {
    printf("Gene %2d belongs to cluster %2d\n",$i++,$_);
}

printf("\n");

printf("Within-cluster sum of distances is %f\n", $error);

printf("\n");


__END__