perl/t/12_treecluster.t

use Test::More tests => 224;

use lib '../blib/lib','../blib/arch';

use_ok ("Algorithm::Cluster");
require_ok ("Algorithm::Cluster");


#########################


#------------------------------------------------------
# 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   = [
    [ 0.8223, 0.9295 ],
    [ 1.4365, 1.3223 ],
    [ 1.1623, 1.5364 ],
    [ 2.1826, 1.1934 ],
    [ 1.7763, 1.9352 ],
    [ 1.7215, 1.9912 ],
    [ 2.1812, 5.9935 ],
    [ 5.3290, 5.9452 ],
    [ 3.1491, 3.3454 ],
    [ 5.1923, 5.3156 ],
    [ 4.7735, 5.4012 ],
    [ 5.1297, 5.5645 ],
    [ 5.3934, 5.1823 ],
];

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 $tree;
my $node;

#----------
# test dataset 1
#

#--------------[PALcluster]-------
my %params = (
    transpose  =>         0,
    method     =>       'a',
    dist       =>       'e',
    data       =>    $data1,
    mask       =>    $mask1,
    weight     =>  $weight1,
);

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data1) - 1, $tree->length );

$node = $tree->get(0);
is ($node->left, 2);
is ($node->right, 1);
is (sprintf("%7.3f", $node->distance), "  2.600");

$node = $tree->get(1);
is ($node->left, -1);
is ($node->right, 0);
is (sprintf("%7.3f", $node->distance), "  7.300");

$node = $tree->get(2);
is ($node->left, 3);
is ($node->right, -2);
is (sprintf("%7.3f", $node->distance), " 21.348");


#--------------[PSLcluster]-------
$params{method} = 's';

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data1) - 1, $tree->length );

$node = $tree->get(0);
is ($node->left, 1);
is ($node->right, 2);
is (sprintf("%7.3f", $node->distance), "  2.600");

$node = $tree->get(1);
is ($node->left, 0);
is ($node->right, -1);
is (sprintf("%7.3f", $node->distance), "  5.800");

$node = $tree->get(2);
is ($node->left, -2);
is ($node->right, 3);
is (sprintf("%7.3f", $node->distance), " 12.908");


#--------------[PCLcluster]-------
$params{method} = 'c';

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data1) - 1, $tree->length );

$node = $tree->get(0);
is ($node->left, 1);
is ($node->right, 2);
is (sprintf("%7.3f", $node->distance), "  2.600");

$node = $tree->get(1);
is ($node->left, 0);
is ($node->right, -1);
is (sprintf("%7.3f", $node->distance), "  6.650");

$node = $tree->get(2);
is ($node->left, -2);
is ($node->right, 3);
is (sprintf("%7.3f", $node->distance), " 19.437");


#--------------[PMLcluster]-------
$params{method} = 'm';

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data1) - 1, $tree->length );

$node = $tree->get(0);
is ($node->left, 2);
is ($node->right, 1);
is (sprintf("%7.3f", $node->distance), "  2.600");

$node = $tree->get(1);
is ($node->left, -1);
is ($node->right, 0);
is (sprintf("%7.3f", $node->distance), "  8.800");

$node = $tree->get(2);
is ($node->left, 3);
is ($node->right, -2);
is (sprintf("%7.3f", $node->distance), " 32.508");



#----------
# test dataset 2
#

#--------------[PALcluster]-------
%params = (
    transpose  =>         0,
    method     =>       'a',
    dist       =>       'e',
    data       =>    $data2,
    mask       =>    $mask2,
    weight     =>  $weight2,
);

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data2) - 1, $tree->length);


$node = $tree->get(0);
is ($node->left, 5);
is ($node->right, 4);
is (sprintf("%7.3f", $node->distance), "  0.003");

$node = $tree->get(1);
is ($node->left, 9);
is ($node->right, 12);
is (sprintf("%7.3f", $node->distance), "  0.029");

$node = $tree->get(2);
is ($node->left, 2);
is ($node->right, 1);
is (sprintf("%7.3f", $node->distance), "  0.061");

$node = $tree->get(3);
is ($node->left, 11);
is ($node->right, -2);
is (sprintf("%7.3f", $node->distance), "  0.070");

$node = $tree->get(4);
is ($node->left, -4);
is ($node->right, 10);
is (sprintf("%7.3f", $node->distance), "  0.128");

$node = $tree->get(5);
is ($node->left, 7);
is ($node->right, -5);
is (sprintf("%7.3f", $node->distance), "  0.224");

$node = $tree->get(6);
is ($node->left, -3);
is ($node->right, 0);
is (sprintf("%7.3f", $node->distance), "  0.254");

