[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.46, Thu Nov 29 19:33:33 2007 UTC revision 1.81, Thu Aug 27 13:58:34 2009 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3  use lib '/vol/ontologies';  #use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5  use Data::Dumper;  use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10  use WebColors;  use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14    use LWP::Simple;
15  #use strict;  #use strict;
16  #use warnings;  #use warnings;
17  use HTML;  use HTML;
18    use FFs;
19    
20  1;  1;
21    
 # $Id$  
   
22  =head1 NAME  =head1 NAME
23    
24  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 319  Line 320 
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$fig,$scope) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
# Line 333  Line 334 
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
337          $domain_classes{'CDD'} = 1;          #$domain_classes{'CDD'} = 1;
338          $domain_classes{'PFAM'} = 1;          $domain_classes{'PFAM'} = 1;
339          get_identical_proteins($fid,\@matched_datasets,$fig);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_sims_observations($fid,\@matched_datasets,$fig);          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          get_functional_coupling($fid,\@matched_datasets,$fig);          get_functional_coupling($fid,\@matched_datasets,$fig);
343          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
# Line 374  Line 375 
375    
376  }  }
377    
378    =head3 get_attributes
379        provides layer of abstraction between tools and underlying access method to Attribute Server
380    =cut
381    
382    sub get_attributes{
383        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
384        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
385        return @attributes;
386    }
387    
388    =head3 get_sims_objects()
389    
390    This is the B<REAL WORKHORSE> method of this Package.
391    
392    =cut
393    
394    sub get_sims_objects {
395        my ($self,$fid,$fig,$parameters) = @_;
396    
397        my $objects = [];
398        my @matched_datasets=();
399    
400        # call function that fetches attribute based observations
401        # returns an array of arrays of hashes
402        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
403    
404        foreach my $dataset (@matched_datasets) {
405            my $object;
406            if ($dataset->{'class'} eq "SIM"){
407                $object = Observation::Sims->new($dataset);
408            }
409            push (@$objects, $object);
410        }
411        return $objects;
412    }
413    
414    
415  =head3 display_housekeeping  =head3 display_housekeeping
416  This method returns the housekeeping data for a given peg in a table format  This method returns the housekeeping data for a given peg in a table format
417    
# Line 383  Line 421 
421      my $content = [];      my $content = [];
422      my $row = [];      my $row = [];
423    
424      my $org_name = $fig->org_of($fid);      my $org_name = "Data not available";
425        if ( $fig->org_of($fid)){
426            $org_name = $fig->org_of($fid);
427        }
428      my $org_id = $fig->genome_of($fid);      my $org_id = $fig->genome_of($fid);
429      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
430      #my $taxonomy = $fig->taxonomy_of($org_id);      #my $taxonomy = $fig->taxonomy_of($org_id);
# Line 414  Line 455 
455  =cut  =cut
456    
457  sub get_sims_summary {  sub get_sims_summary {
458      my ($observation, $fid, $taxes, $dataset, $fig) = @_;      my ($observation, $dataset, $fig) = @_;
459      my %families;      my %families;
460      #my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
461    
462      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
463            my ($id, $evalue);
464            if ($thing =~ /fig\|/){
465                $id = $thing;
466                $evalue = -1;
467            }
468            else{
469          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
470                $id      = $thing->acc;
471          my $id      = $thing->acc;              $evalue  = $thing->evalue;
472          my $evalue  = $thing->evalue;          }
   
473          next if ($id !~ /fig\|/);          next if ($id !~ /fig\|/);
474          next if ($fig->is_deleted_fid($id));          next if ($fig->is_deleted_fid($id));
475    
476          my $genome = $fig->genome_of($id);          my $genome = $fig->genome_of($id);
477          #my ($genome1) = ($genome) =~ /(.*)\./;          #my ($genome1) = ($genome) =~ /(.*)\./;
478          #my $taxonomy = $taxes->{$genome1};          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated  
479          my $parent_tax = "Root";          my $parent_tax = "Root";
480          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
481          foreach my $tax (split(/\; /, $taxonomy)){          push (@{$families{figs}{$parent_tax}}, $id);
482              push (@{$families{children}{$parent_tax}}, $tax);          my $level = 2;
483    
484            foreach my $tax (split(/\; /, $taxonomy),$id){
485              next if ($tax eq $parent_tax);
486              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
487              push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
488              $families{level}{$tax} = $level;
489              push (@currLineage, $tax);              push (@currLineage, $tax);
490              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
491              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
492              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
493                  if ($sim->[10] < $families{evalue}{$tax}){              if ($evalue < $families{evalue}{$tax}){
494                      $families{evalue}{$tax} = $evalue;                      $families{evalue}{$tax} = $evalue;
495                      $families{color}{$tax} = &get_taxcolor($evalue);                      $families{color}{$tax} = &get_taxcolor($evalue);
496                  }                  }
# Line 449  Line 501 
501              }              }
502    
503              $parent_tax = $tax;              $parent_tax = $tax;
504              $level++;
505          }          }
506      }      }
507    
# Line 459  Line 512 
512          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
513          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
514      }      }
515      return (\%families);  
516        return \%families;
517  }  }
518    
519  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 527 
527  sub get_taxcolor{  sub get_taxcolor{
528      my ($evalue) = @_;      my ($evalue) = @_;
529      my $color;      my $color;
530      if ($evalue <= 1e-170){        $color = "#FF2000";    }      if ($evalue == -1){            $color = "black";      }
531        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
532      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
533      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
534      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
# Line 491  Line 546 
546    
547      # 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)
548      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
550      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
551          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $class = $parts[0];          my $class = $parts[0];
554            my $name = $parts[1];
555            next if ($seen->{$name});
556            $seen->{$name}++;
557            #next if (($class eq "PFAM") && ($name !~ /interpro/));
558    
559          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
560              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 504  Line 563 
563                  my $from = $2;                  my $from = $2;
564                  my $to = $3;                  my $to = $3;
565                  my $evalue;                  my $evalue;
566                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
567                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
568                      my $part1 = $2/100;                      my $part1 = $2/100;
569                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
570                  }                  }
571                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
572                        #$evalue=$raw_evalue;
573                        my $part2 = 1000 - $1;
574                        my $part1 = $2/100;
575                        $evalue = $part1."e-".$part2;
576    
577                    }
578                  else{                  else{
579                      $evalue = "0.0";                      $evalue = "0.0";
580                  }                  }
# Line 649  Line 715 
715  =cut  =cut
716    
717  sub get_sims_observations{  sub get_sims_observations{
718        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
719    
720      my ($fid,$datasets_ref,$fig) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
721      #my $fig = new FIG;      if ( (defined $parameters->{flag}) && ($parameters->{flag})){
722      my @sims= $fig->sims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
723          $max_expand = $parameters->{max_expand};
724          $max_eval = $parameters->{max_eval};
725          $db_filter = $parameters->{db_filter};
726          $sim_filters->{ sort_by } = $parameters->{sim_order};
727          #$sim_order = $parameters->{sim_order};
728          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
729        }
730        elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
731          $max_sims = 50;
732          $max_expand = 5;
733          $max_eval = 1e-5;
734          $db_filter = "all";
735          $sim_filters->{ sort_by } = 'id';
736        }
737        else{
738          $max_sims = 50;
739          $max_expand = 5;
740          $max_eval = 1e-5;
741          $db_filter = "figx";
742          $sim_filters->{ sort_by } = 'id';
743          #$sim_order = "id";
744        }
745    
746        my($id, $genome, @genomes, %sims);
747    #    my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
748        my @tmp= $fig->sims($fid,1000000,$max_eval,$db_filter,$max_expand,$sim_filters);
749        @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
750      my ($dataset);      my ($dataset);
751    
752      foreach my $sim (@sims){      if ($group_by_genome){
753          next if ($fig->is_deleted_fid($sim->[1]));        #  Collect all sims from genome with the first occurance of the genome:
754          foreach $sim ( @tmp ){
755            $id = $sim->id2;
756            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
757            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
758            push @{ $sims{ $genome } }, $sim;
759          }
760          @tmp = map { @{ $sims{$_} } } @genomes;
761        }
762    
763        my $seen_sims={};
764        my $count=1;
765        foreach my $sim (@tmp){
766    
767          my $hit = $sim->[1];          my $hit = $sim->[1];
768            next if ($seen_sims->{$hit});
769            next if ($hit =~ /nmpdr\||gnl\|md5\|/);
770            $seen_sims->{$hit}++;
771    
772            last if ($count>$max_sims);
773            $count++;
774    
775          my $percent = $sim->[2];          my $percent = $sim->[2];
776          my $evalue = $sim->[10];          my $evalue = $sim->[10];
777          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 668  Line 782 
782          my $hlength = $sim->[13];          my $hlength = $sim->[13];
783          my $db = get_database($hit);          my $db = get_database($hit);
784          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
785          my $organism = $fig->org_of($hit);          my $organism;
786            if ($fig->org_of($hit)){
787                $organism = $fig->org_of($hit);
788            }
789            else{
790                $organism = "Data not available";
791            }
792    
793          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
794                      'query' => $sim->[0],                      'query' => $sim->[0],
# Line 701  Line 821 
821      my ($id) = (@_);      my ($id) = (@_);
822    
823      my ($db);      my ($db);
824      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
825      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
826        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
827      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
828        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
829      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
830      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
831      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 712  Line 834 
834      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
835      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
836      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
837        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
838        elsif ($id =~ /^img\|/)           { $db = "IMG" }
839        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
840        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
841    
842      return ($db);      return ($db);
843    
# Line 769  Line 895 
895      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
896    
897      # get the fc data      # get the fc data
898      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff);
899    
900      # retrieve data      # retrieve data
901      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
902                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
903                    } @fc_data;                    } @fc_data;
904    
     my ($dataset);  
