=head1 NAME

iPE::Model::Emission::WAM - Weight Array Model.

=head1 DESCRIPTION

=head1 FUNCTION

=cut

package iPE::Model::Emission::WAM;
use iPE;
use iPE::Globals;
use base("iPE::Model::Emission");
use strict;


sub init {
    my ($this) = @_;
    $this->{posCounts_}  = [];
    $this->{nullCounts_} = [];
    $this->{scores_}     = [];
    $this->{distr_}      = {};

    unless($this->hasSettings()) {
        #XXX deprecated.  remove when moving to settings format
        my ($orderstr) = split(' ', $this->{data_});
        if(defined($orderstr)) {
            if($orderstr =~ m/\//) {
                ($this->settings->{order}, $this->settings->{targetOrder}) = 
                    split(/\//, $orderstr);
            }
            else {
                ($this->settings->{order}, $this->settings->{targetOrder}) = 
                    ($orderstr, $orderstr);
            }
        }
        else {
            die ("Error in old style data string. ".
                 "Use the settings framework.\nFound in ".$this->name."\n");
        }
    }

    $this->settings->{targetOrder} ||= $this->order;
    die "WAM requires an order setting in the data attribute.\n"
        if(!defined($this->order));

    if($this->order =~ m/[^\d]/ || $this->targetOrder =~ m/[^\d]/) {
        die(__PACKAGE__.": The order and targetOrder settings for WAM must\n".
            "only contain digits.\n");
    }
}

sub clear {
    my ($this) = @_;
    my @nmers = 
        $this->seqClass->getAllSequences($this->order+1, $this->ambiguate);
    for my $pos (0 .. $this->length-1) {
        for my $nmer (@nmers) {
            $this->{posCounts_}->[$pos]->{$nmer}  = 0.;
            $this->{nullCounts_}->[$pos]->{$nmer} = 0.;
        }
    }
}

sub posCounts   { shift->{posCounts_}                   }
sub nullCounts  { shift->{nullCounts_}                  }
sub scores      { shift->{scores_}                      }
sub order       { shift->settings->{order}             }
sub targetOrder { shift->settings->{targetOrder}       }

sub countRegion     { 
    my ($this, $region) = @_;
    if($region->seq->loaded) { _count(@_, 0)            }
    else                     { _countUnloaded(@_, 0)    }
}
    
sub countNullRegion { 
    my ($this, $region) = @_;
    if($region->seq->loaded) { _count(@_, 1)            }
    else                     { _countUnloaded(@_, 1)    }
}

sub _count {
    my ($this, $region, $null) = @_;

    my $buck;
    if($null)   { $buck = $this->nullCounts }
    else        { $buck = $this->posCounts  }

    #optimization
    my $start = $region->start;
    my $order = $this->order;
    if($start < $order) { $start = $order }
    my $length = $region->end - $region->start + 1;
    my $weight = $region->weight;
    my $context = $region->context;
    my $strRef = $region->strRef;

    my $nmer;
    for my $pos (0 .. $length-1) {
        #get the n-mer from the string that we're counting
        $nmer = substr($$strRef, $start+$pos-$order, $order+1);

        $buck->[$pos+$context]->{$nmer} += $weight;
    }
}

sub _countUnloaded {
    my ($this, $region, $null) = @_;

    my $buck;
    if($null)   { $buck = $this->nullCounts }
    else        { $buck = $this->posCounts  }

    #optimization
    my $start = $region->start;
    my $order = $this->order;
    if($start < $order) { $start = $order }
    my $length = $region->end - $region->start + 1;
    my $targetOrder = $this->targetOrder;
    my $weight = $region->weight;
    my $context = $region->context;
    my $strRef = $region->strRef;

    my $strand = $region->strand;
    my $seq = $region->seq;
    my $nmer;
    for my $pos (0 .. $length-1) {
        #get the n-mer from the string that we're counting
        $nmer = $seq->getContext($strand, $start+$pos, $order, $targetOrder);

        $buck->[$pos+$context]->{$nmer} += $weight;
    }
}

sub getZoeHeaderEnd {
    my $this = shift;
    return "" if(!defined($this->order));
    return $this->order;
}

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

    for my $pos (0 .. $this->length-1) {
        if($this->ambiguate && 
                $this->wildcard == iPE::Model::Emission::LEXICAL()) { 
            $this->lexicalAmbiguateMarkovChain($this->posCounts->[$pos],
                $this->order);
            $this->lexicalAmbiguateMarkovChain($this->nullCounts->[$pos],
                $this->order);
        }
        $this->pseudocountSmoother->smoothHref($this->posCounts->[$pos]);
        $this->pseudocountSmoother->smoothHref($this->nullCounts->[$pos]) 
            if($this->nullModel);
        $this->smoother->smoothHref($this->posCounts->[$pos]);
        $this->smoother->smoothHref($this->nullCounts->[$pos]) 
            if($this->nullModel);
    }
}


