[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.38, Mon Sep 10 15:10:04 2007 UTC revision 1.40, Thu Sep 20 22:27:20 2007 UTC
# Line 86  Line 86 
86    return $self->{acc};    return $self->{acc};
87  }  }
88    
89    =head3 query()
90    
91    The query id
92    
93    =cut
94    
95    sub query {
96        my ($self) = @_;
97        return $self->{query};
98    }
99    
100    
101  =head3 class()  =head3 class()
102    
103  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 435  Line 447 
447  =cut  =cut
448    
449  sub get_sims_summary {  sub get_sims_summary {
450      my ($observation, $fid) = @_;      my ($observation, $fid, $taxes) = @_;
451      my $fig = new FIG;      my $fig = new FIG;
452      my %families;      my %families;
453      my @sims= $fig->nsims($fid,20000,10,"fig");      my @sims= $fig->nsims($fid,20000,10,"fig");
# Line 443  Line 455 
455      foreach my $sim (@sims){      foreach my $sim (@sims){
456          next if ($sim->[1] !~ /fig\|/);          next if ($sim->[1] !~ /fig\|/);
457          my $genome = $fig->genome_of($sim->[1]);          my $genome = $fig->genome_of($sim->[1]);
458          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));          my ($genome1) = ($genome) =~ /(.*)\./;
459            my $taxonomy = $taxes->{$genome1};
460            #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated
461          my $parent_tax = "Root";          my $parent_tax = "Root";
462          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
463          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 451  Line 465 
465              push (@currLineage, $tax);              push (@currLineage, $tax);
466              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
467              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
468                if (defined ($families{evalue}{$tax})){
469                    if ($sim->[10] < $families{evalue}{$tax}){
470                        $families{evalue}{$tax} = $sim->[10];
471                        $families{color}{$tax} = &get_taxcolor($sim->[10]);
472                    }
473                }
474                else{
475                    $families{evalue}{$tax} = $sim->[10];
476                    $families{color}{$tax} = &get_taxcolor($sim->[10]);
477                }
478    
479              $parent_tax = $tax;              $parent_tax = $tax;
480          }          }
481      }      }
# Line 473  Line 498 
498    
499  =cut  =cut
500    
501    sub get_taxcolor{
502        my ($evalue) = @_;
503        my $color;
504        if ($evalue <= 1e-170){        $color = "#FF2000";    }
505        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
506        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
507        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
508        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
509        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
510        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
511        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
512        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
513        else{        $color = "#6666FF";    }
514        return ($color);
515    }
516    
517    
518  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
519    
520      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
# Line 685  Line 727 
727          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
728    
729          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
730                        'query' => $sim->[0],
731                      'acc' => $hit,                      'acc' => $hit,
732                      'identity' => $percent,                      'identity' => $percent,
733                      'type' => 'seq',                      'type' => 'seq',
# Line 1356  Line 1399 
1399      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1400      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1401      if($cello_location){      if($cello_location){
1402          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1403          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1404      }      }
1405      return ($html);      return ($html);
1406  }  }
# Line 1418  Line 1461 
1461          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1462      }      }
1463    
 =cut  
   
