=head1 NAME

iPE::Model::EmissionChain - Defines a series of emission models. 

=head1 DESCRIPTION

Defines a chain of emission models tied to an emission sequence.  Resolves all the subregions and sends the region to the emission models.

=head1 FUNCTIONS

=over 8

=cut

package iPE::Model::EmissionChain;
use iPE;
use iPE::Globals;
use iPE::Util::DNATools;
use iPE::Util::Interval;
use iPE::Util::Overlap;
use iPE::Util::Overlap::Node;
use iPE::Sequence::Region;
use iPE::Model::Emission;
use strict;

=item new (name)

Create a new emission chain for the name given.  This is assumed to be associated with the name.

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

    $this->{overlap_} = new iPE::Util::Overlap;
    $this->{chain_}   = [];
    $this->{default_} = [];
    if(defined($name))  { $this->{name_} = $name                  }
    else                { $this->{name_} = "UnnamedEmissionChain" }

    return $this;
}

sub overlap { shift->{overlap_} }
sub chain   { shift->{chain_}   }
# the model which is used for all regions where there is no defined model
sub default { shift->{default_} }
sub name    { shift->{name_}   }

sub init {
    my ($this) = @_;
    $this->{overlap_} = undef;

    $this->{chain_} = 
        [ sort { $a->interval->cmp($b->interval) } @{$this->chain} ];

    #TODO: check that the min and max of the chain are covered
}

=item addEmission (emission)

Add an emission to the emission chain.  Checks if this is the default emission for the chain (meaning it has a region_begin of "." and region_end of ".") and sets it to the default, otherwise adds it to the chain.  Only one default emission is allowed per chain.

=cut
sub addEmission {
    my ($this, $emis) = @_;

    if ($emis->type == iPE::Model::Emission::DEFAULT_MODEL) {
        Warn( "Multiple default models defined for ".
            $this->name.".\n") if(scalar @{$this->default});
        push @{$this->{default_}}, $emis;
        return;
    }

    my $node = new iPE::Util::Overlap::Node( 
        { low    => $emis->interval->low->coord, 
          high   => $emis->interval->high->coord,
          letter => $emis->interval->letter } );

    my $overlap_node = $this->overlap->find_overlap($node);
    die "Region (".$node->low->coord.", ".$node->high->coord.") overlaps region (".
            $overlap_node->low->coord.", ".$overlap_node->high->coord.") for emission model ".
            $emis->name." in ".$this->name.".\n" 
        if($overlap_node);

    $this->overlap->insert($node);
    push (@{$this->{chain_}}, $emis);
}

=item partitionRegion (region)

Partitions the region on the emission chain.  Returns two array references.  The first is a parallel array of subregions to the models in the chain.  If there is no matching subregion for a given model, the value 0 is placed in lieu of a subregion.  The second is an array of default subregions.

