view release on metacpan or  search on metacpan

perl/examples/ex5_treecluster  view on Meta::CPAN

#!/usr/perl/perl580/bin/perl 

use Algorithm::Cluster;

$|++;

$^W = 1;
use strict;

my $weight =  [ 1,1 ];

my $data =  [
    [ 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 $mask =  [
    [ 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 ],
];

print "--------------[pairwise average linkage]-------\n";

my %params = (
    transpose  =>         0,
    method     =>       'a',
    dist       =>       'e',
    data       =>     $data,
    mask       =>     $mask,
    weight     =>   $weight,
);

my $tree;
my ($i,$j,$n);

my $tree = Algorithm::Cluster::treecluster(%params);

$n = $tree->length;
for ($i = 0; $i < $n; $i++) {
    my $node = $tree->get($i);
    printf("%3d: %3d %3d %7.3f\n",-1-$i,$node->left,$node->right,$node->distance);
}

print "--------------[pairwise single linkage]-------\n";
$params{method} = 's';

$tree = Algorithm::Cluster::treecluster(%params);

$n = $tree->length;
for ($i = 0; $i < $n; $i++) {
    my $node = $tree->get($i);
    printf("%3d: %3d %3d %7.3f\n",-1-$i,$node->left,$node->right,$node->distance);
}

print "--------------[pairwise centroid linkage]-------\n";
$params{method} = 'c';

$tree= Algorithm::Cluster::treecluster(%params);

$n = $tree->length;
for ($i = 0; $i < $n; $i++) {
    my $node = $tree->get($i);
    printf("%3d: %3d %3d %7.3f\n",-1-$i,$node->left,$node->right,$node->distance);
}

print "--------------[pairwise maximum linkage]-------\n";
$params{method} = 'm';

$tree = Algorithm::Cluster::treecluster(%params);

$n = $tree->length;
for ($i = 0; $i < $n; $i++) {
    my $node = $tree->get($i);
    printf("%3d: %3d %3d %7.3f\n",-1-$i,$node->left,$node->right,$node->distance);
}

print "--------------------[tree sorting]-------------\n";
my $order =  [ 1,2,3,4,5,6,1,1,1,2,2,2,2 ];

my @indices = $tree->sort($order);
for ($i = 0; $i < $n; $i++) {
    my $node = $tree->get($i);
    printf("%3d: %3d %3d %7.3f\n",-1-$i,$node->left,$node->right,$node->distance);
};

print "-----------------[data after sorting]----------\n";
for ($i = 0; $i <= $n; $i++) {
    my $j = $indices[$i];
    printf("%3d: %3d %7.3f %7.3f\n", $i+1, $j, $data->[$j]->[0], $data->[$j]->[1]);
};
__END__