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