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

Diff of /FigKernelPackages/Observation.pm

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

revision 1.15, Mon Jun 25 16:51:02 2007 UTC revision 1.16, Mon Jun 25 22:21:40 2007 UTC
# Line 3  Line 3 
3  require Exporter;  require Exporter;
4  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
5    
6    use FIG_Config;
7  use strict;  use strict;
8  use warnings;  #use warnings;
9  use HTML;  use HTML;
10    
11  1;  1;
# Line 723  Line 724 
724  sub get_cluster_observations{  sub get_cluster_observations{
725      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
726    
727      $dataset = {'class' => 'CLUSTER',      my $dataset = {'class' => 'CLUSTER',
728                  'type' => 'fc'                  'type' => 'fc'
729                  };                  };
730      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
# Line 1590  Line 1591 
1591      }      }
1592    
1593      # call genes in region      # call genes in region
1594      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_stop);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
1595      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
1596        my (@start_array_region);
1597        push (@start_array_region, $region_start);
1598    
1599      my %all_genes;      my %all_genes;
1600      my %all_genomes;      my %all_genomes;
1601      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1}
1602    
1603      my @coup = $fig->coupling_and_evidence($fid,5000,1e-10,4,1);      my ($to);
1604        my @tmp = $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1605    #    foreach my $member (@tmp)
1606    #    {
1607    #       my $tmp1 = $member->[2];
1608    #       my ($peg1, $peg2) = @$tmp1;
1609    #       print STDERR "@{$peg1}[0], @{$peg1}[1]";
1610    #    }
1611    
1612        my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1613    
1614        my $count_coup = @coup;
1615        my $coup_count = 0;
1616    
1617      foreach my $pair (@$coup[0]->[2]){      foreach my $pair (@{$coup[0]->[2]}) {
1618            last if ($coup_count > 10);
1619          my ($peg1,$peg2) = @$pair;          my ($peg1,$peg2) = @$pair;
1620    
1621          my $location = $fig->feature_location($peg1);          my $location = $fig->feature_location($peg1);
1622          my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);          my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1623          if($location =~/(.*)_(\d+)_(\d+)$/){          if($location =~/(.*)_(\d+)_(\d+)$/){
# Line 1610  Line 1627 
1627              if ($pair_beg < $pair_end)              if ($pair_beg < $pair_end)
1628              {              {
1629                  $pair_region_start = $pair_beg - 4000;                  $pair_region_start = $pair_beg - 4000;
1630                  $pair_region_end = $pair_end+4000;                  $pair_region_stop = $pair_end+4000;
1631              }              }
1632              else              else
1633              {              {
1634                  $pair_region_end = $pair_end+4000;                  $pair_region_stop = $pair_end+4000;
1635                  $pair_region_start = $pair_beg-4000;                  $pair_region_start = $pair_beg-4000;
1636              }              }
1637    
1638                push (@start_array_region, $pair_region_start);
1639    
1640              $pair_genome = $fig->genome_of($peg1);              $pair_genome = $fig->genome_of($peg1);
1641              $all_genomes{$pair_genome} = 1;              $all_genomes{$pair_genome} = 1;
1642              my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);              my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1643              push(@$all_regions,$pair_features);              push(@$all_regions,$pair_features);
1644              foreach my $pair_feature (@$pair_features){ $all_genes{$feature} = 1}              foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}
   
1645          }          }
1646            $coup_count++;
1647    
1648      }      }
1649    
1650      my $bbh_sets = [];      my $bbh_sets = [];
# Line 1632  Line 1652 
1652      foreach my $gene_key (keys(%all_genes)){      foreach my $gene_key (keys(%all_genes)){
1653          if($already{$gene_key}){next;}          if($already{$gene_key}){next;}
1654          my $gene_set = [$gene_key];          my $gene_set = [$gene_key];
1655    
1656            my $gene_key_genome = $fig->genome_of($gene_key);
1657    
1658          foreach my $genome_key (keys(%all_genomes)){          foreach my $genome_key (keys(%all_genomes)){
1659                next if ($gene_key_genome eq $genome_key);
1660              my $return = $fig->bbh_list($genome_key,[$gene_key]);              my $return = $fig->bbh_list($genome_key,[$gene_key]);
1661              my @$feature_list = $return->{$gene_key};  
1662                my $feature_list = $return->{$gene_key};
1663              foreach my $fl (@$feature_list){              foreach my $fl (@$feature_list){
1664                    #next if ($already{$fl});
1665                  push(@$gene_set,$fl);                  push(@$gene_set,$fl);
1666                  $already{$fl} = 1;                  $already{$fl} = 1;
1667              }              }
# Line 1644  Line 1670 
1670          push(@$bbh_sets,$gene_set);          push(@$bbh_sets,$gene_set);
1671      }      }
1672    
1673      %bbh_set_rank;      my %bbh_set_rank;
1674      my $order = 0;      my $order = 0;
1675      foreach my $set (@$bbh_sets){      foreach my $set (@$bbh_sets){
1676          my $count = scalar(@$set);          my $count = scalar(@$set);
1677          $bbh_rank{$order} = $count;          $bbh_set_rank{$order} = $count;
1678          $order++;          $order++;
1679      }      }
1680    
1681      my %peg_rank;      my %peg_rank;
1682      my $counter =  1;      my $counter =  1;
1683        open (FH, ">$FIG_Config::temp/good_sets.txt");
1684      foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){      foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){
1685          my $good_set = @$bbh_sets[$bbh_order];          my $good_set = @$bbh_sets[$bbh_order];
1686          foreach my $peg (@$good_set){          foreach my $peg (@$good_set){
1687              $peg_rank{$peg} = $counter;              $peg_rank{$peg} = $counter;
1688                print STDERR "$FIG_Config::temp";
1689                print FH "COLOR: $counter\tPEG: $peg\n";
1690          }          }
1691          $counter++;          $counter++;
1692      }      }
1693        close (FH);
1694    
1695    
1696      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
1697          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
# Line 1668  Line 1699 
1699          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
1700          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
1701                              'short_title' => $region_gs,                              'short_title' => $region_gs,
1702                              'height' => 30,                              'basepair_offset' => '0'
                             'basepair_offset' => '0';  