905      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
906                     'type' => 'fc',                     'type' => 'fc',
907                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 887  Line 1012 
1012      return $self->{database};      return $self->{database};
1013  }  }
1014    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
1015  ############################################################  ############################################################
1016  ############################################################  ############################################################
1017  package Observation::PDB;  package Observation::PDB;
# Line 921  Line 1040 
1040      my ($self,$gd,$fig) = @_;      my ($self,$gd,$fig) = @_;
1041    
1042      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1043      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1044                                     -host     => $WebConfig::DBHOST,
1045                                     -user     => $WebConfig::DBUSER,
1046                                     -password => $WebConfig::DBPWD);
1047    
1048      my $acc = $self->acc;      my $acc = $self->acc;
1049    
# Line 942  Line 1064 
1064      my $lines = [];      my $lines = [];
1065      my $line_data = [];      my $line_data = [];
1066      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1067                            'hover_title' => 'PDB',
1068                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1069                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1070    
# Line 1059  Line 1182 
1182          my $id = $row->[0];          my $id = $row->[0];
1183          my $who = $row->[1];          my $who = $row->[1];
1184          my $assignment = $row->[2];          my $assignment = $row->[2];
1185          my $organism = $fig->org_of($id);          my $organism = "Data not available";
1186            if ($fig->org_of($id)){
1187                $organism = $fig->org_of($id);
1188            }
1189          my $single_domain = [];          my $single_domain = [];
1190          push(@$single_domain,$who);          push(@$single_domain,$who);
1191          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1192          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1193          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1194          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1179  Line 1305 
1305      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1306      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1307    
1308      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1309                                    -host     => $WebConfig::DBHOST,
1310                                    -user     => $WebConfig::DBUSER,
1311                                    -password => $WebConfig::DBPWD);
1312    
1313      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1314      if($db eq "CDD"){  
1315          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1316          if(!scalar(@$cdd_objs)){          my $new_id;
1317              $name_title = "name";          if ($id =~ /_/){
1318              $name_value = "not available";              ($new_id) = ($id) =~ /(.*?)_/;
             $description_title = "description";  
             $description_value = "not available";  
1319          }          }
1320          else{          else{
1321              my $cdd_obj = $cdd_objs->[0];              $new_id = $id;
             $name_title = "name";  
             $name_value = $cdd_obj->term;  
             $description_title = "description";  
             $description_value = $cdd_obj->description;  
         }  
1322      }      }
1323      elsif($db =~ /PFAM/){  
1324          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1325          if(!scalar(@$pfam_objs)){          if(!scalar(@$pfam_objs)){
1326              $name_title = "name";              $name_title = "name";
1327              $name_value = "not available";              $name_value = "not available";
# Line 1217  Line 1339 
1339    
1340      my $short_title = $thing->acc;      my $short_title = $thing->acc;
1341      $short_title =~ s/::/ - /ig;      $short_title =~ s/::/ - /ig;
1342        my $new_short_title=$short_title;
1343        if ($short_title =~ /interpro/){
1344            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1345        }
1346      my $line_config = { 'title' => $name_value,      my $line_config = { 'title' => $name_value,
1347                          'short_title' => $short_title,                          'hover_title', => 'Domain',
1348                            'short_title' => $new_short_title,
1349                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1350    
1351      my $name;      my $name;
1352        my ($new_id) = ($id) =~ /(.*?)_/;
1353      $name = {"title" => $db,      $name = {"title" => $db,
1354               "value" => $id};               "value" => $new_id};
1355      push(@$descriptions,$name);      push(@$descriptions,$name);
1356    
1357  #    my $description;  #    my $description;
# Line 1248  Line 1376 
1376    
1377      my $link;      my $link;
1378      my $link_url;      my $link_url;
1379      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"}
1380      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      if($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1381      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1382    
1383      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1278  Line 1406 
1406      my $data = [];      my $data = [];
1407      my $count = 0;      my $count = 0;
1408      my $content;      my $content;
1409        my $seen = {};
1410    
1411      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1412          next if ($thing->type !~ /dom/);          next if ($thing->type !~ /dom/);
# Line 1287  Line 1416 
1416          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1417          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1418    
1419          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1420                                    -host     => $WebConfig::DBHOST,
1421                                    -user     => $WebConfig::DBUSER,
1422                                    -password => $WebConfig::DBPWD);
1423    
1424          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1425          if($db eq "CDD"){  
1426              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );          my $new_id;
1427              if(!scalar(@$cdd_objs)){          if($db =~ /PFAM/){
1428                if ($id =~ /_/){
1429                    ($new_id) = ($id) =~ /(.*?)_/;
1430                }
1431                else{
1432                    $new_id = $id;
1433                }
1434    
1435                next if ($seen->{$new_id});
1436                $seen->{$new_id}=1;
1437    
1438                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1439    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1440                if(!scalar(@$pfam_objs)){
1441                  $name_title = "name";                  $name_title = "name";
1442                  $name_value = "not available";                  $name_value = "not available";
1443                  $description_title = "description";                  $description_title = "description";
1444                  $description_value = "not available";                  $description_value = "not available";
1445              }              }
1446              else{              else{
1447                  my $cdd_obj = $cdd_objs->[0];                  my $pfam_obj = $pfam_objs->[0];
1448                  $name_title = "name";                  $name_title = "name";
1449                  $name_value = $cdd_obj->term;                  $name_value = $pfam_obj->term;
1450                  $description_title = "description";                  #$description_title = "description";
1451                  $description_value = $cdd_obj->description;                  #$description_value = $pfam_obj->description;
1452              }              }
1453          }          }
1454    
1455          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1456    
1457          push(@$single_domain,$db);          push(@$single_domain,$db);
1458          push(@$single_domain,$thing->acc);          push(@$single_domain,$new_id);
1459          push(@$single_domain,$name_value);          push(@$single_domain,$name_value);
1460          push(@$single_domain,$location);          push(@$single_domain,$location);
1461          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
# Line 1388  Line 1533 
1533      #color is      #color is
1534      my $color = "6";      my $color = "6";
1535    
 =pod=  
   
     if($cello_location){  
         my $cello_descriptions = [];  
         my $line_data =[];  
   
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'CELLO',  
                             'basepair_offset' => '1' };  
   
         my $description_cello_location = {"title" => 'Best Cello Location',  
                                           "value" => $cello_location};  
   
         push(@$cello_descriptions,$description_cello_location);  
1536    
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
1537    
1538          push(@$cello_descriptions,$description_cello_score);  #    if($cello_location){
1539    #       my $cello_descriptions = [];
1540          my $element_hash = {  #       my $line_data =[];
1541              "title" => "CELLO",  #
1542              "color"=> $color,  #       my $line_config = { 'title' => 'Localization Evidence',
1543              "start" => "1",  #                           'short_title' => 'CELLO',
1544              "end" =>  $length + 1,  #                            'hover_title' => 'Localization',
1545              "zlayer" => '1',  #                           'basepair_offset' => '1' };
1546              "description" => $cello_descriptions};  #
1547    #       my $description_cello_location = {"title" => 'Best Cello Location',
1548          push(@$line_data,$element_hash);  #                                         "value" => $cello_location};
1549          $gd->add_line($line_data, $line_config);  #
1550      }  #       push(@$cello_descriptions,$description_cello_location);
1551    #
1552      $color = "2";  #       my $description_cello_score = {"title" => 'Cello Score',
1553      if($tmpred_score){  #                                      "value" => $cello_score};
1554          my $line_data =[];  #
1555          my $line_config = { 'title' => 'Localization Evidence',  #       push(@$cello_descriptions,$description_cello_score);
1556                              'short_title' => 'Transmembrane',  #
1557                              'basepair_offset' => '1' };  #       my $element_hash = {
1558    #           "title" => "CELLO",
1559          foreach my $tmpred (@tmpred_locations){  #           "color"=> $color,
1560              my $descriptions = [];  #           "start" => "1",
1561              my ($begin,$end) =split("-",$tmpred);  #           "end" =>  $length + 1,
1562              my $description_tmpred_score = {"title" => 'TMPRED score',  #           "zlayer" => '1',
1563                               "value" => $tmpred_score};  #           "description" => $cello_descriptions};
1564    #
1565              push(@$descriptions,$description_tmpred_score);  #       push(@$line_data,$element_hash);
1566    #       $gd->add_line($line_data, $line_config);
1567              my $element_hash = {  #    }
1568              "title" => "transmembrane location",  #
1569              "start" => $begin + 1,  #    $color = "2";
1570              "end" =>  $end + 1,  #    if($tmpred_score){
1571              "color"=> $color,  #       my $line_data =[];
1572              "zlayer" => '5',  #       my $line_config = { 'title' => 'Localization Evidence',
1573              "type" => 'box',  #                           'short_title' => 'Transmembrane',
1574              "description" => $descriptions};  #                           'basepair_offset' => '1' };
1575    #
1576    #       foreach my $tmpred (@tmpred_locations){
1577    #           my $descriptions = [];
1578    #           my ($begin,$end) =split("-",$tmpred);
1579    #           my $description_tmpred_score = {"title" => 'TMPRED score',
1580    #                            "value" => $tmpred_score};
1581    #
1582    #           push(@$descriptions,$description_tmpred_score);
1583    #
1584    #           my $element_hash = {
1585    #           "title" => "transmembrane location",
1586    #           "start" => $begin + 1,
1587    #           "end" =>  $end + 1,
1588    #           "color"=> $color,
1589    #           "zlayer" => '5',
1590    #           "type" => 'box',
1591    #           "description" => $descriptions};
1592    #
1593    #           push(@$line_data,$element_hash);
1594    #
1595    #       }
1596    #       $gd->add_line($line_data, $line_config);
1597    #    }
1598    
             push(@$line_data,$element_hash);  
   
         }  
         $gd->add_line($line_data, $line_config);  
     }  
 =cut  
1599    
1600      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1601          my $line_data =[];          my $line_data =[];
1602          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1603                              'short_title' => 'TM and SP',                              'short_title' => 'TM and SP',
1604                                'hover_title' => 'Localization',
1605                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1606    
1607          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
# Line 1500  Line 1647 
1647          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1648      }      }
1649    
 =head3  
     $color = "1";  
     if($signal_peptide_score){  
         my $line_data = [];  
         my $descriptions = [];  
   
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'SignalP',  
                             'basepair_offset' => '1' };  
   
         my $description_signal_peptide_score = {"title" => 'signal peptide score',  
                                                 "value" => $signal_peptide_score};  
   
         push(@$descriptions,$description_signal_peptide_score);  
   
         my $description_cleavage_prob = {"title" => 'cleavage site probability',  
                                          "value" => $cleavage_prob};  
1650    
1651          push(@$descriptions,$description_cleavage_prob);  #    $color = "1";
1652    #    if($signal_peptide_score){
1653          my $element_hash = {  #       my $line_data = [];
1654              "title" => "SignalP",  #       my $descriptions = [];
1655              "start" => $cleavage_loc_begin - 2,  #
1656              "end" =>  $cleavage_loc_end + 1,  #       my $line_config = { 'title' => 'Localization Evidence',
1657              "type" => 'bigbox',  #                           'short_title' => 'SignalP',
1658              "color"=> $color,  #                            'hover_title' => 'Localization',
1659              "zlayer" => '10',  #                           'basepair_offset' => '1' };
1660              "description" => $descriptions};  #
1661    #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1662    #                                               "value" => $signal_peptide_score};
1663    #
1664    #       push(@$descriptions,$description_signal_peptide_score);
1665    #
1666    #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1667    #                                        "value" => $cleavage_prob};
1668    #
1669    #       push(@$descriptions,$description_cleavage_prob);
1670    #
1671    #       my $element_hash = {
1672    #           "title" => "SignalP",
1673    #           "start" => $cleavage_loc_begin - 2,
1674    #           "end" =>  $cleavage_loc_end + 1,
1675    #           "type" => 'bigbox',
1676    #           "color"=> $color,
1677    #           "zlayer" => '10',
1678    #           "description" => $descriptions};
1679    #
1680    #       push(@$line_data,$element_hash);
1681    #       $gd->add_line($line_data, $line_config);
1682    #    }
1683    
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
 =cut  
1684    
1685      return ($gd);      return ($gd);
1686    
# Line 1628  Line 1776 
1776  =cut  =cut
1777    
1778  sub display {  sub display {
1779      my ($self,$gd,$array,$fig) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
     #my $fig = new FIG;  
   
     my @ids;  
     foreach my $thing(@$array){  
         next if ($thing->class ne "SIM");  
         push (@ids, $thing->acc);  
     }  
   
     my %in_subs  = $fig->subsystems_for_pegs(\@ids);  
   
     foreach my $thing (@$array){  
         if ($thing->class eq "SIM"){  
1780    
1781        # declare variables
1782        my $window_size = $gd->window_size;
1783              my $peg = $thing->acc;              my $peg = $thing->acc;
1784              my $query = $thing->query;      my $query_id = $thing->query;
   
1785              my $organism = $thing->organism;              my $organism = $thing->organism;
1786        my $abbrev_name = $fig->abbrev($organism);
1787        if (!$organism){
1788          $organism = $peg;
1789          $abbrev_name = $peg;
1790        }
1791              my $genome = $fig->genome_of($peg);              my $genome = $fig->genome_of($peg);
1792              my ($org_tax) = ($genome) =~ /(.*)\./;              my ($org_tax) = ($genome) =~ /(.*)\./;
1793              my $function = $thing->function;              my $function = $thing->function;
1794              my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1795              my $align_start = $thing->qstart;      my $query_stop = $thing->qstop;
             my $align_stop = $thing->qstop;  
1796              my $hit_start = $thing->hstart;              my $hit_start = $thing->hstart;
1797              my $hit_stop = $thing->hstop;              my $hit_stop = $thing->hstop;
1798        my $ln_query = $thing->qlength;
1799        my $ln_hit = $thing->hlength;
1800    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1801    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1802        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start)+1, 1);
1803        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start)+1, 1);
1804    
1805              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1806    
1807        # hit sequence title
1808              my $line_config = { 'title' => "$organism [$org_tax]",              my $line_config = { 'title' => "$organism [$org_tax]",
1809                                  'short_title' => "$abbrev_name",                                  'short_title' => "$abbrev_name",
1810                                  'title_link' => '$tax_link',                                  'title_link' => '$tax_link',
1811                                  'basepair_offset' => '0'                          'basepair_offset' => '0',
1812                            'no_middle_line' => '1'
1813                                  };                                  };
1814    
1815        # query sequence title
1816        my $replace_id = $peg;
1817        $replace_id =~ s/\|/_/ig;
1818        my $anchor_name = "anchor_". $replace_id;
1819        my $query_config = { 'title' => "Query",
1820                             'short_title' => "Query",
1821                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1822                             'basepair_offset' => '0',
1823                             'no_middle_line' => '1'
1824                             };
1825              my $line_data = [];              my $line_data = [];
1826        my $query_data = [];
1827    
1828              my $element_hash;              my $element_hash;
1829              my $links_list = [];      my $hit_links_list = [];
1830              my $descriptions = [];      my $hit_descriptions = [];
1831        my $query_descriptions = [];
1832              # get subsystem information  
1833              my $url_link = "?page=Annotation&feature=".$peg;      # get sequence information
1834              my $link;      # evidence link
1835              $link = {"link_title" => $peg,      my $evidence_link;
1836                       "link" => $url_link};      if ($peg =~ /^fig\|/){
1837              push(@$links_list,$link);        $evidence_link = "?page=Annotation&feature=".$peg;
1838        }
1839        else{
1840          my $db = &Observation::get_database($peg);
1841          my ($link_id) = ($peg) =~ /\|(.*)/;
1842          $evidence_link = &HTML::alias_url($link_id, $db);
1843          #print STDERR "LINK: $db    $evidence_link";
1844        }
1845        my $link = {"link_title" => $peg,
1846                    "link" => $evidence_link};
1847        push(@$hit_links_list,$link) if ($evidence_link);
1848    
1849              #my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1850              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1851              my @subsystems;              my @subsystems;
1852        foreach my $array (@$subs){
             foreach my $array (@subs){  
1853                  my $subsystem = $$array[0];                  my $subsystem = $$array[0];
1854                  push(@subsystems,$subsystem);                  push(@subsystems,$subsystem);
1855                  my $link;          my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
                 $link = {"link" => "?page=Subsystems&subsystem=$subsystem",  
1856                           "link_title" => $subsystem};                           "link_title" => $subsystem};
1857                  push(@$links_list,$link);          push(@$hit_links_list,$link);
1858              }              }
1859    
1860        # blast alignment
1861              $link = {"link_title" => "view blast alignment",              $link = {"link_title" => "view blast alignment",
1862                       "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1863              push (@$links_list,$link);      push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1864    
1865        # description data
1866              my $description_function;              my $description_function;
1867              $description_function = {"title" => "function",              $description_function = {"title" => "function",
1868                                       "value" => $function};                                       "value" => $function};
1869              push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1870    
1871              my ($description_ss, $ss_string);      # subsystem description
1872              $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1873              $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1874        my $description_ss = {"title" => "subsystems",
1875                                 "value" => $ss_string};                                 "value" => $ss_string};
1876              push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1877    
1878        # location description
1879        # hit
1880              my $description_loc;              my $description_loc;
1881              $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1882                                  "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1883              push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1884    
1885              $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1886                                  "value" => $hit_stop};                          "value" => $ln_hit};
1887              push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1888    
1889        # query
1890        $description_loc = {"title" => "Hit Location",
1891                            "value" => $query_start . " - " . $query_stop};
1892        push(@$query_descriptions, $description_loc);
1893    
1894        $description_loc = {"title" => "Sequence Length",
1895                            "value" => $ln_query};
1896        push(@$query_descriptions, $description_loc);
1897    
1898    
1899    
1900        # evalue score description
1901              my $evalue = $thing->evalue;              my $evalue = $thing->evalue;
1902              while ($evalue =~ /-0/)              while ($evalue =~ /-0/)
1903              {              {
# Line 1722  Line 1907 
1907              }              }
1908    
1909              my $color = &color($evalue);              my $color = &color($evalue);
   
