# $Id: 06-tree.t 1566 2010-12-09 02:51:34Z rvos $
use strict;
use Bio::Phylo::Util::CONSTANT 'looks_like_instance';
use Test::More 'no_plan';
use Bio::Phylo::IO qw(parse unparse);
use Bio::Phylo::Forest::Node;
use Bio::Phylo::Forest::Tree;

my $data;
while (<DATA>) {
    $data .= $_;
}

Bio::Phylo->VERBOSE( -level => 0 );

ok( 1, '1 init' );

ok( my $trees = parse(
    -string => $data,
    -format => 'newick' ),
'2 parse' );

ok( my $treeset = $trees->get_entities, '3 trees' );
my $tree        = $treeset->[0];
my $unresolved  = $treeset->[2];

ok( my $root       = $tree->get_root,           '4 get root' );
ok( my $node       = $root->get_first_daughter, '5 get first daughter' );
ok( my $other_node = $root->get_last_daughter,  '6 get last daughter' );
ok( my $children   = $root->get_children,       '7 get children' );

# get
ok( $tree->get('calc_tree_length'), '8 get ctl' );
ok( $tree->get_entities,            '9 get n' );
ok( $tree->get_internals,           '10 get int' );
ok( $tree->get_terminals,           '11 get term' );

#ok($tree->get_by_name('cherry'),                                   '12 gbn');
ok( $tree->get_by_value(
    -value => 'get_branch_length',
    -lt    => 0.5 ),
'12 get lt' );

ok( $tree->get_by_value(
    -value => 'get_branch_length',
    -eq    => 2 ),
'13 get eq' );

ok( $tree->get_by_value(
    -value => 'get_branch_length',
    -le    => 0.4 ),
'14 get le' );

ok( $tree->get_by_value(
    -value => 'get_branch_length',
    -ge    => 0.1 ),
'15 get ge' );

ok( $tree->get_by_value(
    -value => 'get_branch_length',
    -gt    => 0.2 ),
'16 get gt' );

ok( $tree->is_binary, '17 is binary' );

# methods on unresolved tree
ok( !$unresolved->is_binary,             '18 is binary' );
ok( !$unresolved->is_ultrametric,        '19 is ultrametric' );

eval { $unresolved->calc_rohlf_stemminess };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ), '20 calc rohlf stemminess: ' . ref($@));

eval { $unresolved->calc_imbalance };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ), '21 calc imbalance' );

eval { $unresolved->calc_branching_times };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ), '22 calc branching times' );

eval { $unresolved->calc_ltt };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ), '23 calc ltt' );

eval { $tree->insert('BAD!') };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ), '24 insert bad obj' );

# tests
ok( !$tree->is_ultrametric(0.01), '25 is ultrametric' );
ok( !$tree->is_monophyletic( $children, $node ), '26 not monophyletic' );

# test for monophyly
my $poly = $unresolved->get_by_regular_expression(
    -value => 'get_name',
    -match => qr/^poly$/
);

my $e = $unresolved->get_by_regular_expression(
    -value => 'get_name',
    -match => qr/^E$/
);

my $desc = $poly->[0]->get_descendants;

ok( $tree->is_monophyletic( $desc, $e->[0] ), '27 is monophyletic' );

# calculations
ok( $tree->calc_tree_length,         '28 calc tree length' );
ok( $tree->calc_tree_height,         '29 calc tree height' );
ok( $tree->calc_number_of_nodes,     '30 calc num nodes' );
ok( $tree->calc_number_of_terminals, '31 calc num terminals' );
ok( $tree->calc_number_of_internals, '32 calc num internals' );
ok( $tree->calc_total_paths,         '33 calc total paths' );
ok( $tree->calc_redundancy,          '34 calc redundancy' );
ok( $tree->calc_imbalance,           '35 calc imbalance' );

# balance calculation
my $balanced = $treeset->[3];
ok( $tree->calc_imbalance, '36 calc imbalance' );

# ultrametric calculations
ok( $tree = $tree->ultrametricize, '37 ultrametricize' );
ok( $tree->calc_fiala_stemminess, '38 calc fiala stemminess' );
ok( $tree->calc_rohlf_stemminess, '39 calc rohlf stemminess' );
ok( $tree->calc_resolution,       '40 calc resolution' );
ok( $tree->calc_branching_times,  '41 calc branching times' );
ok( $tree->calc_ltt,              '42 calc ltt' );
ok( $tree->scale(10),             '43 scale' );

# testing on undef branch lengths
my $undef = $treeset->[3];
$root = $undef->get_root;

eval { $undef->calc_rohlf_stemminess };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ), '44 calc rohlf stemminess: ' . ref($@) );

