Using the matrix_science::ms_treecluster class.
#!/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_2_8_1-0-gea32989045 $ # # $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
Copyright © 2022 Matrix Science Ltd. All Rights Reserved. Generated on Thu Mar 31 2022 01:12:29 |