[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.34, Fri Mar 5 22:17:16 2004 UTC revision 1.35, Tue Mar 9 23:19:23 2004 UTC
# Line 1186  Line 1186 
1186      my($i,$v,$d,$dist);      my($i,$v,$d,$dist);
1187    
1188      if ($genome1 > $genome2) { ($genome1,$genome2) = ($genome2,$genome1) }      if ($genome1 > $genome2) { ($genome1,$genome2) = ($genome2,$genome1) }
1189    
1190        my $relational_db_response;
1191        my $rdbH = $self->db_handle;
1192    
1193        if (($relational_db_response = $rdbH->SQL("SELECT dist FROM distances WHERE ( genome1 = \'$genome1\' ) AND ( genome2 = \'$genome2\' ) ")) &&
1194            (@$relational_db_response == 1))
1195        {
1196            return $relational_db_response->[0]->[0];
1197        }
1198        return $self->crude_estimate_of_distance1($genome1,$genome2);
1199    }
1200    
1201    sub crude_estimate_of_distance1 {
1202        my($self,$genome1,$genome2) = @_;
1203        my($i,$v,$d,$dist);
1204    
1205        if ($genome1 > $genome2) { ($genome1,$genome2) = ($genome2,$genome1) }
1206      $dist = $self->cached('_dist');      $dist = $self->cached('_dist');
1207      if (! $dist->{"$genome1,$genome2"})      if (! $dist->{"$genome1,$genome2"})
1208      {      {
# Line 1716  Line 1733 
1733      return sort { $b->[0] <=> $a->[0] } @hits;      return sort { $b->[0] <=> $a->[0] } @hits;
1734  }  }
1735    
1736    sub fast_coupling {
1737        my($self,$peg,$bound,$coupling_cutoff) = @_;
1738        my($genome,$genome1,$genome2,$peg1,$peg2,$peg3,%maps,$loc,$loc1,$loc2,$loc3);
1739        my($pairs,$sc,%ev);
1740    
1741        my @ans = ();
1742    
1743        $genome = &genome_of($peg);
1744        foreach $peg1 ($self->in_pch_pin_with($peg))
1745        {
1746            $peg1 =~ s/,.*$//;
1747            if ($peg ne $peg1)
1748            {
1749                $genome1 = &genome_of($peg1);
1750                $maps{$peg}->{$genome1} = $peg1;
1751            }
1752        }
1753    
1754        $loc = [&boundaries_of(scalar $self->feature_location($peg))];
1755        foreach $peg1 ($self->in_cluster_with($peg))
1756        {
1757            if ($peg ne $peg1)
1758            {
1759    #           print STDERR "peg1=$peg1\n";
1760                $loc1 = [&boundaries_of(scalar $self->feature_location($peg1))];
1761                if (&close_enough($loc,$loc1,$bound))
1762                {
1763                    foreach $peg2 ($self->in_pch_pin_with($peg1))
1764                    {
1765                        $genome2 = &genome_of($peg2);
1766                        if (($peg3 = $maps{$peg}->{$genome2}) && ($peg2 ne $peg3))
1767                        {
1768                            $loc2 = [&boundaries_of(scalar $self->feature_location($peg2))];
1769                            $loc3 = [&boundaries_of(scalar $self->feature_location($peg3))];
1770                            if (&close_enough($loc2,$loc3,$bound))
1771                            {
1772                                push(@{$ev{$peg1}},[$peg3,$peg2]);
1773                            }
1774                        }
1775                    }
1776                }
1777            }
1778        }
1779        foreach $peg1 (keys(%ev))
1780        {
1781            $pairs = $ev{$peg1};
1782            $sc = $self->score([$genome,map { $self->genome_of($_->[0]) } @$pairs]);
1783            if ($sc >= $coupling_cutoff)
1784            {
1785                push(@ans,[$sc,$peg1]);
1786            }
1787        }
1788        return sort { $b->[0] <=> $a->[0] } @ans;
1789    }
1790    
1791    
1792    sub score {
1793        my($self,$genomes) = @_;
1794        my($min,$i,$j,$d,%seen,@reduced,$genome);
1795    
1796        foreach $genome (@$genomes)
1797        {
1798            $genome =~ /^(\d+)/;
1799            if (! $seen{$1})
1800            {
1801                push(@reduced,$genome);
1802                $seen{$1} = 1;
1803            }
1804        }
1805    
1806        $i=1;
1807        $d = 0;
1808        for ($j=1; ($j < @reduced); $j++)
1809        {
1810            $d += $self->crude_estimate_of_distance($reduced[$i],$reduced[$j]);
1811        }
1812        return $d;
1813    }
1814    
1815    
1816  =pod  =pod
1817    
# Line 2956  Line 3052 
3052      &run("index_annotations");      &run("index_annotations");
3053      &run("load_ec_names");      &run("load_ec_names");
3054      &run("load_kegg");      &run("load_kegg");
3055        &run("load_distances");
3056      &run("make_indexes");      &run("make_indexes");
3057  }  }
3058    

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3