#!/usr/local/bin/perl
##############################################################################
# file: tools_treecluster.pl #
# 'msparser' toolkit example code #
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1998-2012 Matrix Science Limited All Rights Reserved. #
# #
##############################################################################
# $Source: parser/examples/test_perl/tools_treecluster.pl $ #
# $Author: villek@matrixscience.com $ #
# $Date: 2018-07-30 16:23:53 +0100 $ #
# $Revision: 1b450440f9c97e1e41d0fc6016a27d68951d4532 | MSPARSER_REL_3_0_0-2024-09-24-0-g93ebaeb4f4 $ #
# $NoKeywords:: $ #
##############################################################################
use strict;
use warnings;
##############################################################################
use msparser;
my $rows = 11;
my $cols = 5;
my $tc = msparser::ms_treecluster->new($rows, $cols);
my $data = new msparser::vectord;
my $mask = new msparser::vectori;
$data->push(1.623866862); $data->push(-0.052894948); $data->push(1.182692298); $data->push(2.298658316); $data->push(1.13422094);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(0 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.156396617); $data->push(0.0000000000); $data->push(0.521050737); $data->push(1.544979883); $data->push(0.65718266);
$mask->push(1); $mask->push(0); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(1 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.523561956); $data->push(-0.017417053); $data->push(1.168000125); $data->push(2.459693903); $data->push(1.308011315);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(2 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.55875743); $data->push(-0.241270432); $data->push(0.440420721); $data->push(2.427337989); $data->push(1.043344505);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(3 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.449957484); $data->push(-0.169744676); $data->push(0.867896464); $data->push(2.418999465); $data->push(1.171206827);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(4 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.171206827); $data->push(0.0000000000); $data->push(0.854394678); $data->push(2.075532631); $data->push(0.950095094);
$mask->push(1); $mask->push(0); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(5 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.361768359); $data->push(-0.120294234); $data->push(0.992043276); $data->push(2.238786860); $data->push(1.090175950);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(6 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.781149852); $data->push(0.0028825090); $data->push(1.079975377); $data->push(2.464929601); $data->push(1.301002256);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(7 , $data, $mask); $data->clear(); $mask->clear();
$data->push(-1.227692025);$data->push(-3.522840789); $data->push(-2.434402824);$data->push(-0.873027144);$data->push(-1.977099598);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(8 , $data, $mask); $data->clear(); $mask->clear();
$data->push(1.272023189); $data->push(-0.535331733); $data->push(0.608809243); $data->push(2.004681156); $data->push(0.826192536);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(9 , $data, $mask);
$data->clear(); $mask->clear();
$data->push(1.069014678); $data->push(-0.623709617); $data->push(0.412510571); $data->push(1.82822536); $data->push(0.650764559);
$mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1); $mask->push(1);
$tc->setRow(10, $data, $mask);
$data->clear(); $mask->clear();
my $weights = new msparser::vectord;
my $left = new msparser::vectori;
my $right = new msparser::vectori;
my $distance = new msparser::vectord;
if (!$tc->cluster($msparser::ms_treecluster::TCD_EUCLIDEAN,
$msparser::ms_mascotresults::TCM_PAIRWISE_AVERAGE,
$weights,
$left,
$right,
$distance)) {
print "Failed\n";
} else {
print "Node\tleft\tright\tdistance\n";
for my $i (0 .. $left->size-1) {
my $node = -1 -$i;
print $node . "\t" . $left->get($i) . "\t" . $right->get($i) . "\t" . $distance->get($i), "\n";
}
}
=pod
Running the program with no arguments, for example with
perl -I../bin treecluster.pl
will give the output:
Node left right distance
-1 6 4 0.0129355369880599
-2 2 0 0.0135342339743674
-3 7 -2 0.0168450469179865
-4 5 9 0.0227119800299183
-5 10 1 0.0249214407900278
-6 -1 -3 0.0358259860933716
-7 -4 -5 0.0759763042954681
-8 3 -6 0.098592161220467
-9 -7 -8 0.225907496391906
-10 8 -9 9.24612595642236
=cut
1.9.6