1910              my $description_eval = {"title" => "E-Value",              my $description_eval = {"title" => "E-Value",
1911                                      "value" => $evalue};                                      "value" => $evalue};
1912              push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1913        push(@$query_descriptions, $description_eval);
1914    
1915              my $identity = $self->identity;              my $identity = $self->identity;
1916              my $description_identity = {"title" => "Identity",              my $description_identity = {"title" => "Identity",
1917                                          "value" => $identity};                                          "value" => $identity};
1918              push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1919        push(@$query_descriptions, $description_identity);
1920    
1921    
1922        my $number = $base_start + ($query_start-$hit_start);
1923        #print STDERR "START: $number";
1924        $element_hash = {
1925            "title" => $query_id,
1926            "start" => $base_start,
1927            "end" => $base_start+$ln_query,
1928            "type"=> 'box',
1929            "color"=> $color,
1930            "zlayer" => "2",
1931            "links_list" => $query_links_list,
1932            "description" => $query_descriptions
1933            };
1934        push(@$query_data,$element_hash);
1935    
1936        $element_hash = {
1937            "title" => $query_id . ': HIT AREA',
1938            "start" => $base_start + $query_start,
1939            "end" =>  $base_start + $query_stop,
1940            "type"=> 'smallbox',
1941            "color"=> $query_color,
1942            "zlayer" => "3",
1943            "links_list" => $query_links_list,
1944            "description" => $query_descriptions
1945            };
1946        push(@$query_data,$element_hash);
1947    
1948        $gd->add_line($query_data, $query_config);
1949    
1950    
1951              $element_hash = {              $element_hash = {
1952                  "title" => $peg,                  "title" => $peg,
1953                  "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1954                  "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1955                  "type"=> 'box',                  "type"=> 'box',
1956                  "color"=> $color,                  "color"=> $color,
1957                  "zlayer" => "2",                  "zlayer" => "2",
1958                  "links_list" => $links_list,                  "links_list" => $hit_links_list,
1959                  "description" => $descriptions                  "description" => $hit_descriptions
1960                  };                  };
1961              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1962    
1963        $element_hash = {
1964            "title" => $peg . ': HIT AREA',
1965            "start" => $base_start + $query_start,
1966            "end" =>  $base_start + $query_stop,
1967            "type"=> 'smallbox',
1968            "color"=> $hit_color,
1969            "zlayer" => "3",
1970            "links_list" => $hit_links_list,
1971            "description" => $hit_descriptions
1972            };
1973        push(@$line_data,$element_hash);
1974    
1975              $gd->add_line($line_data, $line_config);              $gd->add_line($line_data, $line_config);
1976          }  
1977      }      my $breaker = [];
1978        my $breaker_hash = {};
1979        my $breaker_config = { 'no_middle_line' => "1" };
1980    
1981        push (@$breaker, $breaker_hash);
1982        $gd->add_line($breaker, $breaker_config);
1983    
1984      return ($gd);      return ($gd);
1985  }  }
1986    
# Line 1791  Line 2026 
2026              }              }
2027          }          }
2028    
2029          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2030                                    -host     => $WebConfig::DBHOST,
2031                                    -user     => $WebConfig::DBUSER,
2032                                    -password => $WebConfig::DBPWD);
2033          my ($name_value,$description_value);          my ($name_value,$description_value);
2034    
2035          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1828  Line 2066 
2066          my $link;          my $link;
2067          my $link_url;          my $link_url;
2068          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"}
2069          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"}
2070          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2071    
2072          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1852  Line 2090 
2090      }      }
2091    
2092      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2093                            'hover_title' => 'Domain',
2094                          'short_title' => $peg,                          'short_title' => $peg,
2095                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2096    
# Line 1871  Line 2110 
2110  =cut  =cut
2111    
2112  sub display_table {  sub display_table {
2113      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2114        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2115    
2116      my $data = [];      my $scroll_list;
2117      my $count = 0;      foreach my $col (@$show_columns){
2118      my $content;          push (@$scroll_list, $col->{key});
2119      #my $fig = new FIG;      }
2120      my $cgi = new CGI;  
2121      my @ids;      push (@ids, $query_fid);
2122      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2123          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2124          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2125      }      }
2126    
2127      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2128      my @attributes = $fig->get_attributes(\@ids);      my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2129    
2130      # get the column for the subsystems      # get the column for the subsystems
2131      %subsystems_column = &get_subsystems_column(\@ids,$fig);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2132    
2133      # get the column for the evidence codes      # get the column for the evidence codes
2134      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2135    
2136      # get the column for pfam_domain      # get the column for pfam_domain
2137      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2138    
2139        # get the column for molecular weight
2140        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2141    
2142        # get the column for organism's habitat
2143        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2144    
2145        # get the column for organism's temperature optimum
2146        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2147    
2148        # get the column for organism's temperature range
2149        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2150    
2151        # get the column for organism's oxygen requirement
2152        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2153    
2154        # get the column for organism's pathogenicity
2155        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2156    
2157        # get the column for organism's pathogenicity host
2158        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2159    
2160        # get the column for organism's salinity
2161        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2162    
2163        # get the column for organism's motility
2164        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2165    
2166        # get the column for organism's gram stain
2167        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2168    
2169        # get the column for organism's endospores
2170        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2171    
2172        # get the column for organism's shape
2173        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2174    
2175        # get the column for organism's disease
2176        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2177    
2178        # get the column for organism's disease
2179        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2180    
2181        # get the column for transmembrane domains
2182        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2183    
2184        # get the column for similar to human
2185        my $similar_to_human_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2186    
2187        # get the column for signal peptide
2188        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2189    
2190        # get the column for transmembrane domains
2191        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2192    
2193        # get the column for conserved neighborhood
2194        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2195    
2196        # get the column for cellular location
2197        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2198    
2199        # get the aliases
2200        my $alias_col;
2201        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2202             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2203             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2204             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2205             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2206            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2207        }
2208    
2209        # get the colors for the function cell
2210        my $functions = $fig->function_of_bulk(\@ids,1);
2211        $functional_color = &get_function_color_cell($functions, $fig);
2212        my $query_function = $fig->function_of($query_fid);
2213    
2214      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
     my $alias_col = &get_aliases(\@ids,$fig);  
     #my $alias_col = {};  
