[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.41, Tue Oct 9 19:05:29 2007 UTC revision 1.46, Thu Nov 29 19:33:33 2007 UTC
# Line 7  Line 7 
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10    use WebColors;
11    
12  use FIG_Config;  use FIG_Config;
13  #use strict;  #use strict;
14  #use warnings;  #use warnings;
# Line 321  Line 323 
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     #my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 383  Line 384 
384      my $row = [];      my $row = [];
385    
386      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
387        my $org_id = $fig->genome_of($fid);
388      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
389      #my $taxonomy = $fig->taxonomy_of($org_id);      #my $taxonomy = $fig->taxonomy_of($org_id);
390      my $length = $fig->translation_length($fid);      my $length = $fig->translation_length($fid);
# Line 412  Line 414 
414  =cut  =cut
415    
416  sub get_sims_summary {  sub get_sims_summary {
417      my ($observation, $fid, $taxes,$fig) = @_;      my ($observation, $fid, $taxes, $dataset, $fig) = @_;
     #my $fig = new FIG;  
418      my %families;      my %families;
419      my @sims= $fig->nsims($fid,20000,10,"fig");      #my @sims= $fig->nsims($fid,20000,10,"fig");
420    
421      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
422          next if ($sim->[1] !~ /fig\|/);          next if ($thing->class ne "SIM");
423          my $genome = $fig->genome_of($sim->[1]);  
424          my ($genome1) = ($genome) =~ /(.*)\./;          my $id      = $thing->acc;
425          my $taxonomy = $taxes->{$genome1};          my $evalue  = $thing->evalue;
426          #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated  
427            next if ($id !~ /fig\|/);
428            next if ($fig->is_deleted_fid($id));
429            my $genome = $fig->genome_of($id);
430            #my ($genome1) = ($genome) =~ /(.*)\./;
431            #my $taxonomy = $taxes->{$genome1};
432            my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated
433          my $parent_tax = "Root";          my $parent_tax = "Root";
434          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
435          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 432  Line 439 
439              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
440              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
441                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($sim->[10] < $families{evalue}{$tax}){
442                      $families{evalue}{$tax} = $sim->[10];                      $families{evalue}{$tax} = $evalue;
443                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                      $families{color}{$tax} = &get_taxcolor($evalue);
444                  }                  }
445              }              }
446              else{              else{
447                  $families{evalue}{$tax} = $sim->[10];                  $families{evalue}{$tax} = $evalue;
448                  $families{color}{$tax} = &get_taxcolor($sim->[10]);                  $families{color}{$tax} = &get_taxcolor($evalue);
449              }              }
450    
451              $parent_tax = $tax;              $parent_tax = $tax;
# Line 485  Line 492 
492      # 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)
493      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
494    
     #my $fig = new FIG;  
   
495      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
496          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
497          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 647  Line 652 
652    
653      my ($fid,$datasets_ref,$fig) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
654      #my $fig = new FIG;      #my $fig = new FIG;
655      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
656      my ($dataset);      my ($dataset);
657    
658      foreach my $sim (@sims){      foreach my $sim (@sims){
659            next if ($fig->is_deleted_fid($sim->[1]));
660          my $hit = $sim->[1];          my $hit = $sim->[1];
661          my $percent = $sim->[2];          my $percent = $sim->[2];
662          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 1119  Line 1125 
1125          # construct the score link          # construct the score link
1126          my $score = $row->[0];          my $score = $row->[0];
1127          my $toid = $row->[1];          my $toid = $row->[1];
1128          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1129          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1130    
1131          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1132          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1347  Line 1353 
1353  }  }
1354    
1355  sub display_cello {  sub display_cello {
1356      my ($thing,$fig) = @_;      my ($thing) = @_;
1357      my $html;      my $html;
1358      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1359      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
# Line 1664  Line 1670 
1670              my $descriptions = [];              my $descriptions = [];
1671    
1672              # get subsystem information              # get subsystem information
1673              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
1674              my $link;              my $link;
1675              $link = {"link_title" => $peg,              $link = {"link_title" => $peg,
1676                       "link" => $url_link};                       "link" => $url_link};
# Line 1678  Line 1684 
1684                  my $subsystem = $$array[0];                  my $subsystem = $$array[0];
1685                  push(@subsystems,$subsystem);                  push(@subsystems,$subsystem);
1686                  my $link;                  my $link;
1687                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1688                           "link_title" => $subsystem};                           "link_title" => $subsystem};
1689                  push(@$links_list,$link);                  push(@$links_list,$link);
1690              }              }
# Line 1752  Line 1758 
1758  sub display_domain_composition {  sub display_domain_composition {
1759      my ($self,$gd,$fig) = @_;      my ($self,$gd,$fig) = @_;
1760    
1761      #my $fig = new FIG;      #$fig = new FIG;
1762      my $peg = $self->acc;      my $peg = $self->acc;
1763    
1764      my $line_data = [];      my $line_data = [];
# Line 1760  Line 1766 
1766      my $descriptions = [];      my $descriptions = [];
1767    
1768      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1769        #my @domain_query_results = ();
1770      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1771          my $key = @$dqr[1];          my $key = @$dqr[1];
1772          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1892  Line 1898 
1898    
1899      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1900      my $alias_col = &get_aliases(\@ids,$fig);      my $alias_col = &get_aliases(\@ids,$fig);
1901        #my $alias_col = {};
1902    
1903      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1904          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1899  Line 1906 
1906          $count++;          $count++;
1907    
1908          my $id      = $thing->acc;          my $id      = $thing->acc;
1909            my $taxid   = $fig->genome_of($id);
1910          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1911          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1912          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1920  Line 1928 
1928          # get the linked fig id          # get the linked fig id
1929          my $fig_col;          my $fig_col;
1930          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1931              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1932          }          }
1933          else{          else{
1934              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1935          }          }
1936    
1937          push (@$single_domain, $box_col, $fig_col, $thing->evalue,          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
# Line 1940  Line 1948 
1948              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1949              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1950              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1951              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1952              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1953              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1954              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}              #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1955                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1956          }          }
1957          push(@$data,$single_domain);          push(@$data,$single_domain);
1958      }      }
   