sub normalize {
    my ($this) = @_;
    
    my @nmers = $this->seqClass->getAllSequences($this->order, $this->ambiguate);
    #whether or not we have a null model.
    my $nullModel = $this->nullModel;
    my $wildCard = $this->seqClass->getWildCard;
    my @alphabet = @{$this->seqClass->getAlphabet};
    push @alphabet, $this->seqClass->getWildCard 
        if($this->ambiguate && $this->wildcard == iPE::Model::Emission::LITERAL());
    for my $pos (0 .. $this->length-1) {
        for my $nmer (@nmers) {
            my $totCounts = 0;
            my $totNullCounts = 0;
            for my $l (@alphabet) {
                $totCounts += $this->posCounts->[$pos]->{$nmer.$l};
                $totNullCounts += $this->nullCounts->[$pos]->{$nmer.$l} 
                    if($nullModel);
            }
            for my $l (@alphabet) {
                $this->posCounts->[$pos]->{$nmer.$l} /= $totCounts
                    if($totCounts);
                $this->nullCounts->[$pos]->{$nmer.$l} /= $totNullCounts 
                    if($totNullCounts && $nullModel);
            }
            if($this->ambiguate && 
                        $this->wildcard == iPE::Model::Emission::LEXICAL()) { 
                $this->posCounts->[$pos]->{$nmer.$wildCard} = 1;
                $this->nullCounts->[$pos]->{$nmer.$wildCard} = 1;
            }
        }
    }
}

sub _adjustProb {
    my ($this, $pos, $letter, $prior, $null) = @_;

    my $buck;
    if($null)   { $buck = $this->nullCounts }
    else        { $buck = $this->posCounts  }

    #adjust the position to adjust according to the beginning position of the
    #model
    $pos -= $this->interval->low->coord;
    for my $nmer (keys %{$buck->[$pos]}) {
        if($nmer =~ m/$letter$/) {
            $buck->[$pos]->{$nmer} *= $prior;
        }
    }
}

sub adjustPosProb  { _adjustProb(@_, 0) }
sub adjustNullProb { _adjustProb(@_, 1) }

sub setNullProb {
    my ($this, $pos, $letter, $prior) = @_;

    #adjust the position to adjust according to the beginning position of the
    #model
    $pos -= $this->interval->low->coord;
    for my $nmer (keys %{$this->nullCounts->[$pos]}) {
        if($nmer =~ m/$letter$/) {
            $this->nullCounts->[$pos]->{$nmer} = $prior;
        }
    }
}

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

    my $g = new iPE::Globals();
    my @nmers = 
        $this->seqClass->getAllSequences($this->order+1, $this->ambiguate);
    my $scale = $g->options->scaleFactor;
    my $negInf = $g->options->sequenceNegInf;
    my $nullModel = $this->nullModel;

    for my $pos (0 .. $this->length-1) {
        for my $nmer (@nmers) {
            if($nullModel) {
                $this->{scores_}->[$pos]->{$nmer} = 
                    $this->logScore($this->{posCounts_}->[$pos]->{$nmer},
                        $this->{nullCounts_}->[$pos]->{$nmer});
            }
            else {
                $this->{scores_}->[$pos]->{$nmer} = 
                    $this->logScore($this->{posCounts_}->[$pos]->{$nmer});
            }
        }
        if($this->ambiguate && 
                $this->wildcard == iPE::Model::Emission::PENALTY()) {
            $this->penalizeAmbiguousNmers($this->{scores_}->[$pos], 
                $this->order);
        }
    }
}

sub adjustScore {
    my ($this, $pos, $letter, $score) = @_;

    for my $nmer (keys %{$this->nullCounts->[$pos]}) {
        if($nmer =~ m/$letter$/) {
            $this->scores->[$pos-$this->interval->low->coord]->{$nmer} 
                += $score;
        }
    }
}

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

    my $pstring = "";
    my $nullModel = $this->nullModel;
    my @nmers = $this->seqClass->getAllSequences($this->order,$this->ambiguate);
    my @alphabet = @{$this->seqClass->getAlphabet};
    push @alphabet, $this->seqClass->getWildCard if($this->ambiguate);
    for my $pos (0 .. $this->length-1) {
        for my $nmer (@nmers) {
            $pstring .= $nmer.$out->tab if($mode ne "score"); 
            for my $l (@alphabet) {
                if($mode eq "count" || $mode eq "prob") {
                    $pstring .= 
                        $out->floatf($this->posCounts->[$pos]->{$nmer.$l}); 
                        if($nullModel) {
                            $pstring .= " | ".
                            $out->floatf($this->nullCounts->[$pos]->{$nmer.$l});
                        }
                    $pstring .= $out->tab; 
                }
                elsif($mode eq "score") {
                    $pstring .= $out->intf($this->scores->[$pos]->{$nmer.$l}).
                                $out->tab;
                }
            }
            $pstring .= "\n";
        }
    }

    $this->setParamString($pstring);
}

=head1 SEE ALSO

L<iPE::Model::Emission>

=head1 AUTHOR

Bob Zimmermann (rpz@cse.wustl.edu)

=cut

1;