1703                          };                          };
1704    
1705            my $offset = shift @start_array_region;
1706    
1707    
1708          my $line_data = [];          my $line_data = [];
1709          foreach my $fid (@$region){          foreach my $fid1 (@$region){
1710              my $element_hash;              my $element_hash;
1711              my $links_list = [];              my $links_list = [];
1712              my $descriptions = [];              my $descriptions = [];
1713    
1714              my $color = $peg_rank{$fid};              my $color = $peg_rank{$fid1};
1715              my $fid_location = $fig->feature_location($fid);              if ($color == 1) {
1716                    print STDERR "PEG: $fid1, RANK: $color";
1717    
1718                }
1719    
1720    
1721                my $fid_location = $fig->feature_location($fid1);
1722              if($fid_location =~/(.*)_(\d+)_(\d+)$/){              if($fid_location =~/(.*)_(\d+)_(\d+)$/){
1723                  my($start,$stop);                  my($start,$stop);
1724                  if ($2 < $3){$start = $2; $stop = $3;}                  if ($2 < $3){$start = $2; $stop = $3;}
1725                  else{$stop = $2; $start = $3;}                  else{$stop = $2; $start = $3;}
1726                    $start = $start - $offset;
1727                    $stop = $stop - $offset;
1728                  $element_hash = {                  $element_hash = {
1729                      "title" => $fid,                      "title" => $fid1,
1730                      "start" => $start,                      "start" => $start,
1731                      "end" =>  $stop,                      "end" =>  $stop,
1732                      "type"=> 'arrow',                      "type"=> 'arrow',
1733                      "color"=> $color,                      "color"=> $color,
1734                      "zlayer" => "2",                      "zlayer" => "2"
1735                  };                  };
1736                  push(@$line_data,$element_hash);                  push(@$line_data,$element_hash);
1737    
1738              }              }
1739          }          }
1740          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3