[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.39, Thu Sep 13 21:09:40 2007 UTC revision 1.74, Thu Feb 5 18:44:35 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;
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 86  Line 89 
89    return $self->{acc};    return $self->{acc};
90  }  }
91    
92    =head3 query()
93    
94    The query id
95    
96    =cut
97    
98    sub query {
99        my ($self) = @_;
100        return $self->{query};
101    }
102    
103    
104  =head3 class()  =head3 class()
105    
106  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 305  Line 320 
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
327    
328      # call function that fetches attribute based observations      # call function that fetches attribute based observations
329      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 320  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          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
339          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
343          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
345      }      }
346    
347      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 349 
349          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
350              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
351          }          }
352          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
353              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
356              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
357          }          }
358          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
359              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
360          }          }
361          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
362              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
363          }          }
364          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
365              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
366          }          }
367          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
368              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
369          }          }
370    
# Line 360  Line 375 
375    
376  }  }
377    
378  =head3 display_housekeeping  =head3 get_attributes
379  This method returns the housekeeping data for a given peg in a table format      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  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
393    
394      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
395      my $org_id   = $fig->orgid_of_orgname($org_name);      my ($self,$fid,$fig,$parameters) = @_;
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
     my $function = $fig->function_of($fid);  
     my @aliases  = $fig->feature_aliases($fid);  
     my $taxonomy = $fig->taxonomy_of($org_id);  
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
396    
397      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
398      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
399      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
400      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      # call function that fetches attribute based observations
401      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);      # returns an array of arrays of hashes
402      $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
403    
404      if ( @subsystems ) {      foreach my $dataset (@matched_datasets) {
405          $content .= qq(<tr><td>Subsystems</td><td>);          my $object;
406          foreach my $subsystem ( @subsystems ) {          if ($dataset->{'class'} eq "SIM"){
407              $content .= join(" -- ", @$subsystem) . "<br>\n";              $object = Observation::Sims->new($dataset);
408          }          }
409            push (@$objects, $object);
410      }      }
411        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
412          }          }
413    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
414    
415    =head3 display_housekeeping
416    This method returns the housekeeping data for a given peg in a table format
417    
418          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
419          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
420              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
421          }      my $content = [];
422          $content .= qq(</td></tr></table>\n);      my $row = [];
423    
424        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);
429        my $function = $fig->function_of($fid);
430        #my $taxonomy = $fig->taxonomy_of($org_id);
431        my $length = $fig->translation_length($fid);
432    
433        push (@$row, $org_name);
434        push (@$row, $fid);
435        push (@$row, $length);
436        push (@$row, $function);
437    
438        # initialize the table for commentary and annotations
439        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
440        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
441        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
442        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
443        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
444        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
445        #$content .= qq(</table><p>\n);
446    
447      $content .= qq(</table><p>\n);      push(@$content, $row);
448    
449      return ($content);      return ($content);
450  }  }
# Line 435  Line 455 
455  =cut  =cut
456    
457  sub get_sims_summary {  sub get_sims_summary {
458      my ($observation, $fid, $taxes) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new 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) {
463            my ($id, $evalue);
464            if ($thing =~ /fig\|/){
465                $id = $thing;
466                $evalue = -1;
467            }
468            else{
469                next if ($thing->class ne "SIM");
470                $id      = $thing->acc;
471                $evalue  = $thing->evalue;
472            }
473            next if ($id !~ /fig\|/);
474            next if ($fig->is_deleted_fid($id));
475    
476      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
477          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
478          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my ($genome1) = ($genome) =~ /(.*)\./;  
         my $taxonomy = $taxes->{$genome1};  
         #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # 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} = $sim->[10];                $families{evalue}{$tax} = $evalue;
495                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                $families{color}{$tax} = &get_taxcolor($evalue);
496                  }                  }
497              }              }
498              else{              else{
499                  $families{evalue}{$tax} = $sim->[10];              $families{evalue}{$tax} = $evalue;
500                  $families{color}{$tax} = &get_taxcolor($sim->[10]);              $families{color}{$tax} = &get_taxcolor($evalue);
501              }              }
502    
503              $parent_tax = $tax;              $parent_tax = $tax;
504              $level++;
505          }          }
506      }      }
507    
# Line 475  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 489  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 506  Line 545 
545  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
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) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
     my $fig = new FIG;  
   
