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

Diff of /FigKernelPackages/FIGV.pm

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

revision 1.26, Fri May 25 16:46:44 2007 UTC revision 1.27, Tue May 29 19:16:26 2007 UTC
# Line 62  Line 62 
62    return $_[0]->{_orgdir};    return $_[0]->{_orgdir};
63  }  }
64    
65    sub is_complete
66    {
67        return 1;
68    }
69    
70  #  #
71  # Redirect any method invocations that we don't implement out to the  # Redirect any method invocations that we don't implement out to the
72  # underlying FIG object.  # underlying FIG object.
# Line 74  Line 79 
79          confess "BAD FIGV object passed to AUTOLOAD";          confess "BAD FIGV object passed to AUTOLOAD";
80      }      }
81    
82        no strict 'refs';
83    
84      my $meth = $AUTOLOAD;      my $meth = $AUTOLOAD;
85      $meth =~ s/.*:://;      $meth =~ s/.*:://;
86        my $fmeth = "FIG::$meth";
87    
88      my $fig = $self->{_fig};      my $fig = $self->{_fig};
89  #    my $args = Dumper(\@args);  #    my $args = Dumper(\@args);
90      if (wantarray)      if (wantarray)
91      {      {
92          my @res = $fig->$meth(@args);          my @res = $fig->$meth(@args);
93    #       my @res = &$fmeth($self, @args);
94  #       warn "FIGV invoke $meth($args) returns\n", Dumper(\@res);  #       warn "FIGV invoke $meth($args) returns\n", Dumper(\@res);
95          return @res;          return @res;
96      }      }
97      else      else
98      {      {
99          my $res = $fig->$meth(@args);          my $res = $fig->$meth(@args);
100    #       my $res = &$fmeth($self, @args);
101  #       warn "FIGV invoke $meth($args) returns\n", Dumper($res);  #       warn "FIGV invoke $meth($args) returns\n", Dumper($res);
102          return $res;          return $res;
103      }      }
# Line 99  Line 109 
109      return $self;      return $self;
110  }  }
111    
112    sub sort_fids_by_taxonomy
113    {
114        my($self,@fids) = @_;
115    
116        return map     { $_->[0] }
117               sort    { $a->[1] cmp $b->[1] }
118               map     { [$_,$self->taxonomy_of($self->genome_of($_))] }
119               @fids;
120    }
121    
122  #  #
123  # To retrieve a subsystem in FIGV, we create the subsystem as normal via $fig->get_subsystem,  # To retrieve a subsystem in FIGV, we create the subsystem as normal via $fig->get_subsystem,
# Line 1159  Line 1178 
1178    
1179  sub sims  sub sims
1180  {  {
1181      my($self,$peg,$max,$maxP,$select) = @_;      my($self,$pegarg,$max,$maxP,$select, $max_expand, $filters) = @_;
1182    
1183      my $fig     = $self->{_fig};      my $fig     = $self->{_fig};
1184      my $newG    = $self->{_genome};      my $newG    = $self->{_genome};
# Line 1168  Line 1187 
1187      $maxP    = $maxP ? $maxP : 1.0e-5;      $maxP    = $maxP ? $maxP : 1.0e-5;
1188      $select     = $select ? $select : "all";      $select     = $select ? $select : "all";
1189    
1190      my $sims_file = "$newGdir/expanded_similarities";      my $prefix = "_sims";
1191      if (not ($peg =~ /^fig\|(\d+\.\d+)/ && ($1 eq $newG)))      my $flip_prefix = "_flips";
1192    
1193        if ($select eq 'raw')
1194        {
1195            $prefix = "_raw_sims";
1196            $flip_prefix = "_raw_flips";
1197        }
1198    
1199        #
1200        # Partition pegs into one set that is part of this organism
1201        # and another set that is not.
1202        #
1203        my @pegs = ref($pegarg) ? @$pegarg : ($pegarg);
1204        my(@part, @not_part, %part);
1205        my %sims;
1206    
1207        for my $peg  (@pegs)
1208        {
1209            if ($peg =~ /^fig\|(\d+\.\d+)/ and $1 eq $newG)
1210            {
1211                push(@part, $peg);
1212                $part{$peg}++;
1213            }
1214            else
1215            {
1216                push(@not_part, $peg);
1217                $sims{$peg} = [];
1218            }
1219        }
1220    
1221        #
1222        # Retrieve a batch of the sims for the not-part pegs, and partition
1223        # into %sims.
1224        #
1225        for my $sim ($fig->sims(\@not_part, $max, $maxP, $select, $max_expand, $filters))
1226      {      {
1227          my @relevant = grep { ($_ =~ /^(\S+)\t(\S+)/) && ($1 ne $peg) && ($2 eq $peg) } `grep '$peg' $sims_file`;          push(@{$sims{$sim->id1}}, $sim);
         my @flips    = ();  
         foreach $_ (@relevant)  
         {  
             chop;  
             my($id1,$id2,$iden,$f1,$f2,$f3,$b1,$e1,$b2,$e2,$psc,$bsc,$ln1,$ln2) = split(/\t/,$_);  
             push(@flips, bless ( [$id2,$id1,$iden,$f1,$f2,$f3,$b2,$e2,$b1,$e1,$psc,$bsc,$ln2,$ln1],'Sim'));  
1228          }          }
1229    
1230        my @out;
1231        my $start_len;
1232    
1233        for my $peg (@pegs)
1234        {
1235            $start_len = @out;
1236            if (not $part{$peg})
1237            {
1238                my @flips = $self->retrieve_sims($peg,      $flip_prefix, $maxP, $select);
1239    
1240          @flips = sort { $b->bsc <=> $a->bsc } @flips;          @flips = sort { $b->bsc <=> $a->bsc } @flips;
         my @old = $fig->sims($peg,$max,$maxP,$select);  
         @old = sort { $b->bsc <=> $a->bsc } @old;  
1241    
1242          my @merged = ();              # my @old = $fig->sims($peg,$max,$maxP,$select);
1243    
1244                my @old = sort { $b->bsc <=> $a->bsc } @{$sims{$peg}};
1245    
1246                # my @merged = ();
1247          my $i1 = 0;          my $i1 = 0;
1248          my $i2 = 0;          my $i2 = 0;
1249          while (($i1 < @flips) || ($i2 < @old))          while (($i1 < @flips) || ($i2 < @old))
1250          {          {
1251              if (($i1 == @flips) || (($i2 < @old) && ($flips[$i1]->[11] < $old[$i2]->[11])))              if (($i1 == @flips) || (($i2 < @old) && ($flips[$i1]->[11] < $old[$i2]->[11])))
1252              {              {
1253                  push(@merged,$old[$i2]);                      # push(@merged,$old[$i2]);
1254                        push(@out,$old[$i2]);
1255                  $i2++;                  $i2++;
1256              }              }
1257              else              else
1258              {              {
1259                  push(@merged,$flips[$i1]);                      # push(@merged,$flips[$i1]);
1260                        push(@out,$flips[$i1]);
1261                  $i1++;                  $i1++;
1262              }              }
1263          }          }
         return @merged;  
1264      }      }
1265            else
1266            {
1267                my @sims = $self->retrieve_sims($peg, $prefix, $maxP, $select);
1268                push(@out, @sims);
1269            }
1270    
1271            if (@out - $start_len > $max)
1272            {
1273                $#out = $start_len + $max - 1;
1274            }
1275        }
1276    
1277        return @out;
1278    }
1279    
1280    sub retrieve_sims
1281    {
1282        my($self, $peg, $prefix, $maxP, $select) = @_;
1283    
1284      $self->load_sims_index();      $self->load_sims_index();
1285    
1286      my $info = $self->{_sims_index}->{$peg};      my $info = $self->{"${prefix}_index"}->{$peg};
1287    
1288      if ($info !~ /^(\d+),(\d+)$/)      if ($info !~ /^(\d+),(\d+)$/)
1289      {      {
# Line 1212  Line 1291 
1291      }      }
1292      my($seek, $len) = ($1, $2);      my($seek, $len) = ($1, $2);
1293    
1294      my $sims_txt = &FIG::read_block($self->{_sims_fh}, $seek, $len);      my $sims_txt = &FIG::read_block($self->{"${prefix}_fh"}, $seek, $len);
1295    
1296      my @sims = map { bless $_, 'Sim' } grep { $_->[10] <= $maxP } map { [split(/\t/)] } @$sims_txt;      my @sims = map { bless $_, 'Sim' } grep { $_->[10] <= $maxP } map { [split(/\t/)] } @$sims_txt;
1297    
# Line 1221  Line 1300 
1300          @sims = grep { $_->[1] =~ /^fig/ } @sims;          @sims = grep { $_->[1] =~ /^fig/ } @sims;
1301      }      }
1302    
     if (@sims > $max)  
     {  
         $#sims = $max-1;  
     }  
   
