=head1 NAME

iPE::State::Transitions - Counts and normalizes the probabilities for successor transitions for all states.

=head1 DESCRIPTION

Every state has a transition object associated with it, which contains all the outbound transitions of the state.  This is in turn used to estimate parameters for transitioning to states.

=cut

package iPE::State::Transitions;

use iPE;
use iPE::Globals;
use iPE::State::PseudoTransition;

use strict;

=head1 FUNCTIONS

=over 8

=item new(source, stateList, statesRef)

Create a new transition list for the "source" state.  This does not initialize the ISO levels for the transition, and thus does not initialize the parameters.  Call setISOs () for that.  statesRef is a reference to an array of states.  This gives ready access to the pseudoStates associated with each state.

=cut

sub new {
    my ($class, $source, $list) = @_;
    my $this = bless {}, $class;


    $this->{source_} = $source;
    $this->{dests_}  = [ split (" ", $list) ];
    $this->{counts_} = undef;
    $this->{ISOs_} = undef;
    $this->{fixedValues_} = {};
    $this->{fixed_} = 0;

    $this->{pseudoTransitions_} = {};
    for my $dest (@{$this->{dests_}}) {
        $this->{pseudoTransitions_}->{$dest} = [];
    }

    return $this;
}

sub source              { shift->{source_} }
sub dests               { shift->{dests_}  }
sub pseudoTransitions   { shift->{pseudoTransitions_} }
sub counts              { shift->{counts_}  }
sub ISOs                { shift->{ISOs_}    }
sub fixedValues         { shift->{fixedValues_} }
sub fixed               { shift->{fixed_} }

=item addPseudoTransition(attributes)

Add a pseudo transition as defined in the XML file.  A pseudo transition is a transition between at least one pseudostate and another state.  It has the same transition probability as its "parent" transition.  No pseudo transition is estimated.

=cut

sub addPseudoTransition {
    my ($this, $att) = @_;

    die "Cannot add pseudotransition to source state ".$this->source.
        " for source ".$att->{source}."\n" if ($this->source ne $att->{source});
    
    die "Cannot add pseudotransition to source state ".$this->source.
        " for dest ".$att->{dest}.":\ntransition does not exist.\n" 
        if (not defined $this->pseudoTransitions->{$att->{dest}});

    my $pseudoTransition 
        = new iPE::State::PseudoTransition($att->{pseudo_source}, 
                                           $att->{pseudo_dest});
    push (@{$this->pseudoTransitions->{$att->{dest}}}, $pseudoTransition);
}

=item fixTransition (dest, values,...)

Fixes the transition probability from this Transitions' source to the passed destination to the values passed.  Script will die if the destination name does not exist on this transition, or if the number of values passed do not match the number of iscochore levels used for this transition.

=cut
sub fixTransition {
    my ($this, $dest, @values) = @_;

    my $found = 0;
    for (@{$this->dests}) { $found = 1 if($_ eq $dest) }
    die "Attempt to fix transition from $this->{source_} to $dest ".
        "when no such transition exists\n" if (!$found);

    die "Number of fixed transition values from $this->{source_} to $dest\n".
        "does not match isochore levels for the transition model.\n"
        if(scalar(@values) != $this->ISOs->nLevels);

    $this->{fixedValues_}->{$dest} = {};
    for my $level (@{$this->ISOs->levels}) {
        $this->{fixedValues_}->{$dest}->{"$level"} = shift @values;
    }
}

=item nDests ()

Returns the actual number of transitions from an object, excluding pseudo transitions.

=cut
sub nDests { scalar (@{shift->{dests_}}) }

=item nTotDests ()

Returns the total number of destination states and pseudo destintation states in this Transitions object.

=cut
sub nTotDests { 
    my $this = shift;
    my $nDests = scalar(@{$this->{dests_}});
    my $nPseudoTransitions = 0;

    for my $dest (@{$this->dests}) {
        for my $pseudoTransition (@{$this->pseudoTransitions->{$dest}}) {
            $nPseudoTransitions++;
        }
    }

    return ($nDests+$nPseudoTransitions);
}

