# -*-Perl-*- Test Harness script for Bioperl
# $Id$

use strict;

BEGIN {
  use lib '.';
  use Bio::Root::Test;
  use File::Temp qw(tempfile);
  test_begin( -tests => 40 );
  use_ok('Bio::Tree::Node');
  use_ok('Bio::Tree::AlleleNode');
  use_ok('Bio::TreeIO');
}

my $node1 = Bio::Tree::Node->new();
my $node2 = Bio::Tree::Node->new();
ok( $node1->is_Leaf() );
is( $node1->ancestor, undef );

# tests for tags
ok !$node1->has_tag('test');
is $node1->add_tag_value( 'test', 'a' ), 1;
ok $node1->has_tag('test');
is $node1->add_tag_value( 'test', 'b' ), 2;
my @tags = $node1->get_tag_values('test');
is scalar @tags, 2;
is scalar $node1->get_tag_values('test'), 'a', 'retrieve the first value';

is $node1->remove_tag('test2'), 0;
is $node1->remove_tag('test'),  1;
ok !$node1->has_tag('test');
is $node1->set_tag_value( 'test', ( 'a', 'b', 'c' ) ), 3;
is $node1->remove_all_tags(), undef;
ok !$node1->has_tag('test');

my $pnode = Bio::Tree::Node->new();
$pnode->add_Descendent($node1);
is( $node1->ancestor, $pnode );
$pnode->add_Descendent($node2);
is( $node2->ancestor, $pnode );

ok( !$pnode->is_Leaf );

my $phylo_node = Bio::Tree::Node->new(
  -bootstrap => 0.25,
  -id        => 'ADH_BOV',
  -desc      => 'Taxon 1'
);
$node1->add_Descendent($phylo_node);
ok( !$node1->is_Leaf );
is( $phylo_node->ancestor,    $node1 );
is( $phylo_node->id,          'ADH_BOV' );
is( $phylo_node->bootstrap,   0.25 );
is( $phylo_node->description, 'Taxon 1' );

is $phylo_node->ancestor($node2), $node2;
ok $node1->is_Leaf;
is my @descs = $node2->each_Descendent, 1;
is $descs[0], $phylo_node;

my $allele_node = Bio::Tree::AlleleNode->new();
$allele_node->add_Genotype(
  Bio::PopGen::Genotype->new(
    -marker_name => 'm1',
    -alleles     => [0]
  )
);
$allele_node->add_Genotype(
  Bio::PopGen::Genotype->new(
    -marker_name => 'm3',
    -alleles     => [ 1, 1 ]
  )
);
$allele_node->add_Genotype(
  Bio::PopGen::Genotype->new(
    -marker_name => 'm4',
    -alleles     => [ 0, 4 ]
  )
);
ok($allele_node);
my @mkrs = $allele_node->get_marker_names;

is( @mkrs, 3 );
my ($m3) = $allele_node->get_Genotypes( -marker => 'm3' );
is( $m3->get_Alleles, 2 );
my ($a1) = $allele_node->get_Genotypes( -marker => 'm1' )->get_Alleles;
is( $a1, 0 );

my ( $a2, $a3 ) = $allele_node->get_Genotypes( -marker => 'm4' )->get_Alleles;
is( $a2, 0 );
is( $a3, 4 );

# bug 2877
my $str = "(A:52,(B:46,C:50):11,D:70)68"; 
my $in = Bio::TreeIO->new(
  -internal_node_id => 'bootstrap',
  -format => 'nhx',
  -string => $str,
);
my $t = $in->next_tree;
  my $s;
  my $old_root = $t->get_root_node();
  my ($b) = $t->find_node( -id => "B" );
  my $b_anc = $b->ancestor;

  my $r = $b->create_node_on_branch( -FRACTION => 0.5 );
  $r->id('fake');

  # before reroot
  is( $t->as_text('newick',$in->params), "(A:52,(C:50,(B:23)fake:23):11,D:70)68;", 'with fake node' );

  # after reroot
  $t->reroot($r);
  is( $t->as_text('newick',$in->params), "(B:23,(C:50,(A:52,D:70)68:11):23)fake;",
    "after reroot on fake node" );
  $t->reroot($b);

  is( $t->as_text('newick',$in->params), "(((C:50,(A:52,D:70)68:11):23)fake:23)B;", "reroot on B" );

  $t->reroot($b_anc);
  $t->splice( -remove_id => 'fake' );

  is(
    $t->as_text('newick',$in->params),
    "(B:23,C:50,(A:52,D:70)68:11);",
    "remove fake node, reroot on former B anc"
  );
  $t->reroot($old_root);
  is( $t->as_text('newick',$in->params), "(A:52,(B:23,C:50):11,D:70)68;", "roundtrip" );