1464      $color = "2";      $color = "2";
1465      if($tmpred_score){      if($tmpred_score){
1466          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1490 
1490          }          }
1491          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1492      }      }
1493    =cut
1494    
1495      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1496          my $line_data =[];          my $line_data =[];
1497          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1498                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1499                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1500    
1501          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1502              my $descriptions = [];              my $descriptions = [];
1503              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1504                               "value" => $tm_loc};                               "value" => $tm_loc};
1505              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1506    
1507              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1508    
1509              my $element_hash = {              my $element_hash = {
1510              "title" => "phobius transmembrane location",              "title" => "Phobius",
1511              "start" => $begin + 1,              "start" => $begin + 1,
1512              "end" =>  $end + 1,              "end" =>  $end + 1,
1513              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1541 
1541          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1542      }      }
1543    
1544    =head3
1545      $color = "1";      $color = "1";
1546      if($signal_peptide_score){      if($signal_peptide_score){
1547          my $line_data = [];          my $line_data = [];
# Line 1531  Line 1573 
1573          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1574          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1575      }      }
1576    =cut
1577    
1578      return ($gd);      return ($gd);
1579    
# Line 1602  Line 1645 
1645      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1646      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1647      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1648        $self->{query} = $dataset->{'query'};
1649      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1650      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1651      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1629  Line 1673 
1673    
1674      my $fig = new FIG;      my $fig = new FIG;
1675      my $peg = $self->acc;      my $peg = $self->acc;
1676        my $query = $self->query;
1677    
1678      my $organism = $self->organism;      my $organism = $self->organism;
1679      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
# Line 1670  Line 1715 
1715          push(@$links_list,$link);          push(@$links_list,$link);
1716      }      }
1717    
1718        $link = {"link_title" => "blast against query",
1719                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=tool_result&tool=bl2seq&peg1=$query&peg2=$peg"};
1720        push (@$links_list,$link);
1721    
1722      my $description_function;      my $description_function;
1723      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1724                               "value" => $function};                               "value" => $function};
# Line 1848  Line 1897 
1897  =cut  =cut
1898    
1899  sub display_table {  sub display_table {
1900      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages) = @_;
1901    
1902      my $data = [];      my $data = [];
1903      my $count = 0;      my $count = 0;
# Line 1898  Line 1947 
1947          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1948          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1949          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1950            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1951    
1952          # get the linked fig id          # get the linked fig id
1953          my $fig_col;          my $fig_col;
# Line 1930  Line 1980 
1980              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}
1981              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}
1982              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}
1983                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1984          }          }
1985          push(@$data,$single_domain);          push(@$data,$single_domain);
1986      }      }
# Line 2042  Line 2093 
2093      my ($ids) = @_;      my ($ids) = @_;
2094      my $fig = new FIG;      my $fig = new FIG;
2095      my $cgi = new CGI;      my $cgi = new CGI;
2096      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2097      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2098    
2099      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
2100      foreach my $key (@codes){      foreach my $key (@codes){
2101          push (@{$code_attributes{$$key[0]}}, $$key[1]);          push (@{$code_attributes{$$key[0]}}, $$key[1]);
2102            push (@{$attribute_location{$$key[0]}{$$key[1]}}, $$key[2]);
2103      }      }
2104    
2105      foreach my $id (@$ids){      foreach my $id (@$ids){
# Line 2057  Line 2109 
2109          my %description_codes;          my %description_codes;
2110    
2111          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2112              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2113              @pfam_codes = ();              @pfam_codes = ();
2114              foreach my $code (@codes) {  
2115                # get only unique values
2116                my %saw;
2117                foreach my $key (@ncodes) {$saw{$key}=1;}
2118                @ncodes = keys %saw;
2119    
2120                foreach my $code (@ncodes) {
2121                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2122                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2123    
2124                    # get the locations for the domain
2125                    my @locs;
2126                    foreach my $part (@{$attribute_location{$id}{$code}}){
2127                        my ($loc) = ($part) =~ /\;(.*)/;
2128                        push (@locs,$loc);
2129                    }
2130                    my $locations = join (", ", @locs);
2131    
2132                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2133                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2134                  }                  }
2135                  else {                  else {
2136                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2137                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2138                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2139                  }                  }
2140              }              }
2141          }          }
# Line 2099  Line 2165 
2165    
2166  sub color {  sub color {
2167      my ($evalue) = @_;      my ($evalue) = @_;
   
2168      my $color;      my $color;
2169      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = 51;    }
2170          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }
2171      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }
2172      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }
2173          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }
2174      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }
2175      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }
2176          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }
2177      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }
2178      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){      else{        $color = 60;    }
         $color = 54;  
     }  
     elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
         $color = 55;  
     }  
     elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){  
         $color = 56;  
     }  
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
     }  
     elsif (($evalue <= 1) && ($evalue > 1e-5)){  
         $color = 58;  
     }  
     elsif (($evalue <= 10) && ($evalue > 1)){  
         $color = 59;  
     }  
     else{  
         $color = 60;  
     }  
   
   
2179      return ($color);      return ($color);
2180  }  }
2181    
# Line 2152  Line 2195 
2195  }  }
2196    
2197  sub display {  sub display {
2198      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes) = @_;
2199    
2200      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2201      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
# Line 2205  Line 2248 
2248      my %all_genomes;      my %all_genomes;
2249      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}
2250    
2251      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "sims"){
     {  
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($pair_beg+(($pair_end-$pair_beg)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($pair_end+(($pair_beg-$pair_end)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
                 }  
   
                 push (@start_array_region, $offset);  
   
                 $all_genomes{$pair_genome} = 1;  
                 my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                 push(@$all_regions,$pair_features);  
                 foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
             }  
             $coup_count++;  
         }  
     }  
     elsif ($compare_or_coupling eq "sims"){  
2252          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2253          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2254    
2255          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
# Line 2260  Line 2260 
2260              foreach my $sim (@sims){              foreach my $sim (@sims){
2261                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->[1] !~ /fig\|/);
2262                  my $genome = $fig->genome_of($sim->[1]);                  my $genome = $fig->genome_of($sim->[1]);
2263                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my ($genome1) = ($genome) =~ /(.*)\./;
2264                    my $lineage = $taxes->{$genome1};
2265                    #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2266                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2267                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2268                          push (@selected_sims, $sim->[1]);                          push (@selected_sims, $sim->[1]);
# Line 2270  Line 2272 
2272                  @selected_sims = grep(!$saw{$_}++, @selected_sims);                  @selected_sims = grep(!$saw{$_}++, @selected_sims);
2273              }              }
2274          }          }
2275            else{
2276                my $simcount = 0;
2277                foreach my $sim (@sims){
2278                    next if ($sim->[1] !~ /fig\|/);
2279                    push (@selected_sims, $sim->[1]);
2280                    $simcount++;
2281                    last if ($simcount > 4);
2282                }
2283            }
2284    
2285          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2286          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2325  Line 2336 
2336          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2337          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2338          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2339            my ($genome1) = ($region_genome) =~ /(.*?)\./;
2340            my $lineage = $taxes->{$genome1};
2341            #$region_gs .= "Lineage:$lineage";
2342          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2343                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2344                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2346 
2346    
2347          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2348    
2349          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2350                                     'short_title' => "",                                     'short_title' => "",
2351                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2352                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2423  Line 2437 
2437              }              }
2438          }          }
2439          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2440          $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2441      }      }
2442      return $gd;      return $gd;
2443  }  }

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.40

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3