=item setISOs(ISO, pseudocount)

Initialize the successor states for each ISO level and a given pseudocount.

=cut

sub setISOs {
    my ($this, $ISO, $pseudocount) = @_;

    $this->{counts_} = {};
    $this->{ISOs_} = $ISO;
    for my $level (@{$this->ISOs->levels}) {
        for my $name (@{$this->{dests_}}) {
            $this->{counts_}->{$name}->{"$level"} = $pseudocount;
        }
    }
}

=item count (destFeature, weight)

Counts a transition from the source state of this object to the state of the passed destination feature.

=cut
sub count {
    my ($this, $destFeature, $wt) = @_;

    my $level = $this->ISOs->snap($destFeature->gcLevel);
    my $destName = $destFeature->state->name;
    if (!defined $this->counts->{$destName}) {
        Warn("No defined transition from $this->{source_} to $destName ".
            "in transcript ".$destFeature->id."\n");
    }
    else {
        $this->counts->{$destName}->{"$level"} += $wt;
    }
}

=item normalize ()

Normalizes the counts to probabilities.

=cut
sub normalize {
    my ($this) = @_;

    for my $level (@{$this->ISOs->levels}) {
        my $totCounts = 0;
        for my $destName (keys %{$this->counts}) {
            next if (defined $this->fixedValues->{$destName});
            $totCounts += $this->counts->{$destName}->{"$level"};
        }
        my $totFixed = 0;
        for my $destName (keys %{$this->counts}) {
            if (defined $this->fixedValues->{$destName}) {
                $totFixed += $this->fixedValues->{$destName}->{"$level"};
            }
        }
        my $remainingDist = 1 - $totFixed;
        for my $destName (keys %{$this->counts}) {
            $this->counts->{$destName}->{"$level"} /= $totCounts if($totCounts);
            $this->counts->{$destName}->{"$level"} *= $remainingDist;
        }
    }
}

=item outputPrepare (out, mode)

Prepare the output object for outputting to a Zoe format.  Must be applied to all transition objects before any transition object is outputted.

=cut
sub outputPrepare {
    my ($this, $out, $mode) = @_;

    $out->addWord("State::Transitions::source", $this->source);
    for my $dest (@{$this->dests}) {
        $out->addWord("State::Transitions::dests", $dest);
        for my $pseudoTransition (@{$this->pseudoTransitions->{$dest}}) {
            $out->addWord("State::Transitions::source", $pseudoTransition->src);
            $out->addWord("State::Transitions::dests", $pseudoTransition->dest);
        }
    }
}

=item outputZoe (out, mode)

Output all the destination state probabilities to the output object in Zoe format.

=cut

sub outputZoe {
    my ($this, $out) = @_;
    my $paramHash;

    for my $dest (@{$this->dests}) {
        if(defined $this->fixedValues->{$dest}) {
            $paramHash = $this->fixedValues->{$dest};
        }
        else {
            $paramHash = $this->counts->{$dest};
        }

        $out->print (
            $out->wordf("State::Transitions::source", $this->source).
            $out->wordf("State::Transitions::dests",  $dest));
        for my $level (@{$this->ISOs->levels}) {
            $out->print($out->floatf($paramHash->{"$level"}));
        }
        $out->print("\n");

        for my $pseudoTransition (@{$this->pseudoTransitions->{$dest}}) {
                $out->print (
            $out->wordf("State::Transitions::source", $pseudoTransition->src).
            $out->wordf("State::Transitions::dests",  $pseudoTransition->dest));
            for my $level (@{$this->ISOs->levels}) {
                $out->print($out->floatf($paramHash->{"$level"}));
            }
            $out->print("\n");
        }
    }
}

=back

=head1 SEE ALSO

L<iPE::State>

=head1 AUTHOR

Bob Zimmermann (rpz@cse.wustl.edu)

=cut

1;
