[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.50, Thu Dec 6 18:47:35 2007 UTC revision 1.53, Mon Feb 18 20:29:09 2008 UTC
# Line 8  Line 8 
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10  use WebColors;  use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  #use strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FigFams;
18    
19  1;  1;
20    
# Line 414  Line 416 
416  =cut  =cut
417    
418  sub get_sims_summary {  sub get_sims_summary {
419      my ($observation, $fid, $taxes, $dataset, $fig) = @_;      my ($observation, $dataset, $fig) = @_;
420      my %families;      my %families;
421      #my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
422    
423      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
424            my ($id, $evalue);
425            if ($thing =~ /fig\|/){
426                $id = $thing;
427                $evalue = -1;
428            }
429            else{
430          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
431                $id      = $thing->acc;
432          my $id      = $thing->acc;              $evalue  = $thing->evalue;
433          my $evalue  = $thing->evalue;          }
   
434          next if ($id !~ /fig\|/);          next if ($id !~ /fig\|/);
435          next if ($fig->is_deleted_fid($id));          next if ($fig->is_deleted_fid($id));
436    
437          my $genome = $fig->genome_of($id);          my $genome = $fig->genome_of($id);
438          #my ($genome1) = ($genome) =~ /(.*)\./;          #my ($genome1) = ($genome) =~ /(.*)\./;
439          #my $taxonomy = $taxes->{$genome1};          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated  
440          my $parent_tax = "Root";          my $parent_tax = "Root";
441          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
442            push (@{$families{figs}{$parent_tax}}, $id);
443            my $level = 2;
444          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
445              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
446                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
447                $families{level}{$tax} = $level;
448              push (@currLineage, $tax);              push (@currLineage, $tax);
449              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
450              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
451              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
452                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($evalue < $families{evalue}{$tax}){
453                      $families{evalue}{$tax} = $evalue;                      $families{evalue}{$tax} = $evalue;
454                      $families{color}{$tax} = &get_taxcolor($evalue);                      $families{color}{$tax} = &get_taxcolor($evalue);
455                  }                  }
# Line 449  Line 460 
460              }              }
461    
462              $parent_tax = $tax;              $parent_tax = $tax;
463                $level++;
464          }          }
465      }      }
466    
# Line 459  Line 471 
471          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
472          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
473      }      }
474      return (\%families);  
475        return \%families;
476  }  }
477    
478  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 486 
486  sub get_taxcolor{  sub get_taxcolor{
487      my ($evalue) = @_;      my ($evalue) = @_;
488      my $color;      my $color;
489      if ($evalue <= 1e-170){        $color = "#FF2000";    }      if ($evalue == -1){            $color = "black";      }
490        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
491      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
492      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
493      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
# Line 919  Line 933 
933      my ($self,$gd,$fig) = @_;      my ($self,$gd,$fig) = @_;
934    
935      my $fid = $self->fig_id;      my $fid = $self->fig_id;
936      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
937                                    -host     => $WebConfig::DBHOST,
938                                    -user     => $WebConfig::DBUSER,
939                                    -password => $WebConfig::DBPWD);
940    
941      my $acc = $self->acc;      my $acc = $self->acc;
942    
# Line 1178  Line 1195 
1195      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1196      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1197    
1198      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1199                                    -host     => $WebConfig::DBHOST,
1200                                    -user     => $WebConfig::DBUSER,
1201                                    -password => $WebConfig::DBPWD);
1202    
1203      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1204      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1255  Line 1275 
1275      my $link;      my $link;
1276      my $link_url;      my $link_url;
1277      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1278      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1279      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1280    
1281      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1293  Line 1313 
1313          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1314          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1315    
1316          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1317                                    -host     => $WebConfig::DBHOST,
1318                                    -user     => $WebConfig::DBUSER,
1319                                    -password => $WebConfig::DBPWD);
1320    
1321          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1322          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1312  Line 1335 
1335                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1336              }              }
1337          }          }
1338            elsif($db =~ /PFAM/){
1339                my ($new_id) = ($id) =~ /(.*?)_/;
1340                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1341                if(!scalar(@$pfam_objs)){
1342                    $name_title = "name";
1343                    $name_value = "not available";
1344                    $description_title = "description";
1345                    $description_value = "not available";
1346                }
1347                else{
1348                    my $pfam_obj = $pfam_objs->[0];
1349                    $name_title = "name";
1350                    $name_value = $pfam_obj->term;
1351                    #$description_title = "description";
1352                    #$description_value = $pfam_obj->description;
1353                }
1354            }
1355    
1356          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1357    
# Line 1800  Line 1840 
1840              }              }
1841          }          }
1842    
1843          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1844                                    -host     => $WebConfig::DBHOST,
1845                                    -user     => $WebConfig::DBUSER,
1846                                    -password => $WebConfig::DBPWD);
1847          my ($name_value,$description_value);          my ($name_value,$description_value);
1848    
1849          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1837  Line 1880 
1880          my $link;          my $link;
1881          my $link_url;          my $link_url;
1882          if ($db eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}          if ($db eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1883          elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}          elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1884          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
1885    
1886          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1889  Line 1932 
1932      #my $fig = new FIG;      #my $fig = new FIG;
1933      my $cgi = new CGI;      my $cgi = new CGI;
1934      my @ids;      my @ids;
1935        $lineages = $fig->taxonomy_list();
1936    
1937      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1938          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1939          push (@ids, $thing->acc);          push (@ids, $thing->acc);
# Line 1910  Line 1955 
1955      my $alias_col = &get_aliases(\@ids,$fig);      my $alias_col = &get_aliases(\@ids,$fig);
1956      #my $alias_col = {};      #my $alias_col = {};
1957    
1958        my $figfam_data = "$FIG_Config::FigfamsData";
1959        my $figfams = new FigFams($fig,$figfam_data);
1960        my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1961    
1962      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1963          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1964          my $single_domain = [];          my $single_domain = [];
# Line 1961  Line 2010 
2010              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
2011              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
2012              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
2013              #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2014              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}              #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2015                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2016          }          }
2017          push(@$data,$single_domain);          push(@$data,$single_domain);
2018      }      }
# Line 2084  Line 2134 
2134      #my $fig = new FIG;      #my $fig = new FIG;
2135      my $cgi = new CGI;      my $cgi = new CGI;
2136      my (%column, %code_attributes, %attribute_locations);      my (%column, %code_attributes, %attribute_locations);
2137      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2138                                    -host     => $WebConfig::DBHOST,
2139                                    -user     => $WebConfig::DBUSER,
2140                                    -password => $WebConfig::DBPWD);
2141    
2142      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2143      foreach my $key (@codes){      foreach my $key (@codes){
# Line 2113  Line 2166 
2166    
2167              foreach my $code (@ncodes) {              foreach my $code (@ncodes) {
2168                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2169                  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://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2170    
2171                  # get the locations for the domain                  # get the locations for the domain
2172                  my @locs;                  my @locs;
# Line 2195  Line 2248 
2248  sub display {  sub display {
2249      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2250    
2251        $taxes = $fig->taxonomy_list();
2252    
2253      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2254      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2255      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
# Line 2268  Line 2323 
2323                  #my $genome = $fig->genome_of($sim->[1]);                  #my $genome = $fig->genome_of($sim->[1]);
2324                  my $genome = $fig->genome_of($sim->acc);                  my $genome = $fig->genome_of($sim->acc);
2325                  #my ($genome1) = ($genome) =~ /(.*)\./;                  #my ($genome1) = ($genome) =~ /(.*)\./;
2326                  #my $lineage = $taxes->{$genome1};                  my $lineage = $taxes->{$genome};
2327                  my $lineage = $fig->taxonomy_of($fig->genome_of($genome));                  #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2328                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2329                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2330                          #push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
# Line 2351  Line 2406 
2406          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2407          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2408          #my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2409          #my $lineage = $taxes->{$genome1};          my $lineage = $taxes->{$region_genome};
2410          my $lineage = $fig->taxonomy_of($region_genome);          #my $lineage = $fig->taxonomy_of($region_genome);
2411          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
2412          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2413                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,

Legend:
Removed from v.1.50  
changed lines
  Added in v.1.53

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3