=head1 NAME

iPE::Model::BNTree - A Bayesian Network Tree model for N-SCAN.

=head1 DESCRIPTION

This is not a traditional model in the sense of owning parameters themselves, it simply contains a tree topology and a model type.  It will accept counts in the form of a hash, and return the text needed by N-SCAN for a parameter file via the optimize function.

Example of phylogenetic tree:

	"[[galGal2:4,[mm5:2,rn3:3]],none]"

The tree is re-rooted at the target which, in this case, is human.  The target is not listed explicitly in the tree; it is listed separately.  The informants are chicken (galGal2), mouse (mm5), and rat (rn3).  The numbers following the species names and colon refer to the order in which the each species occurs in the alignment file. For example, mouse - second, rat - third, and chicken - fourth.

Valid N-SCAN models are:

=over 8 

=item TT - Transition/transversion model.

=item R  - Reversible matrix.  Probability of a transition from node a to node b is equal to transition from node b to node a.

=item G - Generalized.  All transitions, forward and reverse, are estimated.

Generally speaking, a first order reversible model (R1) is used.  All models must have an accompanying order number, (TT0, TT1, .. , G0, etc.) in the specification.

=back

=head1 METHODS

=over 8

=cut

package iPE::Model::BNTree;
use File::Temp qw(tempdir);
use base("iPE::Model"); # mostly unused, here for structural purposes.
use strict;

our %modelTypes = ( "R0"  => 1, 
                    "R1"  => 1, 
                    "R2"  => 1, 
                    "G0"  => 1, 
                    "G0"  => 1, 
                    "G0"  => 1, 
                    "TT0" => 1, 
                    "TT1" => 1, 
                    "TT2" => 1 );

=item new (topology, model-type)

Pass a topology and model type to retrieve a BNTree object.  See above for descriptions of these items.

=cut
sub new {
    my ($class, $topology, $model_type) = @_;
    my $this = bless({ topology_ => $topology,
                       type_     => $model_type }, $class);

    $this->_validate();

    return $this;
}

sub topology { shift->{topology_} }
sub type     { shift->{type_}     }
sub numNodes { shift->{numNodes_} }

sub optimizeTuples {
    my ($this, $model, $href, $order, $name) = @_;

    my $g = new iPE::Globals();
    my $basename;
    if($g->options->keepSSFiles) {
      $basename = $g->options->outputBaseDir;
    }
    else {
      $basename = tempdir( CLEANUP => 1 );
    }
    my $ssname = "$basename/$name.ss";
    open(FH, ">$ssname")
      or die("Couldn't open $ssname to write\n");

    # in order to filter out sequences with "N"s and other unacceptable
    # characters, we have to check if it matches the regExp of the alphabet
    my $legal = "[".join("", @{$model->seqClass->getAlphabet})." ]";

    my @contexts = sort(keys(%$href));
    my ($tot_counts, $counts, $ncontexts, $footer) = (0, 0, 0, "");

    for my $context (@contexts) { 
        next if($context !~ /^$legal+$/);
        my $counts = int($href->{$context} + 0.5);
        $counts = 1 if($counts == 0);
        $tot_counts += $counts;
        $footer .= "$ncontexts\t$context\t$counts\n";
        $ncontexts++;
    }
    print FH $model->getSSHeader($tot_counts, $order, $ncontexts);
    print FH $footer;
    close FH;
    my $bntree_filename = $this->optimizeSSFile($name, $ssname);
    open(BNT, $bntree_filename) or die("Bntree file missing.\n");
    my $output = join("", map { $_ if(m/\S/) } <BNT>);
    close(BNT);
    unlink($bntree_filename);

    return $output;
}

sub optimizeSSFile {
    my ($this, $name, $ssfile) = @_;
    my $g = new iPE::Globals();
    return $this->_optimizeSSFileForTreeAndModel($name, $ssfile,
        $this->topology(), $this->type(),
        $g->options->randomSeed);
}



sub _validate {
    my ($this) = @_;

    $this->_validate_topology($this->topology);
    $this->_validate_type($this->type);
}

sub _validate_topology {
my ($this, $t) = @_;

my $errmsg = "Error in formatting of nscanTopology.\n".
    "You entered \"$t\".\nThe tree should have no spaces in it.\n";

$t =~ s/^[\s]*//;
$t =~ s/[\s]*$//;

die($errmsg) if($t =~ m/\s/);
if($t !~ m/^\[/ || $t !~ m/\]$/) {
    $errmsg .= "It should begin with a [ and end with a ]\n";
    die $errmsg;
}

my $format_error = $this->_descend_tree(\$t);
die("$errmsg$format_error\n") if(length($format_error));
}

sub _descend_tree {
my ($this, $t) = @_;

$$t =~ s/^\[//;

my $msg;
$msg = $this->_check_node($t);
return $msg if(length($msg));
if($$t !~ m/^,(.*)$/) {
    return "Comma appears to be missing before $$t\n";
}
$$t = $1;
$msg = $this->_check_node($t);
return $msg if(length($msg));
if($$t !~ m/^\]/) {
    return "Tree appears unbalanced after $$t.\n";
}

$$t =~ s/^\]//;

return "";
}

sub _check_node {
my ($this, $t) = @_;

if($$t =~ m/^\[/) {
    $$t =~ s/^\[//;
    my $msg = $this->_descend_tree($t);
    return $msg if(length($msg));
}
else {
    $this->{numNodes_}++ unless($$t =~ m/^none/);
    unless($$t =~ m/^[^:]+:\d+(.*)$/ || $$t =~ m/^none(.*)$/) {
        return "Bad node format: $$t\n".
            "Should be species_name:alignment_pos, e.g. mm5:2\n";
    }
    $$t = $1;
}
return "";
}

sub _validate_type {
my ($this, $type) = @_;

my $errmsg = __PACKAGE__.": Invalid tree type $type.\n".
  "Valid types are ".join(".", keys(%modelTypes)).".\n";
die($errmsg) unless(defined($modelTypes{$type}));
}


=back

=head1 SEE ALSO

L<iPE> L<iPE::Model::Emission> 

=head1 AUTHOR

Bob Zimmermann (rpz@cse.wustl.edu).

=cut
1;
