1#!/usr/bin/perl -w 2 3###################################################### 4# Author: Chengzhi Liang, Weigang Qiu, Peter Yang, Thomas Hladish, Brendan 5# $Id: tree_methods-02.t,v 1.6 2010/09/22 19:59:00 astoltzfus Exp $ 6# $Revision: 1.6 $ 7 8 9# Written by Vivek Gopalan (gopalan@umbi.umd.edu) 10# Reference : perldoc Test::Tutorial, Test::Simple, Test::More 11# Date : 28th July 2006 12 13use Test::More 'no_plan'; 14use strict; 15use warnings; 16use Data::Dumper; 17use Bio::NEXUS; 18 19my ($tree,$tree_block,$text_value, $nexus_obj); 20 21 22################## 1. Tree functions test ###################################### 23 24 25print "---- Test for various functions in the Bio::NEXUS::Tree and Bio::NEXUS::Node modules\n"; 26 27 28$text_value =<<STRING; 29#NEXUS 30 31BEGIN TAXA; 32 dimensions ntax=8; 33 taxlabels A B C D E F G H; 34END; 35 36BEGIN TREES; 37 tree basic_ladder = (((((((A:3,B:1):1[100],C:2):1[90],D:3):1[80],E:4):1[70],F:5):1[60],G:6):1[50],H:7):1[40]; 38 39END; 40 41STRING 42 43# tree basic = (((((((A:1,B:1)inode7:1[100],C:2)inode6:1[90],D:3)inode5:1[80],E:4)inode4:1[70],F:5)inode3:1[60],G:6)inode2:1[50],H:7)root[40]; 44 45# +-----A 46# +---+ 47# | +-----B 48# +---+ 49# +----+ +---------C 50# | | 51# +---+ +-------------D 52# | | 53# +---+ +------------------E 54# | | 55# +---+ +----------------------F 56# | | 57# + +--------------------------G 58# | 59# +------------------------------H 60 61 62 63eval { 64 $nexus_obj = new Bio::NEXUS; 65 $nexus_obj->read({'format'=>'string','param'=>$text_value}); # create an object 66 $tree_block = $nexus_obj->get_block('trees'); 67}; 68 69is( $@,'', 'TreesBlock object created and parsed'); # check that we got something 70 71#$nexus_obj->write("test1.nex"); 72$tree = $tree_block->get_tree(); 73 74my $node_H = $tree->find('H'); 75my $node_A = $tree->find('A'); 76 77print $tree->as_string,"\n"; 78 79is(@{$tree->get_nodes}, 15, "15 nodes defined: 8 otus + 7 root"); 80 81## Testing Functions on Root node 82print "#### Testing node functions on Root node\n"; 83 84my $root_node = $tree->get_rootnode; 85is($root_node->get_parent, undef, "Rootnode parent is not defined"); 86is($root_node->get_length, 1, "Branch length of root node is correct"); 87is(@{$root_node->get_children}, 2, "No. of children for root node is correct"); 88is($root_node->get_total_length,38, "Total lengths of the branches from the root node is correct"); ### ???? 89is($root_node->get_support_value,40, "Root node support value is correct"); 90is($root_node->get_name,"root", "Root name label is correct"); 91is($root_node->get_depth,0, "Depth of root node is correct"); 92is($root_node->get_distance($node_H),7, "Distance of root to node H is correct"); 93is($root_node->get_distance($node_A),9, "Distance of root to node A is correct"); 94is($root_node->is_sibling($node_H), 0, "Node H is not the sibilings of the rootnode"); 95is(@{$root_node->get_siblings},0, " No siblings to the root node"); 96is($root_node->is_otu,0, "Root node identified as OTU or (Terminal Node) correctly"); 97is($root_node->is_otu,0, "Root node identified as OTU or (Terminal Node) correctly"); 98#is($root_node->prune); 99 100is($node_A->mrca($node_H)->get_name,'root', "Most recent common ancestor of node A and H is identified correctly"); 101#mrca of A is B = mrca of B is A 102is($node_H->mrca($node_A)->get_name,'root', "Most recent common ancestor of node A and H is identified correctly"); 103 104#Consistency check - Distance from A to B = distance from B to A 105is($root_node->get_distance($node_H),$node_H->get_distance($root_node), "Consistency check for the distance between nodes: distance(AB) = distance(BA)"); 106 107print "#### Testing node functions on node H\n"; 108 109is($node_H->get_parent->get_name, 'root', "Parent of Node 'H' parent is defined correctly"); 110is($node_H->get_length, 7, "Branch length of node H is correct"); 111is(@{$node_H->get_children}, 0, "No. of children for Node H is correct"); 112is($node_H->get_total_length,7, "Total lengths of the branches the node H is correct"); ### ???? 113is($node_H->get_support_value,undef, "Node H support value is correct"); 114is($node_H->get_name,'H', "Node H label is correct"); 115is($node_H->get_depth,1, "Depth of Node H is correct"); 116is($node_H->get_distance($root_node),7, "Distance of node H to root node is correct"); 117is($node_H->get_distance($node_A),16, "Distance of node H to node A is correct"); 118is($node_H->is_sibling($node_A), 0, "Node A is not the sibilings of Node H"); 119is(@{$node_H->get_siblings},1, "No. of siblings to the Node H is correct"); 120is($node_H->is_otu,1, "Node H identified as an OTU (Terminal Node) correctly"); 121 122print "#### Testing node functions on cloned node H\n"; 123# Cloned nodes properties 124my $node_H_clone = $node_H->clone; 125 126$node_H_clone->set_length(10); 127$node_H_clone->set_support_value(100); 128$node_H_clone->set_name('H_clone'); 129 130#Checking the original and the cloned nodes 131is($node_H->get_name,'H', "(Original) node name label is correct"); 132is($node_H->get_length,7, "(Original) depth of node H is correct"); 133is($node_H->get_support_value,undef, "(Original) node H support value is correct"); 134is($node_H_clone->get_name,'H_clone', "(Cloned) node name label is correct"); 135is($node_H_clone->get_depth,1, "(Cloned) depth of node H is correct"); 136is($node_H_clone->get_support_value,100, "(Cloned) node H support value is correct"); 137 138 139