$node = $tree->get(7);
is ($node->left, -1);
is ($node->right, 3);
is (sprintf("%7.3f", $node->distance), "  0.391");

$node = $tree->get(8);
is ($node->left, -8);
is ($node->right, -7);
is (sprintf("%7.3f", $node->distance), "  0.532");

$node = $tree->get(9);
is ($node->left, 8);
is ($node->right, -9);
is (sprintf("%7.3f", $node->distance), "  3.234");

$node = $tree->get(10);
is ($node->left, -6);
is ($node->right, 6);
is (sprintf("%7.3f", $node->distance), "  4.636");

$node = $tree->get(11);
is ($node->left, -11);
is ($node->right, -10);
is (sprintf("%7.3f", $node->distance), " 12.741");



#--------------[PSLcluster]-------
$params{method} = 's';

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data2) - 1, $tree->length );


$node = $tree->get(0);
is ($node->left, 4);
is ($node->right, 5);
is (sprintf("%7.3f", $node->distance), "  0.003");

$node = $tree->get(1);
is ($node->left, 9);
is ($node->right, 12);
is (sprintf("%7.3f", $node->distance), "  0.029");

$node = $tree->get(2);
is ($node->left, 11);
is ($node->right, -2);
is (sprintf("%7.3f", $node->distance), "  0.033");

$node = $tree->get(3);
is ($node->left, 1);
is ($node->right, 2);
is (sprintf("%7.3f", $node->distance), "  0.061");

$node = $tree->get(4);
is ($node->left, 10);
is ($node->right, -3);
is (sprintf("%7.3f", $node->distance), "  0.077");

$node = $tree->get(5);
is ($node->left, 7);
is ($node->right, -5);
is (sprintf("%7.3f", $node->distance), "  0.092");

$node = $tree->get(6);
is ($node->left, 0);
is ($node->right, -4);
is (sprintf("%7.3f", $node->distance), "  0.242");

$node = $tree->get(7);
is ($node->left, -7);
is ($node->right, -1);
is (sprintf("%7.3f", $node->distance), "  0.246");

$node = $tree->get(8);
is ($node->left, 3);
is ($node->right, -8);
is (sprintf("%7.3f", $node->distance), "  0.287");

$node = $tree->get(9);
is ($node->left, -9);
is ($node->right, 8);
is (sprintf("%7.3f", $node->distance), "  1.936");

$node = $tree->get(10);
is ($node->left, -10);
is ($node->right, -6);
is (sprintf("%7.3f", $node->distance), "  3.432");

$node = $tree->get(11);
is ($node->left, 6);
is ($node->right, -11);
is (sprintf("%7.3f", $node->distance), "  3.535");


#--------------[PCLcluster]-------
$params{method} = 'c';

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

# Make sure that @clusters and @centroids are the right length
is (scalar(@$data2) - 1, $tree->length );



$node = $tree->get(0);
is ($node->left, 4);
is ($node->right, 5);
is (sprintf("%7.3f", $node->distance), "  0.003");

$node = $tree->get(1);
is ($node->left, 12);
is ($node->right, 9);
is (sprintf("%7.3f", $node->distance), "  0.029");

$node = $tree->get(2);
is ($node->left, 1);
is ($node->right, 2);
is (sprintf("%7.3f", $node->distance), "  0.061");

$node = $tree->get(3);
is ($node->left, -2);
is ($node->right, 11);
is (sprintf("%7.3f", $node->distance), "  0.063");

$node = $tree->get(4);
is ($node->left, 10);
is ($node->right, -4);
is (sprintf("%7.3f", $node->distance), "  0.109");

$node = $tree->get(5);
is ($node->left, -5);
is ($node->right, 7);
is (sprintf("%7.3f", $node->distance), "  0.189");

$node = $tree->get(6);
is ($node->left, 0);
is ($node->right, -3);
is (sprintf("%7.3f", $node->distance), "  0.239");

$node = $tree->get(7);
is ($node->left, 3);
is ($node->right, -1);
is (sprintf("%7.3f", $node->distance), "  0.390");

$node = $tree->get(8);
is ($node->left, -7);
is ($node->right, -8);
is (sprintf("%7.3f", $node->distance), "  0.382");

$node = $tree->get(9);
is ($node->left, -9);
is ($node->right, 8);
is (sprintf("%7.3f", $node->distance), "  3.063");

$node = $tree->get(10);
is ($node->left, 6);
is ($node->right, -6);
is (sprintf("%7.3f", $node->distance), "  4.578");

$node = $tree->get(11);
is ($node->left, -10);
is ($node->right, -11);
is (sprintf("%7.3f", $node->distance), " 11.536");


#--------------[PMLcluster]-------
$params{method} = 'm';

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

# Make sure that @clusters and @centroids are the right length
is ( scalar(@$data2) - 1, $tree->length );