550      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
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 523  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                    }
574                  else{                  else{
575                      $evalue = "0.0";                      $evalue = "0.0";
576                  }                  }
# Line 550  Line 593 
593    
594  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
595    
596      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
597      my $fig = new FIG;      #my $fig = new FIG;
598    
599      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
600    
# Line 561  Line 604 
604                     };                     };
605    
606      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
607          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
608          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
609          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 573  Line 615 
615                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
616                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
617                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
618              }              }
619              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
620                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 612  Line 653 
653  =cut  =cut
654    
655  sub get_pdb_observations{  sub get_pdb_observations{
656      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
657    
658      my $fig = new FIG;      #my $fig = new FIG;
659    
660      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
661          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
662          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
663          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 672  Line 711 
711  =cut  =cut
712    
713  sub get_sims_observations{  sub get_sims_observations{
714        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
715    
716      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
717      my $fig = new FIG;      if ( (defined $parameters->{flag}) && ($parameters->{flag})){
718      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
719      my ($dataset);        $max_expand = $parameters->{max_expand};
720          $max_eval = $parameters->{max_eval};
721      my %id_list;        $db_filter = $parameters->{db_filter};
722      foreach my $sim (@sims){        $sim_filters->{ sort_by } = $parameters->{sim_order};
723          my $hit = $sim->[1];        #$sim_order = $parameters->{sim_order};
724          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
725          next if ($hit !~ /^fig\|/);      }
726          my @aliases = $fig->feature_aliases($hit);      elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
727          foreach my $alias (@aliases){        $max_sims = 50;
728              $id_list{$alias} = 1;        $max_expand = 5;
729          $max_eval = 1e-5;
730          $db_filter = "all";
731          $sim_filters->{ sort_by } = 'id';
732          }          }
733        else{
734          $max_sims = 50;
735          $max_expand = 5;
736          $max_eval = 1e-5;
737          $db_filter = "figx";
738          $sim_filters->{ sort_by } = 'id';
739          #$sim_order = "id";
740      }      }
741    
742      my %already;      my($id, $genome, @genomes, %sims);
743      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
744      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
745          my $hit = $sim->[1];      my ($dataset);
746          my ($id) = ($hit) =~ /\|(.*)/;  
747          next if (defined($already{$id}));      if ($group_by_genome){
748          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
749          push (@new_sims, $sim);        foreach $sim ( @tmp ){
750          $already{$id} = 1;          $id = $sim->id2;
751            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
752            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
753            push @{ $sims{ $genome } }, $sim;
754          }
755          @tmp = map { @{ $sims{$_} } } @genomes;
756      }      }
757    
758      foreach my $sim (@new_sims){      my $seen_sims={};
759        foreach my $sim (@tmp){
760          my $hit = $sim->[1];          my $hit = $sim->[1];
761            next if ($seen_sims->{$hit});
762            $seen_sims->{$hit}++;
763          my $percent = $sim->[2];          my $percent = $sim->[2];
764          my $evalue = $sim->[10];          my $evalue = $sim->[10];
765          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 712  Line 770 
770          my $hlength = $sim->[13];          my $hlength = $sim->[13];
771          my $db = get_database($hit);          my $db = get_database($hit);
772          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
773          my $organism = $fig->org_of($hit);          my $organism;
774            if ($fig->org_of($hit)){
775                $organism = $fig->org_of($hit);
776            }
777            else{
778                $organism = "Data not available";
779            }
780    
781          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
782                        'query' => $sim->[0],
783                      'acc' => $hit,                      'acc' => $hit,
784                      'identity' => $percent,                      'identity' => $percent,
785                      'type' => 'seq',                      'type' => 'seq',
# Line 744  Line 809 
809      my ($id) = (@_);      my ($id) = (@_);
810    
811      my ($db);      my ($db);
812      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
813      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
814        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
815      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
816        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
817      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
818      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
819      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 755  Line 822 
822      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
823      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
824      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
825        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
826        elsif ($id =~ /^img\|/)           { $db = "IMG" }
827        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
828        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
829    
830      return ($db);      return ($db);
831    
# Line 769  Line 840 
840    
841  sub get_identical_proteins{  sub get_identical_proteins{
842    
843      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
844      my $fig = new FIG;      #my $fig = new FIG;
845      my $funcs_ref;      my $funcs_ref;
846    
 #    my %id_list;  
847      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
 #    my @aliases = $fig->feature_aliases($fid);  
 #    foreach my $alias (@aliases){  
 #       $id_list{$alias} = 1;  
 #    }  
   
848      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
849          my ($tmp, $who);          my ($tmp, $who);
850          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {  
851              $who = &get_database($id);              $who = &get_database($id);
852              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
853          }          }
854      }      }
855    
     my ($dataset);  
856      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
857                     'type' => 'seq',                     'type' => 'seq',
858                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 809  Line 872 
872    
873  sub get_functional_coupling{  sub get_functional_coupling{
874    
875      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
876      my $fig = new FIG;      #my $fig = new FIG;
877      my @funcs = ();      my @funcs = ();
878    
879      # initialize some variables      # initialize some variables
# Line 820  Line 883 
883      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
884    
885      # get the fc data      # get the fc data
886      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);
887    
888      # retrieve data      # retrieve data
889      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
890                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
891                    } @fc_data;                    } @fc_data;
892    
     my ($dataset);  
893      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
894                     'type' => 'fc',                     'type' => 'fc',
895                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 938  Line 1000 
1000      return $self->{database};      return $self->{database};
1001  }  }
1002    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
1003  ############################################################  ############################################################
1004  ############################################################  ############################################################
1005  package Observation::PDB;  package Observation::PDB;
# Line 969  Line 1025 
1025  =cut  =cut
1026    
1027  sub display{  sub display{
1028      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1029    
1030      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1031      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1032                                     -host     => $WebConfig::DBHOST,
1033                                     -user     => $WebConfig::DBUSER,
1034                                     -password => $WebConfig::DBPWD);
1035    
1036      my $acc = $self->acc;      my $acc = $self->acc;
1037    
# Line 993  Line 1052 
1052      my $lines = [];      my $lines = [];
1053      my $line_data = [];      my $line_data = [];
1054      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1055                            'hover_title' => 'PDB',
1056                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1057                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1058    
1059      my $fig = new FIG;      #my $fig = new FIG;
1060      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1061      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1062    
# Line 1097  Line 1157 
1157    
1158    
1159  sub display_table{  sub display_table{
1160      my ($self) = @_;      my ($self,$fig) = @_;
1161    
1162      my $fig = new FIG;      #my $fig = new FIG;
1163      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1164      my $rows = $self->rows;      my $rows = $self->rows;
1165      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1110  Line 1170 
1170          my $id = $row->[0];          my $id = $row->[0];
1171          my $who = $row->[1];          my $who = $row->[1];
1172          my $assignment = $row->[2];          my $assignment = $row->[2];
1173          my $organism = $fig->org_of($id);          my $organism = "Data not available";
1174            if ($fig->org_of($id)){
1175                $organism = $fig->org_of($id);
1176            }
1177          my $single_domain = [];          my $single_domain = [];
1178          push(@$single_domain,$who);          push(@$single_domain,$who);
1179          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1180          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1181          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1182          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1161  Line 1224 
1224    
1225  sub display_table {  sub display_table {
1226    
1227      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1228      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1229      my $rows = $self->rows;      my $rows = $self->rows;
1230      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1176  Line 1239 
1239          # construct the score link          # construct the score link
1240          my $score = $row->[0];          my $score = $row->[0];
1241          my $toid = $row->[1];          my $toid = $row->[1];
1242          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1243          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1244    
1245          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1246          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1230  Line 1293 
1293      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1294      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1295    
1296      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1297                                    -host     => $WebConfig::DBHOST,
1298                                    -user     => $WebConfig::DBUSER,
1299                                    -password => $WebConfig::DBPWD);
1300    
1301      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1302      if($db eq "CDD"){  
1303          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1304          if(!scalar(@$cdd_objs)){          my $new_id;
1305            if ($id =~ /_/){
1306                ($new_id) = ($id) =~ /(.*?)_/;
1307            }
1308            else{
1309                $new_id = $id;
1310            }
1311    
1312            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1313            if(!scalar(@$pfam_objs)){
1314              $name_title = "name";              $name_title = "name";
1315              $name_value = "not available";              $name_value = "not available";
1316              $description_title = "description";              $description_title = "description";
1317              $description_value = "not available";              $description_value = "not available";
1318          }          }
1319          else{          else{
1320              my $cdd_obj = $cdd_objs->[0];              my $pfam_obj = $pfam_objs->[0];
1321              $name_title = "name";              $name_title = "name";
1322              $name_value = $cdd_obj->term;              $name_value = $pfam_obj->term;
1323              $description_title = "description";              #$description_title = "description";
1324              $description_value = $cdd_obj->description;              #$description_value = $pfam_obj->description;
1325          }          }
1326      }      }
1327    
1328      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1329                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1330        my $new_short_title=$short_title;
1331        if ($short_title =~ /interpro/){
1332            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1333        }
1334        my $line_config = { 'title' => $name_value,
1335                            'hover_title', => 'Domain',
1336                            'short_title' => $new_short_title,
1337                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1338    
1339      my $name;      my $name;
1340      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1341               "value" => $name_value};      $name = {"title" => $db,
1342                 "value" => $new_id};
1343      push(@$descriptions,$name);      push(@$descriptions,$name);
1344    
1345      my $description;  #    my $description;
1346      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1347                               "value" => $description_value};  #                   "value" => $description_value};
1348      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1349    
1350      my $score;      my $score;
1351      $score = {"title" => "score",      $score = {"title" => "score",
1352                "value" => $thing->evalue};                "value" => $thing->evalue};
1353      push(@$descriptions,$score);      push(@$descriptions,$score);
1354    
1355        my $location;
1356        $location = {"title" => "location",
1357                     "value" => $thing->start . " - " . $thing->stop};
1358        push(@$descriptions,$location);
1359    
1360      my $link_id;      my $link_id;
1361      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1362          $link_id = $1;          $link_id = $1;
1363      }      }
1364    
1365      my $link;      my $link;
1366      my $link_url;      my $link_url;
1367      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"}
1368      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"}
1369      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1370    
1371      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1285  Line 1373 
1373      push(@$links_list,$link);      push(@$links_list,$link);
1374    
1375      my $element_hash = {      my $element_hash = {
1376          "title" => $thing->type,          "title" => $name_value,
1377          "start" => $thing->start,          "start" => $thing->start,
1378          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1379          "color"=> $color,          "color"=> $color,
# Line 1306  Line 1394 
1394      my $data = [];      my $data = [];
1395      my $count = 0;      my $count = 0;
1396      my $content;      my $content;
1397        my $seen = {};
1398    
1399      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1400          next if ($thing->type !~ /dom/);          next if ($thing->type !~ /dom/);
# Line 1315  Line 1404 
1404          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1405          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1406    
1407          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1408                                    -host     => $WebConfig::DBHOST,
1409                                    -user     => $WebConfig::DBUSER,
1410                                    -password => $WebConfig::DBPWD);
1411    
1412          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1413          if($db eq "CDD"){  
1414              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );          my $new_id;
1415              if(!scalar(@$cdd_objs)){          if($db =~ /PFAM/){
1416                if ($id =~ /_/){
1417                    ($new_id) = ($id) =~ /(.*?)_/;
1418                }
1419                else{
1420                    $new_id = $id;
1421                }
1422    
1423                next if ($seen->{$new_id});
1424                $seen->{$new_id}=1;
1425    
1426                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1427    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1428                if(!scalar(@$pfam_objs)){
1429                  $name_title = "name";                  $name_title = "name";
1430                  $name_value = "not available";                  $name_value = "not available";
1431                  $description_title = "description";                  $description_title = "description";
1432                  $description_value = "not available";                  $description_value = "not available";
1433              }              }
1434              else{              else{
1435                  my $cdd_obj = $cdd_objs->[0];                  my $pfam_obj = $pfam_objs->[0];
1436                  $name_title = "name";                  $name_title = "name";
1437                  $name_value = $cdd_obj->term;                  $name_value = $pfam_obj->term;
1438                  $description_title = "description";                  #$description_title = "description";
1439                  $description_value = $cdd_obj->description;                  #$description_value = $pfam_obj->description;
1440              }              }
1441          }          }
1442    
1443          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1444    
1445          push(@$single_domain,$db);          push(@$single_domain,$db);
1446          push(@$single_domain,$thing->acc);          push(@$single_domain,$new_id);
1447          push(@$single_domain,$name_value);          push(@$single_domain,$name_value);
1448          push(@$single_domain,$location);          push(@$single_domain,$location);
1449          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
# Line 1386  Line 1491 
1491      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1492      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1493      if($cello_location){      if($cello_location){
1494          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1495          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1496      }      }
1497      return ($html);      return ($html);
1498  }  }
1499    
1500  sub display {  sub display {
1501      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1502    
1503      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1504      my $fig= new FIG;      #my $fig= new FIG;
1505      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1506    
1507      my $cleavage_prob;      my $cleavage_prob;
# Line 1416  Line 1521 
1521      #color is      #color is
1522      my $color = "6";      my $color = "6";
1523    
 =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);  
   
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
   
         push(@$cello_descriptions,$description_cello_score);  
   
         my $element_hash = {  
             "title" => "CELLO",  
             "color"=> $color,  
             "start" => "1",  
             "end" =>  $length + 1,  
             "zlayer" => '1',  
             "description" => $cello_descriptions};  
   
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
   
 =cut  
   
     $color = "2";  
     if($tmpred_score){  
         my $line_data =[];  
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'Transmembrane',  
                             'basepair_offset' => '1' };  
   
         foreach my $tmpred (@tmpred_locations){  
             my $descriptions = [];  
             my ($begin,$end) =split("-",$tmpred);  
             my $description_tmpred_score = {"title" => 'TMPRED score',  
                              "value" => $tmpred_score};  
   
             push(@$descriptions,$description_tmpred_score);  
1524    
             my $element_hash = {  
             "title" => "transmembrane location",  
             "start" => $begin + 1,  
             "end" =>  $end + 1,  
             "color"=> $color,  
             "zlayer" => '5',  
             "type" => 'box',  
             "description" => $descriptions};  
1525    
1526              push(@$line_data,$element_hash);  #    if($cello_location){
1527    #       my $cello_descriptions = [];
1528    #       my $line_data =[];
1529    #
1530    #       my $line_config = { 'title' => 'Localization Evidence',
1531    #                           'short_title' => 'CELLO',
1532    #                            'hover_title' => 'Localization',
1533    #                           'basepair_offset' => '1' };
1534    #
1535    #       my $description_cello_location = {"title" => 'Best Cello Location',
1536    #                                         "value" => $cello_location};
1537    #
1538    #       push(@$cello_descriptions,$description_cello_location);
1539    #
1540    #       my $description_cello_score = {"title" => 'Cello Score',
1541    #                                      "value" => $cello_score};
1542    #
1543    #       push(@$cello_descriptions,$description_cello_score);
1544    #
1545    #       my $element_hash = {
1546    #           "title" => "CELLO",
1547    #           "color"=> $color,
1548    #           "start" => "1",
1549    #           "end" =>  $length + 1,
1550    #           "zlayer" => '1',
1551    #           "description" => $cello_descriptions};
1552    #
1553    #       push(@$line_data,$element_hash);
1554    #       $gd->add_line($line_data, $line_config);
1555    #    }
1556    #
1557    #    $color = "2";
1558    #    if($tmpred_score){
1559    #       my $line_data =[];
1560    #       my $line_config = { 'title' => 'Localization Evidence',
1561    #                           'short_title' => 'Transmembrane',
1562    #                           'basepair_offset' => '1' };
1563    #
1564    #       foreach my $tmpred (@tmpred_locations){
1565    #           my $descriptions = [];
1566    #           my ($begin,$end) =split("-",$tmpred);
1567    #           my $description_tmpred_score = {"title" => 'TMPRED score',
1568    #                            "value" => $tmpred_score};
1569    #
1570    #           push(@$descriptions,$description_tmpred_score);
1571    #
1572    #           my $element_hash = {
1573    #           "title" => "transmembrane location",
1574    #           "start" => $begin + 1,
1575    #           "end" =>  $end + 1,
1576    #           "color"=> $color,
1577    #           "zlayer" => '5',
1578    #           "type" => 'box',
1579    #           "description" => $descriptions};
1580    #
1581    #           push(@$line_data,$element_hash);
1582    #
1583    #       }
1584    #       $gd->add_line($line_data, $line_config);
1585    #    }
1586    
         }  
         $gd->add_line($line_data, $line_config);  
     }  