2215    
2216      foreach my $thing (@$dataset) {      my $figfam_data = &FIG::get_figfams_data();
2217        my $figfams = new FFs($figfam_data);
2218        my $same_genome_flag = 0;
2219    
2220        my $func_color_offset=0;
2221        unshift(@$dataset, $query_fid);
2222        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2223    #    foreach my $thing ( @$dataset){
2224            my $thing = $dataset->[$thing_count];
2225            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2226            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2227            if ($thing eq $query_fid){
2228                $id = $thing;
2229                $taxid   = $fig->genome_of($id);
2230                $organism = $fig->genus_species($taxid);
2231                $current_function = $fig->function_of($id);
2232            }
2233            else{
2234          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2235    
2236                $id      = $thing->acc;
2237                $evalue  = $thing->evalue;
2238                $taxid   = $fig->genome_of($id);
2239                $iden    = $thing->identity;
2240                $organism= $thing->organism;
2241                $ln1     = $thing->qlength;
2242                $ln2     = $thing->hlength;
2243                $b1      = $thing->qstart;
2244                $e1      = $thing->qstop;
2245                $b2      = $thing->hstart;
2246                $e2      = $thing->hstop;
2247                $d1      = abs($e1 - $b1) + 1;
2248                $d2      = abs($e2 - $b2) + 1;
2249                $color1  = match_color( $b1, $e1, $ln1 );
2250                $color2  = match_color( $b2, $e2, $ln2 );
2251                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2252                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2253                $current_function = $thing->function;
2254                $next_org = $next_thing->organism if (defined $next_thing);
2255            }
2256    
2257            next if ($id =~ /nmpdr\||gnl\|md5\|/);
2258    
2259          my $single_domain = [];          my $single_domain = [];
2260          $count++;          $count++;
2261    
2262          my $id      = $thing->acc;          # organisms cell
2263          my $taxid   = $fig->genome_of($id);          my ($org, $org_color) = $fig->org_and_color_of($id);
         my $iden    = $thing->identity;  
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
2264    
2265          # checkbox column          my $org_cell;
2266            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2267                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2268            }
2269            elsif ($next_org eq $organism){
2270                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2271                $same_genome_flag = 1;
2272            }
2273            elsif ($same_genome_flag == 1){
2274                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2275                $same_genome_flag = 0;
2276            }
2277    
2278            # checkbox cell
2279            my ($box_cell,$tax, $radio_cell);
2280          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2281          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2282          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_". $id;
2283          my ($tax) = ($id) =~ /fig\|(.*?)\./;          my $replace_id = $id;
2284            $replace_id =~ s/\|/_/ig;
2285            my $white = '#ffffff';
2286            $white = '#999966' if ($id eq $query_fid);
2287            $org_color = '#999966' if ($id eq $query_fid);
2288            my $anchor_name = "anchor_". $replace_id;
2289            my $checked = "";
2290            #$checked = "checked" if ($id eq $query_fid);
2291    #       if ($id =~ /^fig\|/){
2292              my $box = qq~<a name="$anchor_name"></a><input type="checkbox" name="seq" value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');" $checked>~;
2293              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2294              $tax = $fig->genome_of($id) if ($id =~ /^fig\|/);
2295    #       }
2296    #       else{
2297    #         my $box = qq(<a name="$anchor_name"></a>);
2298    #         $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2299    #       }
2300    
2301            # create the radio cell for any sequence, not just fig ids
2302            my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2303            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2304    
2305          # get the linked fig id          # get the linked fig id
2306          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2307          if (defined ($e_identical{$id})){  
2308              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";          my $fig_data;
2309          }          if ($id =~ /^fig\|/)
2310          else{          {
2311              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);              $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2312          }          }
2313            else
2314          push (@$single_domain, $box_col, $fig_col, $thing->evalue,          {
2315                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns              my $url_link = &HTML::set_prot_links($cgi,$id);
2316                $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2317          foreach my $col (sort keys %$scroll_list){          }
2318              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}          $fig_data .= qq(<td><img height='10px' width='20px' src='$FIG_Config::cgi_url/Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2319              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}          my $fig_col = {'data'=> $fig_data,
2320              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}                         'highlight'=>$white};
2321              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}  
2322              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}          $replace_id = $peg;
2323              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}          $replace_id =~ s/\|/_/ig;
2324              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}          $anchor_name = "anchor_". $replace_id;
2325              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}          my $query_config = { 'title' => "Query",
2326              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}                               'short_title' => "Query",
2327              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}                               'title_link' => "changeSimsLocation('$replace_id')",
2328              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}                               'basepair_offset' => '0'
2329              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}                               };
2330              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}  
2331              #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}          # function cell
2332              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2333                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2334                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2335    
2336            my $function_color;
2337            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2338                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2339            }
2340            else{
2341                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2342            }
2343            my $function_cell;
2344            if ($current_function){
2345              if ($current_function eq $query_function){
2346                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2347                $func_color_offset=1;
2348              }
2349              else{
2350                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2351              }
2352            }
2353            else{
2354              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2355            }
2356    
2357            if ($id eq $query_fid){
2358                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2359                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2360                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white},
2361                      {'data'=>$subsystems_column->{$id},'highlight'=>$white},
2362                      {'data'=>$evidence_column->{$id},'highlight'=>$white});  # permanent columns
2363            }
2364            else{
2365                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2366                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell,
2367                      {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"},
2368                      {'data'=>$evidence_column->{$id},'highlight'=>"#ffffff"});  # permanent columns
2369    
2370            }
2371    
2372            if ( ( $application->session->user) ){
2373                my $user = $application->session->user;
2374                if ($user && $user->has_right(undef, 'annotate', 'genome')) {
2375                    push (@$single_domain,$radio_cell);
2376                }
2377            }
2378    
2379            my ($ff) = $figfams->families_containing_peg($id);
2380    
2381            foreach my $col (@$scroll_list){
2382                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2383                else { $highlight_color = "#ffffff"; }
2384    
2385                if ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2393                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2394                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2395                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2396                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2397                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2398                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2399                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2400                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2401                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2402                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2403                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2404                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2405                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2406                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2407                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2408                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2409                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2410                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2411                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2412                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2413                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2414                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2415                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2416                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2417          }          }
2418          push(@$data,$single_domain);          push(@$data,$single_domain);
2419      }      }
# Line 1962  Line 2423 
2423      else{      else{
2424          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2425      }      }
2426        shift(@$dataset);
2427        return ($content);
2428    }
2429    
2430    
2431    =head3 display_figfam_table()
2432    
2433    If available use the function specified here to display the "raw" observation.
2434    This code will display a table for the similarities protein
2435    
2436    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
2437    
2438    =cut
2439    
2440    sub display_figfam_table {
2441      my ($self,$ids, $show_columns, $fig, $application, $cgi) = @_;
2442      my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2443    
2444      my $scroll_list;
2445      foreach my $col (@$show_columns){
2446        push (@$scroll_list, $col->{key});
2447      }
2448    
2449      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2450      my @attributes = $fig->get_attributes($ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2451    
2452      # get the column for the subsystems
2453      $subsystems_column = &get_subsystems_column($ids,$fig,$cgi,'hash');
2454    
2455      # get the column for the evidence codes
2456      $evidence_column = &get_evidence_column($ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2457    
2458      # get the column for pfam_domain
2459      $pfam_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2460    
2461      # get the column for molecular weight
2462      $mw_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2463    
2464      # get the column for organism's habitat
2465      my $habitat_column = &get_attrb_column($ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2466    
2467      # get the column for organism's temperature optimum
2468      my $temperature_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2469    
2470      # get the column for organism's temperature range
2471      my $temperature_range_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2472    
2473      # get the column for organism's oxygen requirement
2474      my $oxygen_req_column = &get_attrb_column($ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2475    
2476      # get the column for organism's pathogenicity
2477      my $pathogenic_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2478    
2479      # get the column for organism's pathogenicity host
2480      my $pathogenic_in_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2481    
2482      # get the column for organism's salinity
2483      my $salinity_column = &get_attrb_column($ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2484    
2485      # get the column for organism's motility
2486      my $motility_column = &get_attrb_column($ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2487    
2488      # get the column for organism's gram stain
2489      my $gram_stain_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2490    
2491      # get the column for organism's endospores
2492      my $endospores_column = &get_attrb_column($ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2493    
2494      # get the column for organism's shape
2495      my $shape_column = &get_attrb_column($ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2496    
2497      # get the column for organism's disease
2498      my $disease_column = &get_attrb_column($ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2499    
2500      # get the column for organism's disease
2501      my $gc_content_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2502    
2503      # get the column for transmembrane domains
2504      my $transmembrane_column = &get_attrb_column($ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2505    
2506      # get the column for similar to human
2507      my $similar_to_human_column = &get_attrb_column($ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2508    
2509      # get the column for signal peptide
2510      my $signal_peptide_column = &get_attrb_column($ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2511    
2512      # get the column for transmembrane domains
2513      my $isoelectric_column = &get_attrb_column($ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2514    
2515      # get the column for conserved neighborhood
2516      my $cons_neigh_column = &get_attrb_column($ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2517    
2518      # get the column for cellular location
2519      my $cell_location_column = &get_attrb_column($ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2520    
2521      # get the aliases
2522      my $alias_col;
2523      if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2524           (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2525           (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2526           (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2527           (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2528        $alias_col = &get_db_aliases($ids,$fig,'all',$cgi,'hash');
2529      }
2530    
2531      foreach my $id ( @$ids){
2532        my $current_function = $fig->function_of($id);
2533        my $organism = $fig->org_of($id);
2534        my $single_domain = [];
2535    
2536        # organisms cell comehere2
2537        my ($org, $org_color) = $fig->org_and_color_of($id);
2538        my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2539    
2540        # get the linked fig id
2541        my $fig_data;
2542        if ($id =~ /^fig\|/)
2543        {
2544            $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2545        }
2546        else
2547        {
2548            my $url_link = &HTML::set_prot_links($cgi,$id);
2549            $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2550        }
2551    
2552        my $fig_col = {'data'=> $fig_data,
2553                       'highlight'=>"#ffffff"};
2554    
2555        # get sequence length
2556        my $length_col = {'data'=> $fig->translation_length($id),
2557                          'highlight'=>"#ffffff"};
2558    
2559        # function cell
2560        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2561    
2562        # insert data
2563        push (@$single_domain, $fig_col, $length_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2564    
2565        foreach my $col (@$scroll_list){
2566          my $highlight_color = "#ffffff";
2567    
2568          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2569          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2570          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2571          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2572          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2573          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2574          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2575          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2576          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2577          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2578          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2579          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2580          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2581          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2582          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2583          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2584          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2585          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2586          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2587          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2588          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2589          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2590          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2591          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2592          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2593          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2594          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2595          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2596          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2597          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2598          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2599          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2600          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2601        }
2602        push(@$data,$single_domain);
2603      }
2604    
2605      $content = $data;
2606      return ($content);      return ($content);
2607  }  }
2608    
# Line 1971  Line 2612 
2612      foreach my $id (@$ids){      foreach my $id (@$ids){
2613          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2614          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2615          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2616            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2617      }      }
2618      return (%column);      return (%column);
2619  }  }
2620    
2621    sub get_figfam_column{
2622        my ($ids, $fig, $cgi) = @_;
2623        my $column;
2624    
2625        my $figfam_data = &FIG::get_figfams_data();
2626        my $figfams = new FFs($figfam_data);
2627    
2628        foreach my $id (@$ids){
2629            my ($ff);
2630            if ($id =~ /\.peg\./){
2631                ($ff) =  $figfams->families_containing_peg($id);
2632            }
2633            if ($ff){
2634                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2635            }
2636            else{
2637                push (@$column, " ");
2638            }
2639        }
2640    
2641        return $column;
2642    }
2643    
2644  sub get_subsystems_column{  sub get_subsystems_column{
2645      my ($ids,$fig) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2646    
2647      #my $fig = new FIG;      my %in_subs  = $fig->subsystems_for_pegs($ids,1);
2648      my $cgi = new CGI;      my ($column, $ss);
     my %in_subs  = $fig->subsystems_for_pegs($ids);  
     my %column;  
2649      foreach my $id (@$ids){      foreach my $id (@$ids){
2650          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2651          my @subsystems;          my @subsystems;
2652            if (scalar(@in_sub)) {
         if (@in_sub > 0) {  
2653              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2654                  my $ss = $$array[0];                  my $ss_name = $array->[0];
2655                  $ss =~ s/_/ /ig;                  $ss_name =~ s/_/ /ig;
2656                  push (@subsystems, "-" . $ss);                  push (@subsystems, "-" . $ss_name);
2657              }              }
2658              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2659              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2660          } else {          } else {
2661              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2662          }          }
2663            push (@$column, $ss->{$id});
2664      }      }
2665      return (%column);  
2666        if ($returnType eq 'hash') { return $ss; }
2667        elsif ($returnType eq 'array') { return $column; }
2668    }
2669    
2670    sub get_lineage_column{
2671        my ($ids, $fig, $cgi) = @_;
2672    
2673        my $lineages = $fig->taxonomy_list();
2674    
2675        foreach my $id (@$ids){
2676            my $genome = $fig->genome_of($id);
2677            if ($lineages->{$genome}){
2678    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2679                push (@$column, $lineages->{$genome});
2680            }
2681            else{
2682                push (@$column, " ");
2683            }
2684        }
2685        return $column;
2686    }
2687    
2688    sub match_color {
2689        my ( $b, $e, $n , $rgb) = @_;
2690        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2691        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2692        my $cov = ( $r - $l + 1 ) / $n;
2693        my $sat = 1 - 10 * $cov / 9;
2694        my $br  = 1;
2695        if ($rgb){
2696            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2697        }
2698        else{
2699            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2700        }
2701    }
2702    
2703    sub hsb2rgb {
2704        my ( $h, $s, $br ) = @_;
2705        $h = 6 * ($h - floor($h));
2706        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2707        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2708        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2709                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2710                                          :               ( 0,      1,      $h - 2 )
2711                                          )
2712                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2713                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2714                                          :               ( 1,      0,      6 - $h )
2715                                          );
2716        ( ( $r * $s + 1 - $s ) * $br,
2717          ( $g * $s + 1 - $s ) * $br,
2718          ( $b * $s + 1 - $s ) * $br
2719        )
2720    }
2721    
2722    sub html2rgb {
2723        my ($hex) = @_;
2724        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2725        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2726                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2727    
2728        my @R = split(//, $r);
2729        my @G = split(//, $g);
2730        my @B = split(//, $b);
2731    
2732        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2733        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2734        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2735    
2736        my $rgb = [$red, $green, $blue];
2737        return $rgb;
2738    
2739    }
2740    
2741    sub rgb2html {
2742        my ( $r, $g, $b ) = @_;
2743        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2744        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2745        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2746        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2747    }
2748    
2749    sub floor {
2750        my $x = $_[0];
2751        defined( $x ) || return undef;
2752        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2753    }
2754    
2755    sub get_function_color_cell{
2756      my ($functions, $fig) = @_;
2757    
2758      # figure out the quantity of each function
2759      my %hash;
2760      foreach my $key (keys %$functions){
2761        my $func = $functions->{$key};
2762        $hash{$func}++;
2763      }
2764    
2765      my %func_colors;
2766      my $count = 1;
2767      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2768        $func_colors{$key}=$count;
2769        $count++;
2770      }
2771    
2772      return \%func_colors;
2773  }  }
2774    
2775  sub get_essentially_identical{  sub get_essentially_identical{
# Line 2032  Line 2802 
2802    
2803    
2804  sub get_evidence_column{  sub get_evidence_column{
2805      my ($ids, $attributes,$fig) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2806      #my $fig = new FIG;      my ($column, $code_attributes);
2807      my $cgi = new CGI;  
2808      my (%column, %code_attributes);      if (! defined $attributes) {
2809            my @attributes_array = $fig->get_attributes($ids);
2810            $attributes = \@attributes_array;
2811        }
2812    
2813      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2814      foreach my $key (@codes){      foreach my $key (@codes){
2815          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2816      }      }
2817    
2818      foreach my $id (@$ids){      foreach my $id (@$ids){
2819          # add evidence code with tool tip          # add evidence code with tool tip
2820          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
2821    
2822          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2823          my @ev_codes = ();          my @ev_codes = ();
2824          foreach my $code (@codes) {          foreach my $code (@codes) {
2825              my $pretty_code = $code->[2];              my $pretty_code = $code->[2];
2826              if ($pretty_code =~ /;/) {              if ($pretty_code =~ /;/) {
2827                  my ($cd, $ss) = split(";", $code->[2]);                  my ($cd, $ss) = split(";", $code->[2]);
2828                    if ($cd =~ /ilit|dlit/){
2829                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2830                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2831                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2832                    }
2833                  $ss =~ s/_/ /g;                  $ss =~ s/_/ /g;
2834                  $pretty_code = $cd;# . " in " . $ss;                  $pretty_code = $cd;# . " in " . $ss;
2835              }              }
# Line 2064  Line 2842 
2842                                  {                                  {
2843                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
2844          }          }
2845          $column{$id}=$ev_codes;  
2846            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2847            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2848      }      }
2849      return (%column);      return $column;
2850  }  }
2851    
2852  sub get_pfam_column{  sub get_attrb_column{
2853      my ($ids, $attributes,$fig) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2854      #my $fig = new FIG;  
2855      my $cgi = new CGI;      my ($column, %code_attributes, %attribute_locations);
2856      my (%column, %code_attributes, %attribute_locations);      my $dbmaster = DBMaster->new(-database =>'Ontology',
2857      my $dbmaster = DBMaster->new(-database =>'Ontology');                                   -host     => $WebConfig::DBHOST,
2858                                     -user     => $WebConfig::DBUSER,
2859                                     -password => $WebConfig::DBPWD);
2860    
2861      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;      if ($colName eq "pfam"){
2862            if (! defined $attributes) {
2863                my @attributes_array = $fig->get_attributes($ids);
2864                $attributes = \@attributes_array;
2865            }
2866    
2867            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2868      foreach my $key (@codes){      foreach my $key (@codes){
2869          my $name = $key->[1];          my $name = $key->[1];
2870          if ($name =~ /_/){          if ($name =~ /_/){
# Line 2087  Line 2875 
2875      }      }
2876    
2877      foreach my $id (@$ids){      foreach my $id (@$ids){
2878          # add evidence code              # add pfam code
2879          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2880          my @pfam_codes = "";          my @pfam_codes = "";
2881          my %description_codes;          my %description_codes;
# Line 2103  Line 2891 
2891    
2892              foreach my $code (@ncodes) {              foreach my $code (@ncodes) {
2893                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2894                  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>";
   
                 # get the locations for the domain  
                 my @locs;  
                 foreach my $part (@{$attribute_location{$id}{$code}}){  
                     my ($loc) = ($part) =~ /\;(.*)/;  
                     push (@locs,$loc);  
                 }  
                 my %locsaw;  
                 foreach my $key (@locs) {$locsaw{$key}=1;}  
                 @locs = keys %locsaw;  
   
                 my $locations = join (", ", @locs);  
2895    
2896    #                   # get the locations for the domain
2897    #                   my @locs;
2898    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2899    #                       my ($loc) = ($part) =~ /\;(.*)/;
2900    #                       push (@locs,$loc);
2901    #                   }
2902    #                   my %locsaw;
2903    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2904    #                   @locs = keys %locsaw;
2905    #
2906    #                   my $locations = join (", ", @locs);
2907    #
2908                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2909                      push(@pfam_codes, "$parts[1] ($locations)");                          push(@pfam_codes, "$parts[1]");
2910                  }                  }
2911                  else {                  else {
2912                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2913                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2914                      push(@pfam_codes, "$pfam_link ($locations)");                          push(@pfam_codes, "$pfam_link");
2915                        }
2916                    }
2917    
2918                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2919                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2920                  }                  }
2921              }              }
2922          }          }
2923        elsif ($colName eq 'cellular_location'){
2924            if (! defined $attributes) {
2925                my @attributes_array = $fig->get_attributes($ids);
2926                $attributes = \@attributes_array;
2927            }
2928    
2929          $column{$id}=join("<br><br>", @pfam_codes);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2930            foreach my $key (@codes){
2931                my ($loc) = ($key->[1]) =~ /::(.*)/;
2932                my ($new_loc, @all);
2933                @all = split (//, $loc);
2934                my $count = 0;
2935                foreach my $i (@all){
2936                    if ( ($i eq uc($i)) && ($count > 0) ){
2937                        $new_loc .= " " . $i;
2938                    }
2939                    else{
2940                        $new_loc .= $i;
2941                    }
2942                    $count++;
2943                }
2944                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2945      }      }
     return (%column);  
2946    
2947            foreach my $id (@$ids){
2948                my (@values, $entry);
2949                #@values = (" ");
2950                if (defined @{$code_attributes{$id}}){
2951                    my @ncodes = @{$code_attributes{$id}};
2952                    foreach my $code (@ncodes){
2953                        push (@values, $code->[0] . ", " . $code->[1]);
2954                    }
2955                }
2956                else{
2957                    @values = ("Not available");
2958  }  }
2959    
2960  sub get_aliases {              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2961      my ($ids,$fig) = @_;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2962            }
2963        }
2964        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2965                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2966            if (! defined $attributes) {
2967                my @attributes_array = $fig->get_attributes($ids);
2968                $attributes = \@attributes_array;
2969            }
2970    
2971            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2972            foreach my $key (@codes){
2973                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2974            }
2975    
2976            foreach my $id (@$ids){
2977                my (@values, $entry);
2978                #@values = (" ");
2979                if (defined @{$code_attributes{$id}}){
2980                    my @ncodes = @{$code_attributes{$id}};
2981                    foreach my $code (@ncodes){
2982                        push (@values, $code);
2983                    }
2984                }
2985                else{
2986                    @values = ("Not available");
2987                }
2988    
2989                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2990                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2991            }
2992        }
2993        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2994                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2995                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2996                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2997                ($colName eq 'gc_content') ) {
2998            if (! defined $attributes) {
2999                my @attributes_array = $fig->get_attributes(undef,$attrbName);
3000                $attributes = \@attributes_array;
3001            }
3002    
3003            my $genomes_with_phenotype;
3004            foreach my $attribute (@$attributes){
3005                my $genome = $attribute->[0];
3006                $genomes_with_phenotype->{$genome} = $attribute->[2];
3007            }
3008    
3009            foreach my $id (@$ids){
3010                my $genome = $fig->genome_of($id);
3011                my @values = (' ');
3012                if (defined $genomes_with_phenotype->{$genome}){
3013                    push (@values, $genomes_with_phenotype->{$genome});
3014                }
3015                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
3016                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
3017            }
3018        }
3019    
3020        return $column;
3021    }
3022    
3023    sub get_aclh_aliases {
3024        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3025        my $db_array;
3026    
3027        my $id_line = join (",", @$ids);
3028        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
3029    
3030    
3031    }
3032    
3033    sub get_id_aliases {
3034        my ($id, $fig) = @_;
3035        my $aliases = {};
3036    
3037        my $org = $fig->org_of($id);
3038        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3039        if ( my $form = &LWP::Simple::get($url) ) {
3040            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3041            foreach my $line (split /\n/, $block){
3042                my @values = split /\t/, $line;
3043                next if ($values[3] eq "Expert");
3044                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3045                    $aliases->{$values[4]} = $values[0];
3046                }
3047            }
3048        }
3049    
3050        return $aliases;
3051    }
3052    
3053    sub get_db_aliases {
3054        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3055        my $db_array;
3056      my $all_aliases = $fig->feature_aliases_bulk($ids);      my $all_aliases = $fig->feature_aliases_bulk($ids);
3057      foreach my $id (@$ids){      foreach my $id (@$ids){
3058    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3059            my $id_org = $fig->org_of($id);
3060    
3061          foreach my $alias (@{$$all_aliases{$id}}){          foreach my $alias (@{$$all_aliases{$id}}){
3062    #       foreach my $alias (@all_aliases){
3063              my $id_db = &Observation::get_database($alias);              my $id_db = &Observation::get_database($alias);
3064              next if ($aliases->{$id}->{$id_db});              next if ( ($id_db ne $db) && ($db ne 'all') );
3065                next if ($aliases->{$id}->{$db});
3066                my $alias_org = $fig->org_of($alias);
3067    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3068                    #push(@funcs, [$id,$id_db,$tmp]);
3069              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3070    #           }
3071          }          }
3072            if (!defined( $aliases->{$id}->{$db})){
3073                $aliases->{$id}->{$db} = " ";
3074      }      }
3075      return ($aliases);          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3076            push (@$db_array, $aliases->{$id}->{$db});
3077        }
3078    
3079        if ($returnType eq 'hash') { return $aliases; }
3080        elsif ($returnType eq 'array') { return $db_array; }
3081  }  }
3082    
3083    
3084    
3085  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
3086    
3087  sub color {  sub color {
# Line 2185  Line 3119 
3119  sub display {  sub display {
3120      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3121    
3122        $taxes = $fig->taxonomy_list();
3123    
3124      my $fid = $self->fig_id;      my $fid = $self->fig_id;
3125      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
3126      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
# Line 2258  Line 3194 
3194                  #my $genome = $fig->genome_of($sim->[1]);                  #my $genome = $fig->genome_of($sim->[1]);
3195                  my $genome = $fig->genome_of($sim->acc);                  my $genome = $fig->genome_of($sim->acc);
3196                  #my ($genome1) = ($genome) =~ /(.*)\./;                  #my ($genome1) = ($genome) =~ /(.*)\./;
3197                  #my $lineage = $taxes->{$genome1};                  my $lineage = $taxes->{$genome};
3198                  my $lineage = $fig->taxonomy_of($fig->genome_of($genome));                  #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3199                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
3200                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
3201                          #push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
# Line 2333  Line 3269 
3269      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3270      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3271      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3272      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs,1);
3273    
3274      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3275          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
# Line 2341  Line 3277 
3277          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3278          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3279          #my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3280          #my $lineage = $taxes->{$genome1};          my $lineage = $taxes->{$region_genome};
3281          my $lineage = $fig->taxonomy_of($region_genome);          #my $lineage = $fig->taxonomy_of($region_genome);
3282          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
3283          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3284                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2432  Line 3368 
3368                  $prev_stop = $stop;                  $prev_stop = $stop;
3369                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3370    
3371                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3372                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3373                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3374                  }                  }
# Line 2584  Line 3520 
3520      my $cgi = new CGI;      my $cgi = new CGI;
3521      my $count = 0;      my $count = 0;
3522      my $peg_array = [];      my $peg_array = [];
3523      my (%evidence_column, %subsystems_column,  %e_identical);      my ($evidence_column, $subsystems_column,  %e_identical);
3524    
3525      if (@$dataset != 1){      if (@$dataset != 1){
3526          foreach my $thing (@$dataset){          foreach my $thing (@$dataset){
# Line 2593  Line 3529 
3529              }              }
3530          }          }
3531          # get the column for the evidence codes          # get the column for the evidence codes
3532          %evidence_column = &Observation::Sims::get_evidence_column($peg_array);          $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3533    
3534          # get the column for the subsystems          # get the column for the subsystems
3535          %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);          $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3536    
3537          # get essentially identical seqs          # get essentially identical seqs
3538          %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);          %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
# Line 2610  Line 3546 
3546          last if ($count > 10);          last if ($count > 10);
3547          my $row_data = [];          my $row_data = [];
3548          my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);          my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3549            if ($fig->org_of($id)){
3550          $org = $fig->org_of($id);          $org = $fig->org_of($id);
3551            }
3552            else{
3553                $org = "Data not available";
3554            }
3555          $function = $fig->function_of($id);          $function = $fig->function_of($id);
3556          if ($mypeg ne $id){          if ($mypeg ne $id){
3557              $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";              $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3558              $id_cell .= &HTML::set_prot_links($cgi,$id);              $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3559              if (defined($e_identical{$id})) { $id_cell .= "*";}              if (defined($e_identical{$id})) { $id_cell .= "*";}
3560          }          }
3561          else{          else{
3562              $function_cell = "&nbsp;&nbsp;$function";              $function_cell = "&nbsp;&nbsp;$function";
3563              $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";              $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3564              $id_cell .= &HTML::set_prot_links($cgi,$id);              $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3565          }          }
3566    
3567          push(@$row_data,$id_cell);          push(@$row_data,$id_cell);
3568          push(@$row_data,$org);          push(@$row_data,$org);
3569          push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);          push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3570          push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);          push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3571          push(@$row_data, $fig->translation_length($id));          push(@$row_data, $fig->translation_length($id));
3572          push(@$row_data,$function_cell);          push(@$row_data,$function_cell);
3573          push(@$all_rows,$row_data);          push(@$all_rows,$row_data);
# Line 2672  Line 3613 
3613    
3614      return($content);      return($content);
3615  }  }
3616    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3