[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.13, Fri Jun 22 20:30:38 2007 UTC revision 1.14, Mon Jun 25 16:34:30 2007 UTC
# Line 1534  Line 1534 
1534      my ($self,$gd, $fid) = @_;      my ($self,$gd, $fid) = @_;
1535    
1536      my $fig = new FIG;      my $fig = new FIG;
1537        my $all_regions = [];
1538    
1539      #get the organism genome      #get the organism genome
1540      my $genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
1541    
1542      # get location of the gene      # get location of the gene
1543      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1561  Line 1562 
1562      }      }
1563    
1564      # call genes in region      # call genes in region
1565      my ($features, $reg_beg, $reg_end) = $fig->genes_in_region($genome, $contig, $region_start, $region_stop);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_stop);
1566        push(@$all_regions,$target_gene_features);
1567    
1568        my %all_genes;
1569        my %all_genomes;
1570        foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1}
1571    
1572        my @coup = $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1573    
1574        foreach my $pair (@$coup[0]->[2]){
1575            my ($peg1,$peg2) = @$pair;
1576            my $location = $fig->feature_location($peg1);
1577            my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1578            if($location =~/(.*)_(\d+)_(\d+)$/){
1579                $pair_contig = $1;
1580                $pair_beg = $2;
1581                $pair_end = $3;
1582                if ($pair_beg < $pair_end)
1583                {
1584                    $pair_region_start = $pair_beg - 4000;
1585                    $pair_region_end = $pair_end+4000;
1586                }
1587                else
1588                {
1589                    $pair_region_end = $pair_end+4000;
1590                    $pair_region_start = $pair_beg-4000;
1591                }
1592    
1593                $pair_genome = $fig->genome_of($peg1);
1594                $all_genomes{$pair_genome} = 1;
1595                my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1596                push(@$all_regions,$pair_features);
1597                foreach my $pair_feature (@$pair_features){ $all_genes{$feature} = 1}
1598    
1599            }
1600        }
1601    
1602        my $bbh_sets = [];
1603        my %already;
1604        foreach my $gene_key (keys(%all_genes)){
1605            if($already{$gene_key}){next;}
1606            my $gene_set = [$gene_key];
1607            foreach my $genome_key (keys(%all_genomes)){
1608                my $return = $fig->bbh_list($genome_key,[$gene_key]);
1609                my @$feature_list = $return->{$gene_key};
1610                foreach my $fl (@$feature_list){
1611                    push(@$gene_set,$fl);
1612                    $already{$fl} = 1;
1613                }
1614            }
1615            $already{$gene_key} = 1;
1616            push(@$bbh_sets,$gene_set);
1617        }
1618    
1619        %bbh_set_rank;
1620        my $order = 0;
1621        foreach my $set (@$bbh_sets){
1622            my $count = scalar(@$set);
1623            $bbh_rank{$order} = $count;
1624            $order++;
1625        }
1626    
1627        my %peg_rank;
1628        my $counter =  1;
1629        foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){
1630            my $good_set = @$bbh_sets[$bbh_order];
1631            foreach my $peg (@$good_set){
1632                $peg_rank{$peg} = $counter;
1633            }
1634            $counter++;
1635        }
1636    
1637        foreach my $region (@$all_regions){
1638            my $sample_peg = @$region[0];
1639            my $region_genome = $fig->genome_of($sample_peg);
1640            my $region_gs = $fig->genus_species($region_genome);
1641            my $line_config = { 'title' => $region_gs,
1642                                'short_title' => $region_gs,
1643                                'height' => 30,
1644                                'basepair_offset' => '0';
1645                            };
1646            my $line_data = [];
1647            foreach my $fid (@$region){
1648                my $element_hash;
1649                my $links_list = [];
1650                my $descriptions = [];
1651    
1652                my $color = $peg_rank{$fid};
1653                my $fid_location = $fig->feature_location($fid);
1654                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
1655                    my($start,$stop);
1656                    if ($2 < $3){$start = $2; $stop = $3;}
1657                    else{$stop = $2; $start = $3;}
1658                    $element_hash = {
1659                        "title" => $fid,
1660                        "start" => $start,
1661                        "end" =>  $stop,
1662                        "type"=> 'arrow',
1663                        "color"=> $color,
1664                        "zlayer" => "2",
1665                    };
1666                    push(@$line_data,$element_hash);
1667                }
1668            }
1669            $gd->add_line($line_data, $line_config);
1670        }
1671        return $gd;
1672    }
1673    
1674    
1675    
1676    
1677      # call to see what is coupled to main peg      # call to see what is coupled to main peg
1678      my ($ref_coupled_to) = $fig->coupled_to($fid);      my ($ref_coupled_to) = $fig->coupled_to($fid);

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3