1587    
1588      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1589          my $line_data =[];          my $line_data =[];
1590          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1591                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1592                                'hover_title' => 'Localization',
1593                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1594    
1595          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1596              my $descriptions = [];              my $descriptions = [];
1597              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1598                               "value" => $tm_loc};                               "value" => $tm_loc};
1599              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1600    
1601              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1602    
1603              my $element_hash = {              my $element_hash = {
1604              "title" => "phobius transmembrane location",              "title" => "Phobius",
1605              "start" => $begin + 1,              "start" => $begin + 1,
1606              "end" =>  $end + 1,              "end" =>  $end + 1,
1607              "color"=> '6',              "color"=> '6',
# Line 1530  Line 1636 
1636      }      }
1637    
1638    
1639      $color = "1";  #    $color = "1";
1640      if($signal_peptide_score){  #    if($signal_peptide_score){
1641          my $line_data = [];  #       my $line_data = [];
1642          my $descriptions = [];  #       my $descriptions = [];
1643    #
1644          my $line_config = { 'title' => 'Localization Evidence',  #       my $line_config = { 'title' => 'Localization Evidence',
1645                              'short_title' => 'SignalP',  #                           'short_title' => 'SignalP',
1646                              'basepair_offset' => '1' };  #                            'hover_title' => 'Localization',
1647    #                           'basepair_offset' => '1' };
1648          my $description_signal_peptide_score = {"title" => 'signal peptide score',  #
1649                                                  "value" => $signal_peptide_score};  #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1650    #                                               "value" => $signal_peptide_score};
1651          push(@$descriptions,$description_signal_peptide_score);  #
1652    #       push(@$descriptions,$description_signal_peptide_score);
1653          my $description_cleavage_prob = {"title" => 'cleavage site probability',  #
1654                                           "value" => $cleavage_prob};  #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1655    #                                        "value" => $cleavage_prob};
1656          push(@$descriptions,$description_cleavage_prob);  #
1657    #       push(@$descriptions,$description_cleavage_prob);
1658          my $element_hash = {  #
1659              "title" => "SignalP",  #       my $element_hash = {
1660              "start" => $cleavage_loc_begin - 2,  #           "title" => "SignalP",
1661              "end" =>  $cleavage_loc_end + 1,  #           "start" => $cleavage_loc_begin - 2,
1662              "type" => 'bigbox',  #           "end" =>  $cleavage_loc_end + 1,
1663              "color"=> $color,  #           "type" => 'bigbox',
1664              "zlayer" => '10',  #           "color"=> $color,
1665              "description" => $descriptions};  #           "zlayer" => '10',
1666    #           "description" => $descriptions};
1667    #
1668    #       push(@$line_data,$element_hash);
1669    #       $gd->add_line($line_data, $line_config);
1670    #    }
1671    
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
1672    
1673      return ($gd);      return ($gd);
1674    
# Line 1632  Line 1740 
1740      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1741      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1742      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1743        $self->{query} = $dataset->{'query'};
1744      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1745      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1746      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1655  Line 1764 
1764  =cut  =cut
1765    
1766  sub display {  sub display {
1767      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
1768    
1769      my $organism = $self->organism;      # declare variables
1770        my $window_size = $gd->window_size;
1771        my $peg = $thing->acc;
1772        my $query_id = $thing->query;
1773        my $organism = $thing->organism;
1774        my $abbrev_name = $fig->abbrev($organism);
1775        if (!$organism){
1776          $organism = $peg;
1777          $abbrev_name = $peg;
1778        }
1779      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1780      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1781      my $function = $self->function;      my $function = $thing->function;
1782      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1783      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1784      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1785      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1786      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1787        my $ln_hit = $thing->hlength;
1788    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1789    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1790        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1791        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1792    
1793      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;
1794    
1795        # hit sequence title
1796      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1797                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1798                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1799                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1800                            'no_middle_line' => '1'
1801                          };                          };
1802    
1803        # query sequence title
1804        my $replace_id = $peg;
1805        $replace_id =~ s/\|/_/ig;
1806        my $anchor_name = "anchor_". $replace_id;
1807        my $query_config = { 'title' => "Query",
1808                             'short_title' => "Query",
1809                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1810                             'basepair_offset' => '0',
1811                             'no_middle_line' => '1'
1812                             };
1813      my $line_data = [];      my $line_data = [];
1814        my $query_data = [];
1815    
1816      my $element_hash;      my $element_hash;
1817      my $links_list = [];      my $hit_links_list = [];
1818      my $descriptions = [];      my $hit_descriptions = [];
1819        my $query_descriptions = [];
1820      # get subsystem information  
1821      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1822        # evidence link
1823      my $link;      my $evidence_link;
1824      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1825               "link" => $url_link};        $evidence_link = "?page=Annotation&feature=".$peg;
1826      push(@$links_list,$link);      }
1827        else{
1828          my $db = &Observation::get_database($peg);
1829          my ($link_id) = ($peg) =~ /\|(.*)/;
1830          $evidence_link = &HTML::alias_url($link_id, $db);
1831          #print STDERR "LINK: $db    $evidence_link";
1832        }
1833        my $link = {"link_title" => $peg,
1834                    "link" => $evidence_link};
1835        push(@$hit_links_list,$link) if ($evidence_link);
1836    
1837      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1838      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1839          my $link;      my @subsystems;
1840          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1841            my $subsystem = $$array[0];
1842            push(@subsystems,$subsystem);
1843            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1844                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1845          push(@$links_list,$link);          push(@$hit_links_list,$link);
1846      }      }
1847    
1848        # blast alignment
1849        $link = {"link_title" => "view blast alignment",
1850                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1851        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1852    
1853        # description data
1854      my $description_function;      my $description_function;
1855      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1856                               "value" => $function};                               "value" => $function};
1857      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1858    
1859      my ($description_ss, $ss_string);      # subsystem description
1860      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1861      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1862        my $description_ss = {"title" => "subsystems",
1863                         "value" => $ss_string};                         "value" => $ss_string};
1864      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1865    
1866        # location description
1867        # hit
1868      my $description_loc;      my $description_loc;
1869      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1870                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1871      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1872    
1873      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1874                          "value" => $hit_stop};                          "value" => $ln_hit};
1875      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1876    
1877        # query
1878        $description_loc = {"title" => "Hit Location",
1879                            "value" => $query_start . " - " . $query_stop};
1880        push(@$query_descriptions, $description_loc);
1881    
1882        $description_loc = {"title" => "Sequence Length",
1883                            "value" => $ln_query};
1884        push(@$query_descriptions, $description_loc);
1885    
1886    
1887    
1888      my $evalue = $self->evalue;      # evalue score description
1889        my $evalue = $thing->evalue;
1890      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1891      {      {
1892          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1729  Line 1895 
1895      }      }
1896    
1897      my $color = &color($evalue);      my $color = &color($evalue);
   