=cut
sub partitionRegion {
    my ($this, $region) = @_;

    my @subregions; #subregions of the parent region
    my @clipped_subregions; #subregions of the main region
    for my $model (@{$this->chain}) {
        #translate the coordinates in the parent region for later reference
        #to in looking for default regions
        my $translatedCoords = 
            [ $model->interval->translate(
                $region->parentStart, $region->parentEnd) ];

        push @subregions, $translatedCoords;

        #the subregion's actual parent is the alleged start and end of the
        #model.  If this region differs from the actual region, then it changes.
        my $subregion = $region->clone;
        $subregion->parentStart($translatedCoords->[0]);
        $subregion->parentEnd($translatedCoords->[1]);

        # if the translated coordinates are outside of the boundaries of a
        # region, the boundaries of the parent region are the same as the region
        # in this case, we allow the region to step outside of the parent region
        # except in the case (below) when it steps outside of the underlying
        # sequence
        if(    ($translatedCoords->[0] < $region->parentStart && 
                $region->parentStart == $region->start) ||
               ($translatedCoords->[1] > $region->parentEnd &&
                $region->parentEnd == $region->end)) {
            $subregion->start($translatedCoords->[0]);
            $subregion->end($translatedCoords->[1]);
        }
        else {
            #now find the subregion, if it exists.  see where the region 
            #intersects with the translated coordinates, and if there is an 
            #intersection, create a subregion.
            my $intersectionCoords =
                [ intersection($region->start, $region->end, 
                    @$translatedCoords) ];
            if(scalar(@$intersectionCoords)) {
                $subregion->start($intersectionCoords->[0]);
                $subregion->end($intersectionCoords->[1]);
            }
            else { $subregion = 0; }
        }
        # as a final step, check to see if the subregion oversteps the bounds
        # of the underlying sequence.
        if($subregion) {
            my $seqIntersection = [ intersection($subregion->start, $subregion->end,
                    0, $region->seq->length - 1) ];
            $subregion->start($seqIntersection->[0]);
            $subregion->end($seqIntersection->[1]);
        }

        push @clipped_subregions, $subregion;
    }
    
    return ([@clipped_subregions], []) if(scalar(@{$this->default}) == 0);

    #now we want to find any gaps in the chain where the default region would
    #be counted.

    #first create dummy subregions at the boundaries of the feature
    my $prevCoords = [($region->start-1, $region->start-1)];
    push @subregions, [($region->end+1, $region->end+1)];

    my @default_regions;
    for my $curCoords (@subregions) {
        my ($start, $end) = ($prevCoords->[1]+1, $curCoords->[0]-1);
        if(($end-$start) > 1) {
            my $subregion = $region->clone; #subregion($start, $end);
            #$subregion->parentStart($start);
           #$subregion->parentEnd($end);
            my $intersectionCoords = 
                [ intersection($region->start, $region->end, 
                    $start, $end) ];

            #if(defined ($subregion)) {
            if(scalar(@$intersectionCoords)) {
                $subregion->start($intersectionCoords->[0]);
                $subregion->end($intersectionCoords->[1]);
                push @default_regions, $subregion;
            }
        }
        $prevCoords = $curCoords;
    }

    return ([@clipped_subregions], [@default_regions]);
}

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

    msg("Counting ".$this->name." for region (".
        $region->start.", ".$region->end.") for parent region (".
        $region->parentStart.", ".$region->parentEnd."):\n"); 

    my ($subregions, $defaults) = $this->partitionRegion($region);
    for (my $i = 0; $i < scalar(@$subregions); $i++) {
        my $model = $this->chain->[$i];
        my $curRegion = $subregions->[$i];
        next if(!ref($curRegion) || !$model->countable);

        if($model->samplingRate != 1 && rand() > $model->samplingRate) {
            msg("Skipping ".$model->name." because of sampling rate.\n");
            next;
        }

        msg("  Counting region (".$curRegion->start.", ".
            $curRegion->end.") (".$curRegion->parentStart.
            ") for model ".$model->name.".  "); 
        if ($curRegion->end-$curRegion->start < 50 && defined($region->strRef)){
            msg("Seq = ", 
                substr(${$region->strRef}, $curRegion->start,
                $curRegion->end-$curRegion->start+1));
        }
        msg("\n");

        $model->countRegion($curRegion);
    }

    if(scalar(@{$this->default})) {
        for my $defaultModel (@{$this->default}) {
            next if ($defaultModel->nullParams);
            for (my $i = 0; $i < scalar(@$defaults); $i++) {
                if($defaultModel->samplingRate != 1 && 
                        rand() > $defaultModel->samplingRate) {
                    msg("Skipping ".$defaultModel->name.
                        " because of sampling rate.\n");
                    next;
                }
                msg("  Counting default region for ".$this->name." (".
                    $defaults->[$i]->start.", ".$defaults->[$i]->end.") ".
                    $defaultModel->name."\n"); 
                $defaultModel->countRegion($defaults->[$i]);
            }
        }
    }
}

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

    my ($subregions, $defaults) = $this->partitionRegion($region);

    for (my $i = 0; $i < scalar(@$subregions); $i++) {
        next if(!ref($subregions->[$i]) || !$this->chain->[$i]->countable);
        $this->chain->[$i]->countNullRegion($subregions->[$i]);
    }

    if(scalar(@{$this->default})) {
        for my $defaultModel (@{$this->default}) {
            for (my $i = 0; $i < scalar(@$defaults); $i++) {
                $defaultModel->countNullRegion($defaults->[$i]);
            }
        }
    }
}

sub outputModels { 
    my ($this, $dir, $seq, $feature, $id) = @_;

    my ($start, $end);
    if($feature->strand eq '-') {
        ($start, $end) = rcCoords($feature->start, $feature->end, $seq->length);
    }
    else {
        ($start, $end) = ($feature->start, $feature->end);
    }

    my $members = { start       => $start,
                    end         => $end,
                    seq         => $seq,
                    feature     => $feature
                  };

    my $region = new iPE::Sequence::Region($members);
    
    my ($subregions, $defaults) = $this->partitionRegion($region);
    for (my $i = 0; $i < scalar(@$subregions); $i++) {
        next if(!ref($subregions->[$i]));
        my $filename = "$dir/".$this->chain->[$i]->name.".fa";
        open FH, ">>$filename" or die "Could not open $filename for writing.\n";
        print FH ">$id\n";
        $seq->writeRegionToFH(\*FH, $subregions->[$i]);
    }

    if(scalar(@{$this->default})) {
        for my $defaultModel (@{$this->default}) {
            for (my $i = 0; $i < scalar(@$defaults); $i++) {
                my $filename = "$dir/".$defaultModel->name.".fa";
                open FH, ">>$filename" or die 
                    "Could not open $filename for writing.\n";
                print FH ">$id\n";
                $seq->writeRegionToFH(\*FH, $defaults->[$i]);
            }
        }
    }
}

=back

=head1 SEE ALSO

L<iPE::Util::Interval>, L<iPE::Util::Overlap>, L<iPE::Util::Overlap::Node>, L<iPE::Model::Emission>

=head1 AUTHOR

Bob Zimmermann (rpz@cse.wustl.edu)

=cut

1;