1959      if ($count >0 ){      if ($count >0 ){
1960          $content = $data;          $content = $data;
1961      }      }
# Line 2144  Line 2152 
2152    
2153  sub color {  sub color {
2154      my ($evalue) = @_;      my ($evalue) = @_;
2155        my $palette = WebColors::get_palette('vitamins');
2156      my $color;      my $color;
2157      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2158      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2159      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2160      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2161      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2162      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2163      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2164      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2165      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2166      else{        $color = 60;    }      else{        $color = $palette->[9];    }
2167      return ($color);      return ($color);
2168  }  }
2169    
# Line 2180  Line 2189 
2189      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2190      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2191      my $range = $gd_window_size;      my $range = $gd_window_size;
     #my $fig = new FIG;  
2192      my $all_regions = [];      my $all_regions = [];
2193      my $gene_associations={};      my $gene_associations={};
2194    
# Line 2220  Line 2228 
2228    
2229      # call genes in region      # call genes in region
2230      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2231        #foreach my $feat (@$target_gene_features){
2232        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2233        #}
2234      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2235      my (@start_array_region);      my (@start_array_region);
2236      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2237    
2238      my %all_genes;      my %all_genes;
2239      my %all_genomes;      my %all_genomes;
2240      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2241            #if ($feature =~ /peg/){
2242                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2243            #}
2244        }
2245    
2246      my @selected_sims;      my @selected_sims;
2247    
2248      if ($compare_or_coupling eq "sims"){      if ($compare_or_coupling eq "sims"){
# Line 2241  Line 2257 
2257    
2258                  #my $genome = $fig->genome_of($sim->[1]);                  #my $genome = $fig->genome_of($sim->[1]);
2259                  my $genome = $fig->genome_of($sim->acc);                  my $genome = $fig->genome_of($sim->acc);
2260                  my ($genome1) = ($genome) =~ /(.*)\./;                  #my ($genome1) = ($genome) =~ /(.*)\./;
2261                  my $lineage = $taxes->{$genome1};                  #my $lineage = $taxes->{$genome1};
2262                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2263                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2264                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2265                          #push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
# Line 2312  Line 2328 
2328    
2329      }      }
2330    
2331      print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2332      # cluster the genes      # cluster the genes
2333      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2334      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2335      print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2336      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2337    
2338      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
# Line 2324  Line 2340 
2340          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2341          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2342          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2343          my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2344          my $lineage = $taxes->{$genome1};          #my $lineage = $taxes->{$genome1};
2345            my $lineage = $fig->taxonomy_of($region_genome);
2346          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
2347          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2348                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2358  Line 2375 
2375    
2376              # get subsystem information              # get subsystem information
2377              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2378              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2379    
2380              my $link;              my $link;
2381              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
# Line 2373  Line 2390 
2390                  $ss =~ s/_/ /ig;                  $ss =~ s/_/ /ig;
2391                  push (@subsystems, $ss);                  push (@subsystems, $ss);
2392                  my $link;                  my $link;
2393                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2394                           "link_title" => $ss};                           "link_title" => $ss};
2395                  push(@$links_list,$link);                  push(@$links_list,$link);
2396              }              }
# Line 2529  Line 2546 
2546      }      }
2547    
2548      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2549          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2550              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2551                  foreach $y (@$x) {                  foreach $y (@$x) {
2552                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2596  Line 2613 
2613          $org = $fig->org_of($id);          $org = $fig->org_of($id);
2614          $function = $fig->function_of($id);          $function = $fig->function_of($id);
2615          if ($mypeg ne $id){          if ($mypeg ne $id){
2616              $function_cell = qq(<input type=radio name=function id=$id value=$id onClick="clearText('newAnnotation');">&nbsp;&nbsp;$function);              $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";
2617              $id_cell .= &HTML::set_prot_links($cgi,$id);              $id_cell .= &HTML::set_prot_links($cgi,$id);
2618              if (defined($e_identical{$id})) { $id_cell .= "*";}              if (defined($e_identical{$id})) { $id_cell .= "*";}
2619          }          }

Legend:
Removed from v.1.41  
changed lines
  Added in v.1.46

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3