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

Diff of /FigKernelPackages/FIG.pm

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

revision 1.42, Thu Mar 18 16:02:32 2004 UTC revision 1.43, Fri Mar 19 18:45:36 2004 UTC
# Line 1654  Line 1654 
1654      foreach $peg1 (keys(%ev))      foreach $peg1 (keys(%ev))
1655      {      {
1656          $pairs = $ev{$peg1};          $pairs = $ev{$peg1};
1657          $sc = $self->score([$genome,map { $self->genome_of($_->[0]) } @$pairs]);          $sc = $self->score([$peg,map { $_->[0] } @$pairs]);
1658          if ($sc >= $coupling_cutoff)          if ($sc >= $coupling_cutoff)
1659          {          {
1660              push(@ans,[$sc,$peg1]);              push(@ans,[$sc,$peg1]);
# Line 1665  Line 1665 
1665    
1666    
1667  sub score {  sub score {
1668      my($self,$genomes) = @_;      my($self,$pegs) = @_;
     my($min,$i,$j,$d,%seen,@reduced,$genome);  
1669    
1670      foreach $genome (@$genomes)      my @ids = map { $self->maps_to_id($_) } @$pegs;
1671      {      return &score1($self,\@ids) - 1;
1672          $genome =~ /^(\d+)/;  }
1673          if (! $seen{$1})  
1674    sub score1 {
1675        my($self,$pegs) = @_;
1676        my($sim);
1677        my($first,@rest) = @$pegs;
1678        my $count = 1;
1679        my %hits = map { $_ => 1 } @rest;
1680        my @ordered = sort { $b->[0] <=> $a->[0] }
1681                      map { $sim = $_; [$sim->iden,$sim->id2] }
1682                      grep { $hits{$_->id2} }
1683                      $self->sims($first,1000,1,"raw");
1684        while ((@ordered > 0) && ($ordered[0]->[0] >= 97))
1685          {          {
1686              push(@reduced,$genome);          shift @ordered ;
             $seen{$1} = 1;  
1687          }          }
1688        while (@ordered > 0)
1689        {
1690            my $start = $ordered[0]->[0];
1691            $_ = shift @ordered;
1692            my @sub = ( $_->[1] );
1693            while ((@ordered > 0) && ($ordered[0]->[0] > ($start-3)))
1694            {
1695                $_ = shift @ordered;
1696                push(@sub, $_->[1]);
1697      }      }
1698    
1699      $i=1;          if (@sub == 1)
     $d = 0;  
     for ($j=1; ($j < @reduced); $j++)  
1700      {      {
1701          $d += $self->crude_estimate_of_distance($reduced[$i],$reduced[$j]);              $count++;
1702      }      }
1703      return $d;          else
1704            {
1705                $count += &score1($self,\@sub);
1706            }
1707        }
1708        return $count;
1709  }  }
   
1710    
1711  =pod  =pod
1712    
# Line 1777  Line 1797 
1797              $j++;              $j++;
1798          }          }
1799      }      }
1800      return ($sc,$ev);      return ($self->score([map { $_->[0] } @$ev]),$ev);
1801  }  }
1802    
1803  sub accumulate_ev {  sub accumulate_ev {
1804      my($self,$genome1,$feature_ids1,$feature_ids2,$bound,$ev) = @_;      my($self,$genome1,$feature_ids1,$feature_ids2,$bound,$ev) = @_;
1805      my($genome2,@locs1,@locs2,$i,$j,$sc,$x);      my($genome2,@locs1,@locs2,$i,$j,$x);
1806    
1807      if ((@$feature_ids1 == 0) || (@$feature_ids2 == 0)) { return 0 }      if ((@$feature_ids1 == 0) || (@$feature_ids2 == 0)) { return 0 }
1808    
1809      $feature_ids1->[0] =~ /^fig\|(\d+\.\d+)/;      $feature_ids1->[0] =~ /^fig\|(\d+\.\d+)/;
1810      $genome2 = $1;      $genome2 = $1;
     $sc = 0;  
1811      @locs1 = map { $x = $self->feature_location($_); $x ? [&boundaries_of($x)] : () } @$feature_ids1;      @locs1 = map { $x = $self->feature_location($_); $x ? [&boundaries_of($x)] : () } @$feature_ids1;
1812      @locs2 = map { $x = $self->feature_location($_); $x ? [&boundaries_of($x)] : () } @$feature_ids2;      @locs2 = map { $x = $self->feature_location($_); $x ? [&boundaries_of($x)] : () } @$feature_ids2;
1813    
# Line 1799  Line 1818 
1818              if (($feature_ids1->[$i] ne $feature_ids2->[$j]) &&              if (($feature_ids1->[$i] ne $feature_ids2->[$j]) &&
1819                  &close_enough($locs1[$i],$locs2[$j],$bound))                  &close_enough($locs1[$i],$locs2[$j],$bound))
1820              {              {
                 $sc += $self->crude_estimate_of_distance($genome1,$genome2);  
1821                  push(@$ev,[$feature_ids1->[$i],$feature_ids2->[$j]]);                  push(@$ev,[$feature_ids1->[$i],$feature_ids2->[$j]]);
1822              }              }
1823          }          }
1824      }      }
     return $sc;  
1825  }  }
1826    
1827  sub close_enough {  sub close_enough {
# Line 1826  Line 1843 
1843          if ($id2 =~ /^fig\|(\d+\.\d+)/)          if ($id2 =~ /^fig\|(\d+\.\d+)/)
1844          {          {
1845              my $genome = $1;              my $genome = $1;
1846              if ($self->taxonomy_of($genome) !~ /^Euk/)              if ($self->is_prokaryotic($genome))
1847              {              {
1848                  push(@{$by_org{$genome}},$id2);                  push(@{$by_org{$genome}},$id2);
1849              }              }

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3