[Bio] / FigKernelPackages / gjoalignandtree.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/gjoalignandtree.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4, Mon Nov 8 19:49:39 2010 UTC revision 1.5, Mon Nov 8 20:26:00 2010 UTC
# Line 153  Line 153 
153  #  #
154  #     begin => bool   #  Trim start (specifically)  #     begin => bool   #  Trim start (specifically)
155  #     end   => bool   #  Trim end (specifically)  #     end   => bool   #  Trim end (specifically)
156    #     fract_cov  => fract  #  Fraction of sequences to be covered (D: 0.75)
157  #  #
158  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
159  sub trim_align_to_median_ends  sub trim_align_to_median_ends
160  {  {
161      my ( $align, $opts ) = @_;      my ( $align, $opts ) = @_;
162    
163      $align && ref $align eq 'ARRAY' && @$align      $align && ref $align eq 'ARRAY' && @$align
164          or print STDERR "trim_align_to_median_ends called with invalid sequence list.\n"          or print STDERR "trim_align_to_median_ends called with invalid sequence list.\n"
165             and return wantarray ? () : [];             and return wantarray ? () : [];
# Line 166  Line 168 
168      my $tr_beg = $opts->{ begin } || $opts->{ beg } || $opts->{ start } ? 1 : 0;      my $tr_beg = $opts->{ begin } || $opts->{ beg } || $opts->{ start } ? 1 : 0;
169      my $tr_end = $opts->{ end } ? 1 : 0;      my $tr_end = $opts->{ end } ? 1 : 0;
170      $tr_beg = $tr_end = 1 if ! ( $tr_beg || $tr_end );      $tr_beg = $tr_end = 1 if ! ( $tr_beg || $tr_end );
171        my $frac  = $opts->{ fract_cov } || 0.75;
172    
173      my( @pos1, @pos2, $i );      my( @ngap1, @ngap2);
174      foreach my $seq ( @$align )      foreach my $seq ( @$align )
175      {      {
176          my( $b, $e ) = $seq->[2] =~ /^(-*).*[^-](-*)$/;          my( $b, $e ) = $seq->[2] =~ /^(-*).*[^-](-*)$/;
177          push @pos1, length( $b || '' );          push @ngap1, length( $b || '' );
178          push @pos2, length( $e || '' );          push @ngap2, length( $e || '' );
179      }      }
180    
181      @pos1 = sort { $a <=> $b } @pos1;      @ngap1 = sort { $a <=> $b } @ngap1;
182      @pos2 = sort { $a <=> $b } @pos2;      @ngap2 = sort { $a <=> $b } @ngap2;
183    
184      my $pos1 = $tr_beg ? $pos1[ int( @pos1/2 ) ] : 0;      my $ngap1 = $tr_beg ? $ngap1[ int( @ngap1 * $frac ) ] : 0;
185      my $pos2 = $tr_end ? $pos2[ int( @pos2/2 ) ] : 0;      my $ngap2 = $tr_end ? $ngap2[ int( @ngap2 * $frac ) ] : 0;
186    
187      my $ori_len = length( $align->[0]->[2] );      my $ori_len = length( $align->[0]->[2] );
188      my $new_len = $ori_len - ( $pos1 + $pos2 );      my $new_len = $ori_len - ( $ngap1 + $ngap2 );
189      my @align2 = map { [ @$_[0,1], substr( $_->[2], $pos1, $new_len ) ] }      my @align2 = map { [ @$_[0,1], substr( $_->[2], $ngap1, $new_len ) ] }
190                   @$align;                   @$align;
191    
192      wantarray ? @align2 : \@align2;      wantarray ? @align2 : \@align2;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3