1898      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1899                              "value" => $evalue};                              "value" => $evalue};
1900      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1901        push(@$query_descriptions, $description_eval);
1902    
1903      my $identity = $self->identity;      my $identity = $self->identity;
1904      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1905                                  "value" => $identity};                                  "value" => $identity};
1906      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1907        push(@$query_descriptions, $description_identity);
1908    
1909    
1910        my $number = $base_start + ($query_start-$hit_start);
1911        #print STDERR "START: $number";
1912        $element_hash = {
1913            "title" => $query_id,
1914            "start" => $base_start,
1915            "end" => $base_start+$ln_query,
1916            "type"=> 'box',
1917            "color"=> $color,
1918            "zlayer" => "2",
1919            "links_list" => $query_links_list,
1920            "description" => $query_descriptions
1921            };
1922        push(@$query_data,$element_hash);
1923    
1924        $element_hash = {
1925            "title" => $query_id . ': HIT AREA',
1926            "start" => $base_start + $query_start,
1927            "end" =>  $base_start + $query_stop,
1928            "type"=> 'smallbox',
1929            "color"=> $query_color,
1930            "zlayer" => "3",
1931            "links_list" => $query_links_list,
1932            "description" => $query_descriptions
1933            };
1934        push(@$query_data,$element_hash);
1935    
1936        $gd->add_line($query_data, $query_config);
1937    
1938    
1939      $element_hash = {      $element_hash = {
1940          "title" => $peg,          "title" => $peg,
1941          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1942          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1943          "type"=> 'box',          "type"=> 'box',
1944          "color"=> $color,          "color"=> $color,
1945          "zlayer" => "2",          "zlayer" => "2",
1946          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1947          "description" => $descriptions                  "description" => $hit_descriptions
1948                    };
1949        push(@$line_data,$element_hash);
1950    
1951        $element_hash = {
1952            "title" => $peg . ': HIT AREA',
1953            "start" => $base_start + $query_start,
1954            "end" =>  $base_start + $query_stop,
1955            "type"=> 'smallbox',
1956            "color"=> $hit_color,
1957            "zlayer" => "3",
1958            "links_list" => $hit_links_list,
1959            "description" => $hit_descriptions
1960          };          };
1961      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1962    
1963      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1964    
1965      return ($gd);      my $breaker = [];
1966        my $breaker_hash = {};
1967        my $breaker_config = { 'no_middle_line' => "1" };
1968    
1969        push (@$breaker, $breaker_hash);
1970        $gd->add_line($breaker, $breaker_config);
1971    
1972        return ($gd);
1973  }  }
1974    
1975  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1763  Line 1979 
1979  =cut  =cut
1980    
1981  sub display_domain_composition {  sub display_domain_composition {
1982      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1983    
1984      my $fig = new FIG;      #$fig = new FIG;
1985      my $peg = $self->acc;      my $peg = $self->acc;
1986    
1987      my $line_data = [];      my $line_data = [];
# Line 1773  Line 1989 
1989      my $descriptions = [];      my $descriptions = [];
1990    
1991      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1992        #my @domain_query_results = ();
1993      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1994          my $key = @$dqr[1];          my $key = @$dqr[1];
1995          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1798  Line 2014 
2014              }              }
2015          }          }
2016    
2017          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2018                                    -host     => $WebConfig::DBHOST,
2019                                    -user     => $WebConfig::DBUSER,
2020                                    -password => $WebConfig::DBPWD);
2021          my ($name_value,$description_value);          my ($name_value,$description_value);
2022    
2023          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1835  Line 2054 
2054          my $link;          my $link;
2055          my $link_url;          my $link_url;
2056          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"}
2057          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"}
2058          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2059    
2060          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1859  Line 2078 
2078      }      }
2079    
2080      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2081                            'hover_title' => 'Domain',
2082                          'short_title' => $peg,                          'short_title' => $peg,
2083                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2084    
# Line 1878  Line 2098 
2098  =cut  =cut
2099    
2100  sub display_table {  sub display_table {
2101      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2102        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2103    
2104      my $data = [];      my $scroll_list;
2105      my $count = 0;      foreach my $col (@$show_columns){
2106      my $content;          push (@$scroll_list, $col->{key});
2107      my $fig = new FIG;      }
2108      my $cgi = new CGI;  
2109      my @ids;      push (@ids, $query_fid);
2110      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2111          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2112          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2113      }      }
2114    
2115      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2116        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2117    
2118      # get the column for the subsystems      # get the column for the subsystems
2119      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2120    
2121      # get the column for the evidence codes      # get the column for the evidence codes
2122      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2123    
2124      # get the column for pfam_domain      # get the column for pfam_domain
2125      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2126    
2127      my %e_identical = &get_essentially_identical($query_fid);      # get the column for molecular weight
2128      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2129    
2130      foreach my $thing (@$dataset) {      # get the column for organism's habitat
2131          next if ($thing->class ne "SIM");      my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
         my $single_domain = [];  
         $count++;  
2132    
2133          my $id = $thing->acc;      # get the column for organism's temperature optimum
2134        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2135    
2136          my $iden    = $thing->identity;      # get the column for organism's temperature range
2137          my $ln1     = $thing->qlength;      my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
         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>)";  
2138    
2139          # checkbox column      # get the column for organism's oxygen requirement
2140          my $field_name = "tables_" . $id;      my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
         my $pair_name = "visual_" . $id;  
         my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);  
2141    
2142          # get the linked fig id      # get the column for organism's pathogenicity
2143          my $fig_col;      my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
         if (defined ($e_identical{$id})){  
             $fig_col = &HTML::set_prot_links($cgi,$id) . "*";  
         }  
         else{  
             $fig_col = &HTML::set_prot_links($cgi,$id);  
         }  
   
         push(@$single_domain,$box_col);                        # permanent column  
         push(@$single_domain,$fig_col);                        # permanent column  
         push(@$single_domain,$thing->evalue);                  # permanent column  
         push(@$single_domain,"$iden\%");                       # permanent column  
         push(@$single_domain,$reg1);                           # permanent column  
         push(@$single_domain,$reg2);                           # permanent column  
         push(@$single_domain,$thing->organism);                # permanent column  
         push(@$single_domain,$thing->function);                # permanent column  
         foreach my $col (sort keys %$scroll_list){  
             if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}  
             elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}  
             elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
             elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}  
             elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}  
             elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}  
             elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}  
             elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}  
             elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}  
             elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}  
             elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}  
             elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}  
             elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}  
         }  
         push(@$data,$single_domain);  
     }  