eval { $undef->get('BAD!') };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ), '45 bad arg get' );
ok( $undef->calc_imbalance,         '46 calc imbalance' );

# trying to create a cyclical tree, no mas!
my $node1    = new Bio::Phylo::Forest::Node;
my $node2    = new Bio::Phylo::Forest::Node;
my $cyclical = new Bio::Phylo::Forest::Tree;
$node1->set_parent($node2);
$node2->set_parent($node1);
$cyclical->insert($node1);
$cyclical->insert($node2);
ok( $cyclical->get_root, '47 no root in cycle' );
ok( $tree->DESTROY, '48 destroy' );

my $left  = '((((A,B),C),D),E);';
my $right = '(E,(D,(C,(A,B))));';
my $ladder = parse( '-format' => 'newick', '-string' => $left )->first;
ok( $ladder->ladderize->to_newick eq $right, '49 ladderize' );

{
    my $n1 = '((C:0,(B:0,A:0):7):3,D:0):0;';
    my $n2 = '(((A:0,B:0):4,C:0):6,D:0):0;';
    my $n3 = '((A,B,C),D);';
    my $t1 = parse( '-format' => 'newick', '-string' => $n1 )->first;
    my $t2 = parse( '-format' => 'newick', '-string' => $n2 )->first;
    my $t3 = parse( '-format' => 'newick', '-string' => $n3 )->first;
    ok( $t1->calc_branch_length_score( $t2 ) == 18, "50 branch length score" );
    ok( $t1->calc_symdiff( $t2 ) == 0, "51 calc symdiff" );
    ok( $t1->calc_symdiff( $t3 ) == 1, "52 calc symdiff" );
}

{
    my $newick = '(((a:100,b:1)n1:1,c:1)n2:1,((((d:1,e:1)n3:1,f:1)n4:1,g:1)n5:1,h:1)n6:1)n7:0;';
    my $tree = parse( '-format' => 'newick', '-string' => $newick )->first;
    my $focal = $tree->get_by_name('b');
    my $farthest_nodal = $focal->get_farthest_node;
    my $fn_name = $farthest_nodal->get_name;
    ok( ( $fn_name eq 'd' or $fn_name eq 'e' ), "53 farthest by nodal" );
    my $farthest_patristic = $focal->get_farthest_node(1);
    my $fp_name = $farthest_patristic->get_name;
    ok( $fp_name eq 'a', "54 farthest by patristic");
    ok( $tree->get_midpoint->get_name eq 'n1', "55 gets midpoint node");
}

{
    my $newick = '((a:1,b:1)n1:1,c:2)n2:0;';
    my $tree = parse( '-format' => 'newick', '-string' => $newick )->first;
    $tree->calc_node_ages;
    is( $tree->get_by_name('n1')->get_generic('age'), 1, "56 calc node age" );
    is( $tree->get_by_name('n2')->get_generic('age'), 2, "57 calc node age" );    
}


{
    my $newick = '((a:1,b:1)n1:1,(c:2,d:2))n2:0;';
    my $tree = parse( '-format' => 'newick', '-string' => $newick )->first;
    is( $tree->calc_number_of_cherries, 2, "58 calc number of cherries" );
}

{
    my $newick = '((a:1,b:1)n1:1,(c:2,d:2)n2:1)n3:0;';
    my $tree = parse( '-format' => 'newick', '-string' => $newick )->first;
    $tree->chronompl;
    is ( $tree->get_by_name('n1')->get_branch_length, 1.5, '59 chronompl' );
    is ( $tree->get_by_name('n2')->get_branch_length, 0.5, '60 chronompl' );
}

{
    my $newick = '((((A,B),C),(D,F)),E);';
    my $tree = parse( '-format' => 'newick', '-string' => $newick )->first;
    ok( $tree->is_ultrametric, '61 grafen branch lengths' );
}

{
    my $newick = '((((((A:6,B:6):5,C:11):4,D:15):3,E:18):2,F:20):1,G:21):0;';
    my $tree = parse( '-format' => 'newick', '-string' => $newick )->first;
    my $bt = $tree->calc_waiting_times;
    for my $i ( 0 .. $#{ $bt } ) {
        is( $bt->[$i]->[1], $i, '62 waiting times' );
    }
}
__DATA__
((H:1,I:1):1,(G:1,(F:0.01,(E:0.3,(D:2,(C:0.1,(A:1,B:1)cherry:1):1):1):1):1):1):0;
(H:1,(G:1,(F:1,((C:1,(A:1,B:1):1):1,(D:1,E:1):1):1):1):1):0;
(H:1,(G:1,(F:1,((C:1,(A:1,I:1,B:1)poly:1):1,(D:1,E:1):1):1):1):1):0;
((((A,B),(C,D)),(E,F)),((G,H),(I,J)));