1303      return @sims;      return @sims;
1304  }  }
1305    
   
1306  sub sims_old {  sub sims_old {
1307      my($self,$peg,$max,$maxP,$select) = @_;      my($self,$peg,$max,$maxP,$select) = @_;
1308    
# Line 1295  Line 1368 
1368      }      }
1369  }  }
1370    
1371    
1372    sub coupled_to
1373    {
1374        my($self,$peg) = @_;
1375    
1376        my $fig     = $self->{_fig};
1377        my $newG    = $self->{_genome};
1378        my $newGdir = $self->{_orgdir};
1379    
1380        if ($peg =~ /^fig\|$newG\.peg/)
1381        {
1382    
1383            $self->load_coupling_index();
1384    
1385            my $tie = $self->{_pch_tie};
1386    
1387            my @dat = $tie->get_dup($peg);
1388    
1389            return map { [split(/$;/, $_)] } @dat;
1390        }
1391        else
1392        {
1393            return $fig->coupled_to($peg);
1394        }
1395    
1396    }
1397    
1398    sub coupling_evidence
1399    {
1400        my($self,$peg1, $peg2) = @_;
1401    
1402        my $fig     = $self->{_fig};
1403        my $newG    = $self->{_genome};
1404        my $newGdir = $self->{_orgdir};
1405    
1406        if ($peg1 =~ /^fig\|$newG\.peg/)
1407        {
1408            $self->load_coupling_index();
1409    
1410            my $tie = $self->{_pch_ev_tie};
1411    
1412            my @dat = $tie->get_dup("$peg1$;$peg2");
1413    
1414            my @a;
1415            return map { @a = split(/$;/, $_); [@a[0,1,4]] } @dat;
1416        }
1417        else
1418        {
1419            return $fig->coupling_evidence($peg1, $peg2);
1420        }
1421    
1422    }
1423    
1424    sub coupling_and_evidence
1425    {
1426        my($self,$peg1) = @_;
1427    
1428        my $fig     = $self->{_fig};
1429        my $newG    = $self->{_genome};
1430        my $newGdir = $self->{_orgdir};
1431    
1432        if ($peg1 =~ /^fig\|$newG\.peg/)
1433        {
1434            $self->load_coupling_index();
1435    
1436            my $tie = $self->{_pch_tie};
1437            my $evtie = $self->{_pch_ev_tie};
1438    
1439            my @out;
1440            my @coupled_to = $tie->get_dup($peg1);
1441            for my $ent (@coupled_to)
1442            {
1443                my ($peg2, $score) = split(/$;/, $ent);
1444    
1445                my @ev = $evtie->get_dup("$peg1$;$peg2");
1446    
1447                my $l = [];
1448                for my $event (@ev)
1449                {
1450                    my($peg3, $peg4, $iden3, $iden4, $rep) = split(/$;/, $event);
1451                    push(@$l, [$peg3, $peg4]);
1452                }
1453                push(@out, [$score, $peg2, $l]);
1454            }
1455            return @out;
1456        }
1457        else
1458        {
1459            return $fig->coupling_and_evidence($peg1);
1460        }
1461    
1462    }
1463    
1464    sub load_coupling_index
1465    {
1466        my($self) = @_;
1467    
1468        return if defined($self->{_pch_index});
1469    
1470        my $fig     = $self->{_fig};
1471        my $newG    = $self->{_genome};
1472        my $newGdir = $self->{_orgdir};
1473    
1474        my $pch_btree = "$newGdir/pchs.btree";
1475        my $ev_btree = "$newGdir/pchs.evidence.btree";
1476    
1477        my $pch_index = {};
1478        my $ev_index = {};
1479    
1480        my $tied = tie %$pch_index, 'DB_File', $pch_btree, O_RDONLY, 0666, $DB_BTREE;
1481        my $evtied = tie %$ev_index, 'DB_File', $ev_btree, O_RDONLY, 0666, $DB_BTREE;
1482    
1483        #
1484        # Set these even if failed so we don't keep trying to open and failing.
1485        #
1486        $self->{_pch_index} = $pch_index;
1487        $self->{_pch_tie} = $tied;
1488        $self->{_pch_ev_index} = $ev_index;
1489        $self->{_pch_ev_tie} = $evtied;
1490    
1491        if (not $tied)
1492        {
1493            warn "Cannot tie pch index $pch_btree: $!\n";
1494        }
1495    }
1496    
1497  sub load_bbh_index  sub load_bbh_index
1498  {  {
1499      my($self) = @_;      my($self) = @_;
# Line 1337  Line 1536 
1536      my $sims_index_file = "$sims_file.index";      my $sims_index_file = "$sims_file.index";
1537      my $sims_index = {};      my $sims_index = {};
1538    
1539      my $tied = tie %$sims_index, 'DB_File', $sims_index_file, O_RDONLY, 0666, $DB_BTREE;      my $flips_file = "$newGdir/expanded_similarities.flips";
1540        my $flips_index_file = "$flips_file.index";
1541        my $flips_index = {};
1542    
1543        my $raw_sims_file = "$newGdir/similarities";
1544        my $raw_sims_index_file = "$raw_sims_file.index";
1545        my $raw_sims_index = {};
1546    
1547        my $raw_flips_file = "$newGdir/similarities.flips";
1548        my $raw_flips_index_file = "$raw_flips_file.index";
1549        my $raw_flips_index = {};
1550    
1551        $self->open_sims($sims_index, $sims_file, $sims_index_file, "_sims");
1552        $self->open_sims($flips_index, $flips_file, $flips_index_file, "_flips");
1553        $self->open_sims($raw_sims_index, $raw_sims_file, $raw_sims_index_file, "_raw_sims");
1554        $self->open_sims($raw_flips_index, $raw_flips_file, $raw_flips_index_file, "_raw_flips");
1555    }
1556    
1557    #
1558    # Open a sims file, tie it to a hash, and store the info into the $self obj.
1559    #
1560    sub open_sims
1561    {
1562        my($self, $hash, $sims_file, $index_file, $prefix) = @_;
1563    
1564        my $tied = tie %$hash, 'DB_File', $index_file, O_RDONLY, 0666, $DB_BTREE;
1565    
1566      #      #
1567      # Set these even if failed so we don't keep trying to open and failing.      # Set these even if failed so we don't keep trying to open and failing.
1568      #      #
1569      $self->{_sims_index} = $sims_index;      $self->{"${prefix}_index"} = $hash;
1570      $self->{_sims_tie} = $tied;      $self->{"${prefix}_tie"} = $tied;
1571    
1572      if (not $tied)      if (not $tied)
1573      {      {
1574          warn "Cannot tie sims index $sims_index_file: $!\n";          warn "Cannot tie sims index $index_file: $!\n";
1575      }      }
1576    
1577      #      #
1578      # open the sims file as well.      # open the sims file as well.
1579      #      #
1580    
1581      $self->{_sims_fh} = new FileHandle("<$sims_file");      $self->{"${prefix}_fh"} = new FileHandle("<$sims_file");
1582    
1583      if (!$self->{_sims_fh})      if (!$self->{"${prefix}_fh"})
1584      {      {
1585          warn "Cannot open sims file $sims_file: $!\n";          warn "Cannot open sims file $sims_file: $!\n";
1586      }      }
# Line 1545  Line 1769 
1769  sub scenario_directory {  sub scenario_directory {
1770    my ($self, $organism) = @_;    my ($self, $organism) = @_;
1771    
1772    my $directory = "$FIG_Config::var/Models/";    my $directory;
1773    
1774    if ($organism eq $self->{_genome}) {    if ($organism eq $self->{_genome})
1775      {
1776      $directory = $self->{_orgdir} . "/Models";      $directory = $self->{_orgdir} . "/Models";
1777          $directory .= "/$organism" if defined($organism);
1778    
1779    } else {    } else {
1780      $directory .= $organism;        $directory $self->{_fig}->scenario_directory($organism);
1781    }    }
1782    
1783    return $directory;    return $directory;

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3