2144    
2145      if ($count >0 ){      # get the column for organism's pathogenicity host
2146          $content = $data;      my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2147      }  
2148      else{      # get the column for organism's salinity
2149          $content = "<p>This PEG does not have any similarities</p>";      my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2150      }  
2151      return ($content);      # get the column for organism's motility
2152  }      my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2153    
2154        # get the column for organism's gram stain
2155        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2156    
2157        # get the column for organism's endospores
2158        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2159    
2160        # get the column for organism's shape
2161        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2162    
2163        # get the column for organism's disease
2164        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2165    
2166        # get the column for organism's disease
2167        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2168    
2169        # get the column for transmembrane domains
2170        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2171    
2172        # get the column for similar to human
2173        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);
2174    
2175        # get the column for signal peptide
2176        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2177    
2178        # get the column for transmembrane domains
2179        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2180    
2181        # get the column for conserved neighborhood
2182        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2183    
2184        # get the column for cellular location
2185        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2186    
2187        # get the aliases
2188        my $alias_col;
2189        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2190             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2191             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2192             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2193             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2194            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2195        }
2196    
2197        # get the colors for the function cell
2198        my $functions = $fig->function_of_bulk(\@ids,1);
2199        $functional_color = &get_function_color_cell($functions, $fig);
2200        my $query_function = $fig->function_of($query_fid);
2201    
2202        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2203    
2204        my $figfam_data = &FIG::get_figfams_data();
2205        my $figfams = new FFs($figfam_data);
2206        my $same_genome_flag = 0;
2207    
2208        my $func_color_offset=0;
2209        unshift(@$dataset, $query_fid);
2210        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2211    #    foreach my $thing ( @$dataset){
2212            my $thing = $dataset->[$thing_count];
2213            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2214            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2215            if ($thing eq $query_fid){
2216                $id = $thing;
2217                $taxid   = $fig->genome_of($id);
2218                $organism = $fig->genus_species($taxid);
2219                $current_function = $fig->function_of($id);
2220            }
2221            else{
2222                next if ($thing->class ne "SIM");
2223    
2224                $id      = $thing->acc;
2225                $evalue  = $thing->evalue;
2226                $taxid   = $fig->genome_of($id);
2227                $iden    = $thing->identity;
2228                $organism= $thing->organism;
2229                $ln1     = $thing->qlength;
2230                $ln2     = $thing->hlength;
2231                $b1      = $thing->qstart;
2232                $e1      = $thing->qstop;
2233                $b2      = $thing->hstart;
2234                $e2      = $thing->hstop;
2235                $d1      = abs($e1 - $b1) + 1;
2236                $d2      = abs($e2 - $b2) + 1;
2237                $color1  = match_color( $b1, $e1, $ln1 );
2238                $color2  = match_color( $b2, $e2, $ln2 );
2239                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2240                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2241                $current_function = $thing->function;
2242                $next_org = $next_thing->organism if (defined $next_thing);
2243            }
2244    
2245            my $single_domain = [];
2246            $count++;
2247    
2248            # organisms cell
2249            my ($org, $org_color) = $fig->org_and_color_of($id);
2250    
2251            my $org_cell;
2252            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2253                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2254            }
2255            elsif ($next_org eq $organism){
2256                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2257                $same_genome_flag = 1;
2258            }
2259            elsif ($same_genome_flag == 1){
2260                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2261                $same_genome_flag = 0;
2262            }
2263    
2264            # checkbox cell
2265            my ($box_cell,$tax, $radio_cell);
2266            my $field_name = "tables_" . $id;
2267            my $pair_name = "visual_" . $id;
2268            my $cell_name = "cell_". $id;
2269            my $replace_id = $id;
2270            $replace_id =~ s/\|/_/ig;
2271            my $white = '#ffffff';
2272            $white = '#999966' if ($id eq $query_fid);
2273            $org_color = '#999966' if ($id eq $query_fid);
2274            my $anchor_name = "anchor_". $replace_id;
2275            my $checked = "";
2276            #$checked = "checked" if ($id eq $query_fid);
2277            if ($id =~ /^fig\|/){
2278              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>~;
2279              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2280              $tax = $fig->genome_of($id);
2281            }
2282            else{
2283              my $box = qq(<a name="$anchor_name"></a>);
2284              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2285            }
2286    
2287            # create the radio cell for any sequence, not just fig ids
2288            my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2289            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2290    
2291            # get the linked fig id
2292            my $anchor_link = "graph_" . $replace_id;
2293            my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2294            $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>);
2295            my $fig_col = {'data'=> $fig_data,
2296                           'highlight'=>$white};
2297    
2298            $replace_id = $peg;
2299            $replace_id =~ s/\|/_/ig;
2300            $anchor_name = "anchor_". $replace_id;
2301            my $query_config = { 'title' => "Query",
2302                                 'short_title' => "Query",
2303                                 'title_link' => "changeSimsLocation('$replace_id')",
2304                                 'basepair_offset' => '0'
2305                                 };
2306    
2307            # function cell
2308            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2309                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2310                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2311    
2312            my $function_color;
2313            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2314                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2315            }
2316            else{
2317                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2318            }
2319            my $function_cell;
2320            if ($current_function){
2321              if ($current_function eq $query_function){
2322                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2323                $func_color_offset=1;
2324              }
2325              else{
2326                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2327              }
2328            }
2329            else{
2330              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2331            }
2332    
2333            if ($id eq $query_fid){
2334                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2335                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2336                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white},
2337                      {'data'=>$subsystems_column->{$id},'highlight'=>$white},
2338                      {'data'=>$evidence_column->{$id},'highlight'=>$white});  # permanent columns
2339            }
2340            else{
2341                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2342                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell,
2343                      {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"},
2344                      {'data'=>$evidence_column->{$id},'highlight'=>"#ffffff"});  # permanent columns
2345    
2346            }
2347    
2348            if ( ( $application->session->user) ){
2349                my $user = $application->session->user;
2350                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2351                    push (@$single_domain,$radio_cell);
2352                }
2353            }
2354    
2355            my ($ff) = $figfams->families_containing_peg($id);
2356    
2357            foreach my $col (@$scroll_list){
2358                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2359                else { $highlight_color = "#ffffff"; }
2360    
2361                if ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2362                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2363                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2364                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2365                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2366                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2367                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2368                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2369                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2370                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2371                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2372                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2373                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2374                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2375                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2393            }
2394            push(@$data,$single_domain);
2395        }
2396        if ($count >0 ){
2397            $content = $data;
2398        }
2399        else{
2400            $content = "<p>This PEG does not have any similarities</p>";
2401        }
2402        shift(@$dataset);
2403        return ($content);
2404    }
2405    
2406    
2407    =head3 display_figfam_table()
2408    
2409    If available use the function specified here to display the "raw" observation.
2410    This code will display a table for the similarities protein
2411    
2412    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.
2413    
2414    =cut
2415    
2416    sub display_figfam_table {
2417      my ($self,$ids, $show_columns, $fig, $application, $cgi) = @_;
2418      my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2419    
2420      my $scroll_list;
2421      foreach my $col (@$show_columns){
2422        push (@$scroll_list, $col->{key});
2423      }
2424    
2425      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2426      my @attributes = $fig->get_attributes($ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2427    
2428      # get the column for the subsystems
2429      $subsystems_column = &get_subsystems_column($ids,$fig,$cgi,'hash');
2430    
2431      # get the column for the evidence codes
2432      $evidence_column = &get_evidence_column($ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2433    
2434      # get the column for pfam_domain
2435      $pfam_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2436    
2437      # get the column for molecular weight
2438      $mw_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2439    
2440      # get the column for organism's habitat
2441      my $habitat_column = &get_attrb_column($ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2442    
2443      # get the column for organism's temperature optimum
2444      my $temperature_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2445    
2446      # get the column for organism's temperature range
2447      my $temperature_range_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2448    
2449      # get the column for organism's oxygen requirement
2450      my $oxygen_req_column = &get_attrb_column($ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2451    
2452      # get the column for organism's pathogenicity
2453      my $pathogenic_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2454    
2455      # get the column for organism's pathogenicity host
2456      my $pathogenic_in_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2457    
2458      # get the column for organism's salinity
2459      my $salinity_column = &get_attrb_column($ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2460    
2461      # get the column for organism's motility
2462      my $motility_column = &get_attrb_column($ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2463    
2464      # get the column for organism's gram stain
2465      my $gram_stain_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2466    
2467      # get the column for organism's endospores
2468      my $endospores_column = &get_attrb_column($ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2469    
2470      # get the column for organism's shape
2471      my $shape_column = &get_attrb_column($ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2472    
2473      # get the column for organism's disease
2474      my $disease_column = &get_attrb_column($ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2475    
2476      # get the column for organism's disease
2477      my $gc_content_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2478    
2479      # get the column for transmembrane domains
2480      my $transmembrane_column = &get_attrb_column($ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2481    
2482      # get the column for similar to human
2483      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);
2484    
2485      # get the column for signal peptide
2486      my $signal_peptide_column = &get_attrb_column($ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2487    
2488      # get the column for transmembrane domains
2489      my $isoelectric_column = &get_attrb_column($ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2490    
2491      # get the column for conserved neighborhood
2492      my $cons_neigh_column = &get_attrb_column($ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2493    
2494      # get the column for cellular location
2495      my $cell_location_column = &get_attrb_column($ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2496    
2497      # get the aliases
2498      my $alias_col;
2499      if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2500           (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2501           (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2502           (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2503           (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2504        $alias_col = &get_db_aliases($ids,$fig,'all',$cgi,'hash');
2505      }
2506    
2507      foreach my $id ( @$ids){
2508        my $current_function = $fig->function_of($id);
2509        my $organism = $fig->org_of($id);
2510        my $single_domain = [];
2511    
2512        # organisms cell
2513        my ($org, $org_color) = $fig->org_and_color_of($id);
2514        my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2515    
2516        # get the linked fig id
2517        my $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2518        my $fig_col = {'data'=> $fig_data,
2519                       'highlight'=>"#ffffff"};
2520    
2521        # function cell
2522        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2523    
2524        # insert data
2525        push (@$single_domain, $fig_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2526    
2527        foreach my $col (@$scroll_list){
2528          my $highlight_color = "#ffffff";
2529    
2530          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2531          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2532          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2533          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2534          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2535          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2536          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2537          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2538          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2539          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2540          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2541          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2542          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2543          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2544          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2545          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2546          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2547          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2548          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2549          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2550          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2551          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2552          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2553          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2554          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2555          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2556          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2557          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2558          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2559          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2560          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2561          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2562          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2563        }
2564        push(@$data,$single_domain);
2565      }
2566    
2567      $content = $data;
2568      return ($content);
2569    }
2570    
2571  sub get_box_column{  sub get_box_column{
2572      my ($ids) = @_;      my ($ids) = @_;
# Line 1979  Line 2574 
2574      foreach my $id (@$ids){      foreach my $id (@$ids){
2575          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2576          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2577          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2578            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2579      }      }
2580      return (%column);      return (%column);
2581  }  }
2582    
2583    sub get_figfam_column{
2584        my ($ids, $fig, $cgi) = @_;
2585        my $column;
2586    
2587        my $figfam_data = &FIG::get_figfams_data();
2588        my $figfams = new FFs($figfam_data);
2589    
2590        foreach my $id (@$ids){
2591            my ($ff);
2592            if ($id =~ /\.peg\./){
2593                ($ff) =  $figfams->families_containing_peg($id);
2594            }
2595            if ($ff){
2596                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2597            }
2598            else{
2599                push (@$column, " ");
2600            }
2601        }
2602    
2603        return $column;
2604    }
2605    
2606  sub get_subsystems_column{  sub get_subsystems_column{
2607      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2608    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2609      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2610      my %column;      my ($column, $ss);
2611      foreach my $id (@$ids){      foreach my $id (@$ids){
2612          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2613          my @subsystems;          my @subsystems;
2614    
2615          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2616              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2617                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2618                  $count++;                  $ss =~ s/_/ /ig;
2619                    push (@subsystems, "-" . $ss);
2620              }              }
2621              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2622              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2623          } else {          } else {
2624              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2625          }          }
2626            push (@$column, $ss->{$id});
2627      }      }
2628      return (%column);  
2629        if ($returnType eq 'hash') { return $ss; }
2630        elsif ($returnType eq 'array') { return $column; }
2631    }
2632    
2633    sub get_lineage_column{
2634        my ($ids, $fig, $cgi) = @_;
2635    
2636        my $lineages = $fig->taxonomy_list();
2637    
2638        foreach my $id (@$ids){
2639            my $genome = $fig->genome_of($id);
2640            if ($lineages->{$genome}){
2641    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2642                push (@$column, $lineages->{$genome});
2643            }
2644            else{
2645                push (@$column, " ");
2646            }
2647        }
2648        return $column;
2649    }
2650    
2651    sub match_color {
2652        my ( $b, $e, $n , $rgb) = @_;
2653        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2654        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2655        my $cov = ( $r - $l + 1 ) / $n;
2656        my $sat = 1 - 10 * $cov / 9;
2657        my $br  = 1;
2658        if ($rgb){
2659            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2660        }
2661        else{
2662            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2663        }
2664    }
2665    
2666    sub hsb2rgb {
2667        my ( $h, $s, $br ) = @_;
2668        $h = 6 * ($h - floor($h));
2669        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2670        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2671        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2672                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2673                                          :               ( 0,      1,      $h - 2 )
2674                                          )
2675                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2676                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2677                                          :               ( 1,      0,      6 - $h )
2678                                          );
2679        ( ( $r * $s + 1 - $s ) * $br,
2680          ( $g * $s + 1 - $s ) * $br,
2681          ( $b * $s + 1 - $s ) * $br
2682        )
2683    }
2684    
2685    sub html2rgb {
2686        my ($hex) = @_;
2687        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2688        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2689                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2690    
2691        my @R = split(//, $r);
2692        my @G = split(//, $g);
2693        my @B = split(//, $b);
2694    
2695        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2696        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2697        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2698    
2699        my $rgb = [$red, $green, $blue];
2700        return $rgb;
2701    
2702    }
2703    
2704    sub rgb2html {
2705        my ( $r, $g, $b ) = @_;
2706        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2707        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2708        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2709        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2710    }
2711    
2712    sub floor {
2713        my $x = $_[0];
2714        defined( $x ) || return undef;
2715        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2716    }
2717    
2718    sub get_function_color_cell{
2719      my ($functions, $fig) = @_;
2720    
2721      # figure out the quantity of each function
2722      my %hash;
2723      foreach my $key (keys %$functions){
2724        my $func = $functions->{$key};
2725        $hash{$func}++;
2726      }
2727    
2728      my %func_colors;
2729      my $count = 1;
2730      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2731        $func_colors{$key}=$count;
2732        $count++;
2733      }
2734    
2735      return \%func_colors;
2736  }  }
2737    
2738  sub get_essentially_identical{  sub get_essentially_identical{
2739      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2740      my $fig = new FIG;      #my $fig = new FIG;
2741    
2742      my %id_list;      my %id_list;
2743      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2744    
2745      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2746            if($thing->class eq "IDENTICAL"){
2747                my $rows = $thing->rows;
2748                my $count_identical = 0;
2749                foreach my $row (@$rows) {
2750                    my $id = $row->[0];
2751          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2752              $id_list{$id} = 1;              $id_list{$id} = 1;
2753          }          }
2754      }      }
2755            }
2756        }
2757    
2758    #    foreach my $id (@maps_to) {
2759    #        if (($id ne $fid) && ($fig->function_of($id))) {
2760    #           $id_list{$id} = 1;
2761    #        }
2762    #    }
2763      return(%id_list);      return(%id_list);
2764  }  }
2765    
2766    
2767  sub get_evidence_column{  sub get_evidence_column{
2768      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2769      my $fig = new FIG;      my ($column, $code_attributes);
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
2770    
2771      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      if (! defined $attributes) {
2772            my @attributes_array = $fig->get_attributes($ids);
2773            $attributes = \@attributes_array;
2774        }
2775    
2776        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2777      foreach my $key (@codes){      foreach my $key (@codes){
2778          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2779      }      }
2780    
2781      foreach my $id (@$ids){      foreach my $id (@$ids){
2782          # add evidence code with tool tip          # add evidence code with tool tip
2783          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2784    
2785          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2786              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2787              foreach my $code (@codes) {              foreach my $code (@codes) {
2788                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2789                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
2790                      my ($cd, $ss) = split(";", $code->[2]);                      my ($cd, $ss) = split(";", $code->[2]);
2791                    if ($cd =~ /ilit|dlit/){
2792                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2793                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2794                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2795                    }
2796                      $ss =~ s/_/ /g;                      $ss =~ s/_/ /g;
2797                      $pretty_code = $cd;# . " in " . $ss;                      $pretty_code = $cd;# . " in " . $ss;
2798                  }                  }
2799                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2800              }              }
         }  
2801    
2802          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2803              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2063  Line 2805 
2805                                  {                                  {
2806                                      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));
2807          }          }
2808          $column{$id}=$ev_codes;  
2809            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2810            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2811      }      }
2812      return (%column);      return $column;
2813  }  }
2814    
2815  sub get_pfam_column{  sub get_attrb_column{
2816      my ($ids) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2817      my $fig = new FIG;  
2818      my $cgi = new CGI;      my ($column, %code_attributes, %attribute_locations);
2819      my (%column, %code_attributes);      my $dbmaster = DBMaster->new(-database =>'Ontology',
2820      my $dbmaster = DBMaster->new(-database =>'Ontology');                                   -host     => $WebConfig::DBHOST,
2821                                     -user     => $WebConfig::DBUSER,
2822                                     -password => $WebConfig::DBPWD);
2823    
2824        if ($colName eq "pfam"){
2825            if (! defined $attributes) {
2826                my @attributes_array = $fig->get_attributes($ids);
2827                $attributes = \@attributes_array;
2828            }
2829    
2830      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2831      foreach my $key (@codes){      foreach my $key (@codes){
2832          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2833                if ($name =~ /_/){
2834                    ($name) = ($key->[1]) =~ /(.*?)_/;
2835                }
2836                push (@{$code_attributes{$key->[0]}}, $name);
2837                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2838      }      }
2839    
2840      foreach my $id (@$ids){      foreach my $id (@$ids){
2841          # add evidence code with tool tip              # add pfam code
2842          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2843          my @pfam_codes = "";          my @pfam_codes = "";
2844          my %description_codes;          my %description_codes;
2845    
2846          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2847              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2848              @pfam_codes = ();              @pfam_codes = ();
2849              foreach my $code (@codes) {  
2850                    # get only unique values
2851                    my %saw;
2852                    foreach my $key (@ncodes) {$saw{$key}=1;}
2853                    @ncodes = keys %saw;
2854    
2855                    foreach my $code (@ncodes) {
2856                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2857                  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>";
2858    
2859    #                   # get the locations for the domain
2860    #                   my @locs;
2861    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2862    #                       my ($loc) = ($part) =~ /\;(.*)/;
2863    #                       push (@locs,$loc);
2864    #                   }
2865    #                   my %locsaw;
2866    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2867    #                   @locs = keys %locsaw;
2868    #
2869    #                   my $locations = join (", ", @locs);
2870    #
2871                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2872                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1]");
2873                  }                  }
2874                  else {                  else {
2875                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2876                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2877                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link");
2878                        }
2879                    }
2880    
2881                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2882                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2883                }
2884                  }                  }
2885              }              }
2886        elsif ($colName eq 'cellular_location'){
2887            if (! defined $attributes) {
2888                my @attributes_array = $fig->get_attributes($ids);
2889                $attributes = \@attributes_array;
2890          }          }
2891    
2892          $column{$id}=join("<br><br>", @pfam_codes);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2893            foreach my $key (@codes){
2894                my ($loc) = ($key->[1]) =~ /::(.*)/;
2895                my ($new_loc, @all);
2896                @all = split (//, $loc);
2897                my $count = 0;
2898                foreach my $i (@all){
2899                    if ( ($i eq uc($i)) && ($count > 0) ){
2900                        $new_loc .= " " . $i;
2901                    }
2902                    else{
2903                        $new_loc .= $i;
2904                    }
2905                    $count++;
2906                }
2907                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2908      }      }
     return (%column);  
2909    
2910            foreach my $id (@$ids){
2911                my (@values, $entry);
2912                #@values = (" ");
2913                if (defined @{$code_attributes{$id}}){
2914                    my @ncodes = @{$code_attributes{$id}};
2915                    foreach my $code (@ncodes){
2916                        push (@values, $code->[0] . ", " . $code->[1]);
2917                    }
2918                }
2919                else{
2920                    @values = ("Not available");
2921  }  }
2922    
2923  sub get_prefer {              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2924      my ($fid, $db, $all_aliases) = @_;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2925      my $fig = new FIG;          }
2926      my $cgi = new CGI;      }
2927        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2928                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2929            if (! defined $attributes) {
2930                my @attributes_array = $fig->get_attributes($ids);
2931                $attributes = \@attributes_array;
2932            }
2933    
2934            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2935            foreach my $key (@codes){
2936                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2937            }
2938    
2939            foreach my $id (@$ids){
2940                my (@values, $entry);
2941                #@values = (" ");
2942                if (defined @{$code_attributes{$id}}){
2943                    my @ncodes = @{$code_attributes{$id}};
2944                    foreach my $code (@ncodes){
2945                        push (@values, $code);
2946                    }
2947                }
2948                else{
2949                    @values = ("Not available");
2950                }
2951    
2952                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2953                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2954            }
2955        }
2956        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2957                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2958                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2959                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2960                ($colName eq 'gc_content') ) {
2961            if (! defined $attributes) {
2962                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2963                $attributes = \@attributes_array;
2964            }
2965    
2966            my $genomes_with_phenotype;
2967            foreach my $attribute (@$attributes){
2968                my $genome = $attribute->[0];
2969                $genomes_with_phenotype->{$genome} = $attribute->[2];
2970            }
2971    
2972            foreach my $id (@$ids){
2973                my $genome = $fig->genome_of($id);
2974                my @values = (' ');
2975                if (defined $genomes_with_phenotype->{$genome}){
2976                    push (@values, $genomes_with_phenotype->{$genome});
2977                }
2978                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2979                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2980            }
2981        }
2982    
2983        return $column;
2984    }
2985    
2986    sub get_aclh_aliases {
2987        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2988        my $db_array;
2989    
2990        my $id_line = join (",", @$ids);
2991        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
2992    
2993    
2994      foreach my $alias (@{$$all_aliases{$fid}}){  }
2995    
2996    sub get_id_aliases {
2997        my ($id, $fig) = @_;
2998        my $aliases = {};
2999    
3000        my $org = $fig->org_of($id);
3001        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3002        if ( my $form = &LWP::Simple::get($url) ) {
3003            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3004            foreach my $line (split /\n/, $block){
3005                my @values = split /\t/, $line;
3006                next if ($values[3] eq "Expert");
3007                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3008                    $aliases->{$values[4]} = $values[0];
3009                }
3010            }
3011        }
3012    
3013        return $aliases;
3014    }
3015    
3016    sub get_db_aliases {
3017        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3018        my $db_array;
3019        my $all_aliases = $fig->feature_aliases_bulk($ids);
3020        foreach my $id (@$ids){
3021    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3022            my $id_org = $fig->org_of($id);
3023    
3024            foreach my $alias (@{$$all_aliases{$id}}){
3025    #       foreach my $alias (@all_aliases){
3026          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
3027          if ($id_db eq $db){              next if ( ($id_db ne $db) && ($db ne 'all') );
3028              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              next if ($aliases->{$id}->{$db});
3029              return ($acc_col);              my $alias_org = $fig->org_of($alias);
3030    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3031                    #push(@funcs, [$id,$id_db,$tmp]);
3032                    $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3033    #           }
3034          }          }
3035            if (!defined( $aliases->{$id}->{$db})){
3036                $aliases->{$id}->{$db} = " ";
3037      }      }
3038      return (" ");          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3039            push (@$db_array, $aliases->{$id}->{$db});
3040  }  }
3041    
3042        if ($returnType eq 'hash') { return $aliases; }
3043        elsif ($returnType eq 'array') { return $db_array; }
3044    }
3045    
3046    
3047    
3048  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; $_ }
3049    
3050  sub color {  sub color {
3051      my ($evalue) = @_;      my ($evalue) = @_;
3052        my $palette = WebColors::get_palette('vitamins');
3053      my $color;      my $color;
3054      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
3055      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3056      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3057      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3058      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3059      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3060      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3061      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3062      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3063      else{        $color = 60;    }      else{        $color = $palette->[9];    }
3064      return ($color);      return ($color);
3065  }  }
3066    
# Line 2159  Line 3080 
3080  }  }
3081    
3082  sub display {  sub display {
3083      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3084    
3085        $taxes = $fig->taxonomy_list();
3086    
3087      my $fid = $self->fig_id;      my $fid = $self->fig_id;
3088      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
3089      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
3090      my $fig = new FIG;      my $range = $gd_window_size;
3091      my $all_regions = [];      my $all_regions = [];
3092      my $gene_associations={};      my $gene_associations={};
3093    
# Line 2189  Line 3112 
3112      my ($region_start, $region_end);      my ($region_start, $region_end);
3113      if ($beg < $end)      if ($beg < $end)
3114      {      {
3115          $region_start = $beg - 4000;          $region_start = $beg - ($range);
3116          $region_end = $end+4000;          $region_end = $end+ ($range);
3117          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
3118      }      }
3119      else      else
3120      {      {
3121          $region_start = $end-4000;          $region_start = $end-($range);
3122          $region_end = $beg+4000;          $region_end = $beg+($range);
3123          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
3124          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
3125          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2204  Line 3127 
3127    
3128      # call genes in region      # call genes in region
3129      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
3130        #foreach my $feat (@$target_gene_features){
3131        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
3132        #}
3133      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
3134      my (@start_array_region);      my (@start_array_region);
3135      push (@start_array_region, $offset);      push (@start_array_region, $offset);
3136    
3137      my %all_genes;      my %all_genes;
3138      my %all_genomes;      my %all_genomes;
3139      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
3140            #if ($feature =~ /peg/){
3141      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3142      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($pair_beg+(($pair_end-$pair_beg)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($pair_end+(($pair_beg-$pair_end)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
3143                  }                  }
3144    
3145                  push (@start_array_region, $offset);      my @selected_sims;
3146    
3147                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
                 my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                 push(@$all_regions,$pair_features);  
                 foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
             }  
             $coup_count++;  
         }  
     }  
     elsif ($compare_or_coupling eq "sims"){  
3148          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
3149          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
3150    
3151          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
3152          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
3153              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
3154                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
3155                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
3156                  my ($genome1) = ($genome) =~ /(.*)\./;  
3157                  my $lineage = $taxes->{$genome1};                  #my $genome = $fig->genome_of($sim->[1]);
3158                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
3159                    #my ($genome1) = ($genome) =~ /(.*)\./;
3160                    my $lineage = $taxes->{$genome};
3161                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3162                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
3163                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
3164                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
3165                            push (@selected_sims, $sim->acc);
3166                      }                      }
3167                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
3168              }              }
3169          }          }
3170            else{
3171                my $simcount = 0;
3172                foreach my $sim (@$sims_array){
3173                    next if ($sim->class ne "SIM");
3174                    next if ($sim->acc !~ /fig\|/);
3175    
3176                    push (@selected_sims, $sim->acc);
3177                    $simcount++;
3178                    last if ($simcount > 4);
3179                }
3180            }
3181    
3182            my %saw;
3183            @selected_sims = grep(!$saw{$_}++, @selected_sims);
3184    
3185          # get the gene context for the sorted matches          # get the gene context for the sorted matches
3186          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2302  Line 3204 
3204              my ($region_start, $region_end);              my ($region_start, $region_end);
3205              if ($beg < $end)              if ($beg < $end)
3206              {              {
3207                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
3208                  $region_end = $end+4000;                  $region_end = $end+($range/2);
3209                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
3210              }              }
3211              else              else
3212              {              {
3213                  $region_start = $end-4000;                  $region_start = $end-($range/2);
3214                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
3215                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3216                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
3217                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2325  Line 3227 
3227    
3228      }      }
3229    
3230        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3231      # cluster the genes      # cluster the genes
3232      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3233      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3234        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3235        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
3236    
3237      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3238          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3239          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3240          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3241          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3242            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3243            my $lineage = $taxes->{$region_genome};
3244            #my $lineage = $fig->taxonomy_of($region_genome);
3245            #$region_gs .= "Lineage:$lineage";
3246          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3247                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3248                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2341  Line 3250 
3250    
3251          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3252    
3253          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3254                                     'short_title' => "",                                     'short_title' => "",
3255                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
3256                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2365  Line 3274 
3274    
3275              # get subsystem information              # get subsystem information
3276              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3277              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3278    
3279              my $link;              my $link;
3280              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3281                       "link" => $url_link};                       "link" => $url_link};
3282              push(@$links_list,$link);              push(@$links_list,$link);
3283    
3284              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3285              foreach my $subsystem (@subsystems){              my @subsystems;
3286                foreach my $array (@subs){
3287                    my $subsystem = $$array[0];
3288                    my $ss = $subsystem;
3289                    $ss =~ s/_/ /ig;
3290                    push (@subsystems, $ss);
3291                  my $link;                  my $link;
3292                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3293                           "link_title" => $subsystem};                           "link_title" => $ss};
3294                    push(@$links_list,$link);
3295                }
3296    
3297                if ($fid1 eq $fid){
3298                    my $link;
3299                    $link = {"link_title" => "Annotate this sequence",
3300                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3301                  push(@$links_list,$link);                  push(@$links_list,$link);
3302              }              }
3303    
# Line 2410  Line 3331 
3331                  $prev_stop = $stop;                  $prev_stop = $stop;
3332                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3333    
3334                  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})){
3335                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3336                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3337                  }                  }
3338    
3339                    my $title = $fid1;
3340                    if ($fid1 eq $fid){
3341                        $title = "My query gene: $fid1";
3342                    }
3343    
3344                  $element_hash = {                  $element_hash = {
3345                      "title" => $fid1,                      "title" => $title,
3346                      "start" => $start,                      "start" => $start,
3347                      "end" =>  $stop,                      "end" =>  $stop,
3348                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2429  Line 3355 
3355                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3356                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3357                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3358    
3359                    if ($fid1 eq $fid){
3360                        $element_hash = {
3361                            "title" => 'Query',
3362                            "start" => $start,
3363                            "end" =>  $stop,
3364                            "type"=> 'bigbox',
3365                            "color"=> $color,
3366                            "zlayer" => "1"
3367                            };
3368    
3369                        # if there is an overlap, put into second line
3370                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3371                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3372                    }
3373              }              }
3374          }          }
3375          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3376          $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3377      }      }
3378      return $gd;      return ($gd, \@selected_sims);
3379  }  }
3380    
3381  sub cluster_genes {  sub cluster_genes {
# Line 2504  Line 3445 
3445      }      }
3446    
3447      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3448          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3449              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3450                  foreach $y (@$x) {                  foreach $y (@$x) {
3451                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2522  Line 3463 
3463      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3464      return ($i < @$xL);      return ($i < @$xL);
3465  }  }
3466    
3467    #############################################
3468    #############################################
3469    package Observation::Commentary;
3470    
3471    use base qw(Observation);
3472    
3473    =head3 display_protein_commentary()
3474    
3475    =cut
3476    
3477    sub display_protein_commentary {
3478        my ($self,$dataset,$mypeg,$fig) = @_;
3479    
3480        my $all_rows = [];
3481        my $content;
3482        #my $fig = new FIG;
3483        my $cgi = new CGI;
3484        my $count = 0;
3485        my $peg_array = [];
3486        my ($evidence_column, $subsystems_column,  %e_identical);
3487    
3488        if (@$dataset != 1){
3489            foreach my $thing (@$dataset){
3490                if ($thing->class eq "SIM"){
3491                    push (@$peg_array, $thing->acc);
3492                }
3493            }
3494            # get the column for the evidence codes
3495            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3496    
3497            # get the column for the subsystems
3498            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3499    
3500            # get essentially identical seqs
3501            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3502        }
3503        else{
3504            push (@$peg_array, @$dataset);
3505        }
3506    
3507        my $selected_sims = [];
3508        foreach my $id (@$peg_array){
3509            last if ($count > 10);
3510            my $row_data = [];
3511            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3512            if ($fig->org_of($id)){
3513                $org = $fig->org_of($id);
3514            }
3515            else{
3516                $org = "Data not available";
3517            }
3518            $function = $fig->function_of($id);
3519            if ($mypeg ne $id){
3520                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3521                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3522                if (defined($e_identical{$id})) { $id_cell .= "*";}
3523            }
3524            else{
3525                $function_cell = "&nbsp;&nbsp;$function";
3526                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3527                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3528            }
3529    
3530            push(@$row_data,$id_cell);
3531            push(@$row_data,$org);
3532            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3533            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3534            push(@$row_data, $fig->translation_length($id));
3535            push(@$row_data,$function_cell);
3536            push(@$all_rows,$row_data);
3537            push (@$selected_sims, $id);
3538            $count++;
3539        }
3540    
3541        if ($count >0){
3542            $content = $all_rows;
3543        }
3544        else{
3545            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3546        }
3547        return ($content,$selected_sims);
3548    }
3549    
3550    sub display_protein_history {
3551        my ($self, $id,$fig) = @_;
3552        my $all_rows = [];
3553        my $content;
3554    
3555        my $cgi = new CGI;
3556        my $count = 0;
3557        foreach my $feat ($fig->feature_annotations($id)){
3558            my $row = [];
3559            my $col1 = $feat->[2];
3560            my $col2 = $feat->[1];
3561            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3562            my $text = $feat->[3];
3563    
3564            push (@$row, $col1);
3565            push (@$row, $col2);
3566            push (@$row, $text);
3567            push (@$all_rows, $row);
3568            $count++;
3569        }
3570        if ($count > 0){
3571            $content = $all_rows;
3572        }
3573        else {
3574            $content = "There is no history for this PEG";
3575        }
3576    
3577        return($content);
3578    }
3579    

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.74

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3