$node = $tree->get(0);
is ($node->left, 5);
is ($node->right, 4);
is (sprintf("%7.3f", $node->distance), "  0.003");

$node = $tree->get(1);
is ($node->left, 9);
is ($node->right, 12);
is (sprintf("%7.3f", $node->distance), "  0.029");

$node = $tree->get(2);
is ($node->left, 2);
is ($node->right, 1);
is (sprintf("%7.3f", $node->distance), "  0.061");

$node = $tree->get(3);
is ($node->left, 11);
is ($node->right, 10);
is (sprintf("%7.3f", $node->distance), "  0.077");

$node = $tree->get(4);
is ($node->left, -2);
is ($node->right, -4);
is (sprintf("%7.3f", $node->distance), "  0.216");

$node = $tree->get(5);
is ($node->left, -3);
is ($node->right, 0);
is (sprintf("%7.3f", $node->distance), "  0.266");

$node = $tree->get(6);
is ($node->left, -5);
is ($node->right, 7);
is (sprintf("%7.3f", $node->distance), "  0.302");

$node = $tree->get(7);
is ($node->left, -1);
is ($node->right, 3);
is (sprintf("%7.3f", $node->distance), "  0.425");

$node = $tree->get(8);
is ($node->left, -8);
is ($node->right, -6);
is (sprintf("%7.3f", $node->distance), "  0.968");

$node = $tree->get(9);
is ($node->left, 8);
is ($node->right, 6);
is (sprintf("%7.3f", $node->distance), "  3.975");

$node = $tree->get(10);
is ($node->left, -10);
is ($node->right, -7);
is (sprintf("%7.3f", $node->distance), "  5.755");

$node = $tree->get(11);
is ($node->left, -11);
is ($node->right, -9);
is (sprintf("%7.3f", $node->distance), " 22.734");


#-------[treecluster on a distance matrix]------------

my $matrix   =  [
        [],
        [ 3.4],
        [ 4.3, 10.1],
        [ 3.7, 11.5,  1.0],
        [ 1.6,  4.1,  3.4,  3.4],
        [10.1, 20.5,  2.5,  2.7,  9.8],
        [ 2.5,  3.7,  3.1,  3.6,  1.1, 10.1],
        [ 3.4,  2.2,  8.8,  8.7,  3.3, 16.6,  2.7],
        [ 2.1,  7.7,  2.7,  1.9,  1.8,  5.7,  3.4,  5.2],
        [ 1.4,  1.7,  9.2,  8.7,  3.4, 16.8,  4.2,  1.3,  5.0],
        [ 2.7,  3.7,  5.5,  5.5,  1.9, 11.5,  2.0,  1.5,  2.1,  3.1],
        [10.0, 19.3,  2.2,  3.7,  9.1,  1.2,  9.3, 15.7,  6.3, 16.0, 11.5]
];

%params = (
    method     =>       's',
    data       =>   $matrix,
);

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

# Make sure that @clusters and @centroids are the right length
is ( scalar(@$matrix) - 1, $tree->length );

$node = $tree->get(0);
is ($node->left, 2);
is ($node->right, 3);
is (sprintf("%7.3f", $node->distance), "  1.000");

$node = $tree->get(1);
is ($node->left, 4);
is ($node->right, 6);
is (sprintf("%7.3f", $node->distance), "  1.100");

$node = $tree->get(2);
is ($node->left, 5);
is ($node->right, 11);
is (sprintf("%7.3f", $node->distance), "  1.200");

$node = $tree->get(3);
is ($node->left, 7);
is ($node->right, 9);
is (sprintf("%7.3f", $node->distance), "  1.300");

$node = $tree->get(4);
is ($node->left, 0);
is ($node->right, -4);
is (sprintf("%7.3f", $node->distance), "  1.400");

$node = $tree->get(5);
is ($node->left, -5);
is ($node->right, 10);
is (sprintf("%7.3f", $node->distance), "  1.500");

$node = $tree->get(6);
is ($node->left, -2);
is ($node->right, -6);
is (sprintf("%7.3f", $node->distance), "  1.600");

$node = $tree->get(7);
is ($node->left, 1);
is ($node->right, -7);
is (sprintf("%7.3f", $node->distance), "  1.700");

$node = $tree->get(8);
is ($node->left, 8);
is ($node->right, -8);
is (sprintf("%7.3f", $node->distance), "  1.800");

$node = $tree->get(9);
is ($node->left, -1);
is ($node->right, -9);
is (sprintf("%7.3f", $node->distance), "  1.900");

$node = $tree->get(10);
is ($node->left, -10);
is ($node->right, -3);
is (sprintf("%7.3f", $node->distance), "  2.200");
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)