[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38, Mon Sep 10 15:10:04 2007 UTC revision 1.60, Fri Jun 20 16:08:32 2008 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 strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 86  Line 88 
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91    =head3 query()
92    
93    The query id
94    
95    =cut
96    
97    sub query {
98        my ($self) = @_;
99        return $self->{query};
100    }
101    
102    
103  =head3 class()  =head3 class()
104    
105  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 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 360  Line 374 
374    
375  }  }
376    
377  =head3 display_housekeeping  =head3 get_sims_objects()
378  This method returns the housekeeping data for a given peg in a table format  
379    This is the B<REAL WORKHORSE> method of this Package.
380    
381  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
382    
383      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
384      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);  
385    
386      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
387      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $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);  
     }  
388    
389      if ( @subsystems ) {      # call function that fetches attribute based observations
390          $content .= qq(<tr><td>Subsystems</td><td>);      # returns an array of arrays of hashes
391          foreach my $subsystem ( @subsystems ) {      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
392              $content .= join(" -- ", @$subsystem) . "<br>\n";  
393        foreach my $dataset (@matched_datasets) {
394            my $object;
395            if ($dataset->{'class'} eq "SIM"){
396                $object = Observation::Sims->new($dataset);
397          }          }
398            push (@$objects, $object);
399      }      }
400        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
401          }          }
402    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
403    
404    =head3 display_housekeeping
405    This method returns the housekeeping data for a given peg in a table format
406    
407          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
408          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
409              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
410          }      my $content = [];
411          $content .= qq(</td></tr></table>\n);      my $row = [];
     }  
412    
413      $content .= qq(</table><p>\n);      my $org_name = $fig->org_of($fid);
414        my $org_id = $fig->genome_of($fid);
415        my $function = $fig->function_of($fid);
416        #my $taxonomy = $fig->taxonomy_of($org_id);
417        my $length = $fig->translation_length($fid);
418    
419        push (@$row, $org_name);
420        push (@$row, $fid);
421        push (@$row, $length);
422        push (@$row, $function);
423    
424        # initialize the table for commentary and annotations
425        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
426        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
427        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
428        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
429        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
430        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
431        #$content .= qq(</table><p>\n);
432    
433        push(@$content, $row);
434    
435      return ($content);      return ($content);
436  }  }
# Line 435  Line 441 
441  =cut  =cut
442    
443  sub get_sims_summary {  sub get_sims_summary {
444      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
445      my %families;      my %families;
446      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
447    
448      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
449          next if ($sim->[1] !~ /fig\|/);          my ($id, $evalue);
450          my $genome = $fig->genome_of($sim->[1]);          if ($thing =~ /fig\|/){
451          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));              $id = $thing;
452                $evalue = -1;
453            }
454            else{
455                next if ($thing->class ne "SIM");
456                $id      = $thing->acc;
457                $evalue  = $thing->evalue;
458            }
459            next if ($id !~ /fig\|/);
460            next if ($fig->is_deleted_fid($id));
461    
462            my $genome = $fig->genome_of($id);
463            #my ($genome1) = ($genome) =~ /(.*)\./;
464            my $taxonomy = $taxes->{$genome};
465          my $parent_tax = "Root";          my $parent_tax = "Root";
466          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
467            push (@{$families{figs}{$parent_tax}}, $id);
468            my $level = 2;
469          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
470              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
471                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
472                $families{level}{$tax} = $level;
473              push (@currLineage, $tax);              push (@currLineage, $tax);
474              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
475              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
476                if (defined ($families{evalue}{$tax})){
477                    if ($evalue < $families{evalue}{$tax}){
478                        $families{evalue}{$tax} = $evalue;
479                        $families{color}{$tax} = &get_taxcolor($evalue);
480                    }
481                }
482                else{
483                    $families{evalue}{$tax} = $evalue;
484                    $families{color}{$tax} = &get_taxcolor($evalue);
485                }
486    
487              $parent_tax = $tax;              $parent_tax = $tax;
488                $level++;
489          }          }
490      }      }
491    
# Line 462  Line 496 
496          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
497          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
498      }      }
499      return (\%families);  
500        return \%families;
501  }  }
502    
503  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 508 
508    
509  =cut  =cut
510    
511    sub get_taxcolor{
512        my ($evalue) = @_;
513        my $color;
514        if ($evalue == -1){            $color = "black";      }
515        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
516        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
517        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
518        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
519        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
520        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
521        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
522        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
523        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
524        else{        $color = "#6666FF";    }
525        return ($color);
526    }
527    
528    
529  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
530    
531      # 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)
532      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
533    
534      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
535          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
536          my @parts = split("::",$key);          my @parts = split("::",$key);
537          my $class = $parts[0];          my $class = $parts[0];
538            my $name = $parts[1];
539            #next if (($class eq "PFAM") && ($name !~ /interpro/));
540    
541          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
542              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 545 
545                  my $from = $2;                  my $from = $2;
546                  my $to = $3;                  my $to = $3;
547                  my $evalue;                  my $evalue;
548                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
549                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
550                      my $part1 = $2/100;                      my $part1 = $2/100;
551                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
552                  }                  }
553                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
554                        $evalue=$raw_evalue;
555                    }
556                  else{                  else{
557                      $evalue = "0.0";                      $evalue = "0.0";
558                  }                  }
# Line 520  Line 575 
575    
576  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
577    
578      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
579      my $fig = new FIG;      #my $fig = new FIG;
580    
581      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
582    
# Line 531  Line 586 
586                     };                     };
587    
588      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
589          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
590          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
591          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 597 
597                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
598                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
599                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
600              }              }
601              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
602                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 635 
635  =cut  =cut
636    
637  sub get_pdb_observations{  sub get_pdb_observations{
638      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
639    
640      my $fig = new FIG;      #my $fig = new FIG;
641    
642      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
643          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
644          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
645          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 642  Line 693 
693  =cut  =cut
694    
695  sub get_sims_observations{  sub get_sims_observations{
696        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
697    
698      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter);
699      my $fig = new FIG;      if ($parameters->{flag}){
700      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
701      my ($dataset);        $max_expand = $parameters->{max_expand};
702          $max_eval = $parameters->{max_eval};
703      my %id_list;        $db_filter = $parameters->{db_filter};
704      foreach my $sim (@sims){        $sim_order = $parameters->{sim_order};
705          my $hit = $sim->[1];        $group_by_genome = 1 if (defined ($parameters->{group_genome}));
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
706          }          }
707        else{
708          $max_sims = 50;
709          $max_expand = 5;
710          $max_eval = 1e-5;
711          $db_filter = "figx";
712          $sim_order = "id";
713      }      }
714    
715      my %already;      my($id, $genome, @genomes, %sims);
716      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand);
717      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
718          my $hit = $sim->[1];      my ($dataset);
719          my ($id) = ($hit) =~ /\|(.*)/;  
720          next if (defined($already{$id}));      if ($group_by_genome){
721          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
722          push (@new_sims, $sim);        foreach $sim ( @tmp ){
723          $already{$id} = 1;          $id = $sim->id2;
724            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
725            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
726            push @{ $sims{ $genome } }, $sim;
727          }
728          @tmp = map { @{ $sims{$_} } } @genomes;
729      }      }
730    
731      foreach my $sim (@new_sims){      foreach my $sim (@tmp){
732          my $hit = $sim->[1];          my $hit = $sim->[1];
733          my $percent = $sim->[2];          my $percent = $sim->[2];
734          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 743 
743          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
744    
745          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
746                        'query' => $sim->[0],
747                      'acc' => $hit,                      'acc' => $hit,
748                      'identity' => $percent,                      'identity' => $percent,
749                      'type' => 'seq',                      'type' => 'seq',
# Line 714  Line 773 
773      my ($id) = (@_);      my ($id) = (@_);
774    
775      my ($db);      my ($db);
776      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
777      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
778        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
779      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
780        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
781      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
782      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
783      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 725  Line 786 
786      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
787      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
788      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
789        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
790        elsif ($id =~ /^img\|/)           { $db = "IMG" }
791        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
792        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
793    
794      return ($db);      return ($db);
795    
# Line 739  Line 804 
804    
805  sub get_identical_proteins{  sub get_identical_proteins{
806    
807      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
808      my $fig = new FIG;      #my $fig = new FIG;
809      my $funcs_ref;      my $funcs_ref;
810    
 #    my %id_list;  
811      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;  
 #    }  
   
812      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
813          my ($tmp, $who);          my ($tmp, $who);
814          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}))) {  
815              $who = &get_database($id);              $who = &get_database($id);
816              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
817          }          }
818      }      }
819    
     my ($dataset);  
820      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
821                     'type' => 'seq',                     'type' => 'seq',
822                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 836 
836    
837  sub get_functional_coupling{  sub get_functional_coupling{
838    
839      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
840      my $fig = new FIG;      #my $fig = new FIG;
841      my @funcs = ();      my @funcs = ();
842    
843      # initialize some variables      # initialize some variables
# Line 797  Line 854 
854                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
855                    } @fc_data;                    } @fc_data;
856    
     my ($dataset);  
857      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
858                     'type' => 'fc',                     'type' => 'fc',
859                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 964 
964      return $self->{database};      return $self->{database};
965  }  }
966    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
967  ############################################################  ############################################################
968  ############################################################  ############################################################
969  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 989 
989  =cut  =cut
990    
991  sub display{  sub display{
992      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
993    
994      my $fid = $self->fig_id;      my $fid = $self->fig_id;
995      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
996                                    -host     => $WebConfig::DBHOST,
997                                    -user     => $WebConfig::DBUSER,
998                                    -password => $WebConfig::DBPWD);
999    
1000      my $acc = $self->acc;      my $acc = $self->acc;
1001    
# Line 963  Line 1016 
1016      my $lines = [];      my $lines = [];
1017      my $line_data = [];      my $line_data = [];
1018      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1019                            'hover_title' => 'PDB',
1020                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1021                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1022    
1023      my $fig = new FIG;      #my $fig = new FIG;
1024      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1025      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1026    
# Line 1067  Line 1121 
1121    
1122    
1123  sub display_table{  sub display_table{
1124      my ($self) = @_;      my ($self,$fig) = @_;
1125    
1126      my $fig = new FIG;      #my $fig = new FIG;
1127      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1128      my $rows = $self->rows;      my $rows = $self->rows;
1129      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1185 
1185    
1186  sub display_table {  sub display_table {
1187    
1188      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1189      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1190      my $rows = $self->rows;      my $rows = $self->rows;
1191      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1200 
1200          # construct the score link          # construct the score link
1201          my $score = $row->[0];          my $score = $row->[0];
1202          my $toid = $row->[1];          my $toid = $row->[1];
1203          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";
1204          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1205    
1206          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1207          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1254 
1254      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1255      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1256    
1257      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1258                                    -host     => $WebConfig::DBHOST,
1259                                    -user     => $WebConfig::DBUSER,
1260                                    -password => $WebConfig::DBPWD);
1261    
1262      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1263      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1276 
1276              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1277          }          }
1278      }      }
1279        elsif($db =~ /PFAM/){
1280            my ($new_id) = ($id) =~ /(.*?)_/;
1281            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1282            if(!scalar(@$pfam_objs)){
1283                $name_title = "name";
1284                $name_value = "not available";
1285                $description_title = "description";
1286                $description_value = "not available";
1287            }
1288            else{
1289                my $pfam_obj = $pfam_objs->[0];
1290                $name_title = "name";
1291                $name_value = $pfam_obj->term;
1292                #$description_title = "description";
1293                #$description_value = $pfam_obj->description;
1294            }
1295        }
1296    
1297      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1298                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1299        my $new_short_title=$short_title;
1300        if ($short_title =~ /interpro/){
1301            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1302        }
1303        my $line_config = { 'title' => $name_value,
1304                            'hover_title', => 'Domain',
1305                            'short_title' => $new_short_title,
1306                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1307    
1308      my $name;      my $name;
1309      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1310               "value" => $name_value};      $name = {"title" => $db,
1311                 "value" => $new_id};
1312      push(@$descriptions,$name);      push(@$descriptions,$name);
1313    
1314      my $description;  #    my $description;
1315      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1316                               "value" => $description_value};  #                   "value" => $description_value};
1317      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1318    
1319      my $score;      my $score;
1320      $score = {"title" => "score",      $score = {"title" => "score",
1321                "value" => $thing->evalue};                "value" => $thing->evalue};
1322      push(@$descriptions,$score);      push(@$descriptions,$score);
1323    
1324        my $location;
1325        $location = {"title" => "location",
1326                     "value" => $thing->start . " - " . $thing->stop};
1327        push(@$descriptions,$location);
1328    
1329      my $link_id;      my $link_id;
1330      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1331          $link_id = $1;          $link_id = $1;
1332      }      }
1333    
1334      my $link;      my $link;
1335      my $link_url;      my $link_url;
1336      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"}
1337      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1338      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1339    
1340      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1255  Line 1342 
1342      push(@$links_list,$link);      push(@$links_list,$link);
1343    
1344      my $element_hash = {      my $element_hash = {
1345          "title" => $thing->type,          "title" => $name_value,
1346          "start" => $thing->start,          "start" => $thing->start,
1347          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1348          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1372 
1372          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1373          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1374    
1375          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1376                                    -host     => $WebConfig::DBHOST,
1377                                    -user     => $WebConfig::DBUSER,
1378                                    -password => $WebConfig::DBPWD);
1379    
1380          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1381          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1394 
1394                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1395              }              }
1396          }          }
1397            elsif($db =~ /PFAM/){
1398                my ($new_id) = ($id) =~ /(.*?)_/;
1399                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1400                if(!scalar(@$pfam_objs)){
1401                    $name_title = "name";
1402                    $name_value = "not available";
1403                    $description_title = "description";
1404                    $description_value = "not available";
1405                }
1406                else{
1407                    my $pfam_obj = $pfam_objs->[0];
1408                    $name_title = "name";
1409                    $name_value = $pfam_obj->term;
1410                    #$description_title = "description";
1411                    #$description_value = $pfam_obj->description;
1412                }
1413            }
1414    
1415          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1416    
# Line 1356  Line 1463 
1463      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1464      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1465      if($cello_location){      if($cello_location){
1466          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1467          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1468      }      }
1469      return ($html);      return ($html);
1470  }  }
1471    
1472  sub display {  sub display {
1473      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1474    
1475      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1476      my $fig= new FIG;      #my $fig= new FIG;
1477      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1478    
1479      my $cleavage_prob;      my $cleavage_prob;
# Line 1386  Line 1493 
1493      #color is      #color is
1494      my $color = "6";      my $color = "6";
1495    
1496  =pod=  =head3
1497    
1498      if($cello_location){      if($cello_location){
1499          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1394  Line 1501 
1501    
1502          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1503                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1504                                'hover_title' => 'Localization',
1505                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1506    
1507          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1526 
1526          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1527      }      }
1528    
 =cut  
   
1529      $color = "2";      $color = "2";
1530      if($tmpred_score){      if($tmpred_score){
1531          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1555 
1555          }          }
1556          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1557      }      }
1558    =cut
1559    
1560      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1561          my $line_data =[];          my $line_data =[];
1562          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1563                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1564                                'hover_title' => 'Localization',
1565                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1566    
1567          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1568              my $descriptions = [];              my $descriptions = [];
1569              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1570                               "value" => $tm_loc};                               "value" => $tm_loc};
1571              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1572    
1573              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1574    
1575              my $element_hash = {              my $element_hash = {
1576              "title" => "phobius transmembrane location",              "title" => "Phobius",
1577              "start" => $begin + 1,              "start" => $begin + 1,
1578              "end" =>  $end + 1,              "end" =>  $end + 1,
1579              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1607 
1607          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1608      }      }
1609    
1610    =head3
1611      $color = "1";      $color = "1";
1612      if($signal_peptide_score){      if($signal_peptide_score){
1613          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1615 
1615    
1616          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1617                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1618                                'hover_title' => 'Localization',
1619                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1620    
1621          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1640 
1640          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1641          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1642      }      }
1643    =cut
1644    
1645      return ($gd);      return ($gd);
1646    
# Line 1602  Line 1712 
1712      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1713      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1714      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1715        $self->{query} = $dataset->{'query'};
1716      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1717      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1718      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1736 
1736  =cut  =cut
1737    
1738  sub display {  sub display {
1739      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
1740    
1741      my $organism = $self->organism;      # declare variables
1742        my $window_size = $gd->window_size;
1743        my $peg = $thing->acc;
1744        my $query_id = $thing->query;
1745        my $organism = $thing->organism;
1746        my $abbrev_name = $fig->abbrev($organism);
1747        if (!$organism){
1748          $organism = $peg;
1749          $abbrev_name = $peg;
1750        }
1751      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1752      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1753      my $function = $self->function;      my $function = $thing->function;
1754      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1755      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1756      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1757      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1758      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1759        my $ln_hit = $thing->hlength;
1760    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1761    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1762        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1763        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1764    
1765      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;
1766    
1767        # hit sequence title
1768      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1769                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1770                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1771                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1772                            'no_middle_line' => '1'
1773                          };                          };
1774    
1775        # query sequence title
1776        my $replace_id = $peg;
1777        $replace_id =~ s/\|/_/ig;
1778        my $anchor_name = "anchor_". $replace_id;
1779        my $query_config = { 'title' => "Query",
1780                             'short_title' => "Query",
1781                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1782                             'basepair_offset' => '0',
1783                             'no_middle_line' => '1'
1784                             };
1785      my $line_data = [];      my $line_data = [];
1786        my $query_data = [];
1787    
1788      my $element_hash;      my $element_hash;
1789      my $links_list = [];      my $hit_links_list = [];
1790      my $descriptions = [];      my $hit_descriptions = [];
1791        my $query_descriptions = [];
1792      # get subsystem information  
1793      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1794        # evidence link
1795      my $link;      my $evidence_link;
1796      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1797               "link" => $url_link};        $evidence_link = "?page=Evidence&feature=".$peg;
1798      push(@$links_list,$link);      }
1799        else{
1800          my $db = &Observation::get_database($peg);
1801          my ($link_id) = ($peg) =~ /\|(.*)/;
1802          $evidence_link = &HTML::alias_url($link_id, $db);
1803          #print STDERR "LINK: $db    $evidence_link";
1804        }
1805        my $link = {"link_title" => $peg,
1806                    "link" => $evidence_link};
1807        push(@$hit_links_list,$link) if ($evidence_link);
1808    
1809      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1810      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1811          my $link;      my @subsystems;
1812          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1813            my $subsystem = $$array[0];
1814            push(@subsystems,$subsystem);
1815            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1816                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1817          push(@$links_list,$link);          push(@$hit_links_list,$link);
1818      }      }
1819    
1820        # blast alignment
1821        $link = {"link_title" => "view blast alignment",
1822                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1823        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1824    
1825        # description data
1826      my $description_function;      my $description_function;
1827      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1828                               "value" => $function};                               "value" => $function};
1829      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1830    
1831      my ($description_ss, $ss_string);      # subsystem description
1832      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1833      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1834        my $description_ss = {"title" => "subsystems",
1835                         "value" => $ss_string};                         "value" => $ss_string};
1836      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1837    
1838        # location description
1839        # hit
1840      my $description_loc;      my $description_loc;
1841      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1842                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1843      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1844    
1845      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1846                          "value" => $hit_stop};                          "value" => $ln_hit};
1847      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1848    
1849        # query
1850        $description_loc = {"title" => "Hit Location",
1851                            "value" => $query_start . " - " . $query_stop};
1852        push(@$query_descriptions, $description_loc);
1853    
1854        $description_loc = {"title" => "Sequence Length",
1855                            "value" => $ln_query};
1856        push(@$query_descriptions, $description_loc);
1857    
1858      my $evalue = $self->evalue;  
1859    
1860        # evalue score description
1861        my $evalue = $thing->evalue;
1862      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1863      {      {
1864          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1699  Line 1867 
1867      }      }
1868    
1869      my $color = &color($evalue);      my $color = &color($evalue);
   
1870      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1871                              "value" => $evalue};                              "value" => $evalue};
1872      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1873        push(@$query_descriptions, $description_eval);
1874    
1875      my $identity = $self->identity;      my $identity = $self->identity;
1876      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1877                                  "value" => $identity};                                  "value" => $identity};
1878      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1879        push(@$query_descriptions, $description_identity);
1880    
1881    
1882        my $number = $base_start + ($query_start-$hit_start);
1883        #print STDERR "START: $number";
1884        $element_hash = {
1885            "title" => $query_id,
1886            "start" => $base_start,
1887            "end" => $base_start+$ln_query,
1888            "type"=> 'box',
1889            "color"=> $color,
1890            "zlayer" => "2",
1891            "links_list" => $query_links_list,
1892            "description" => $query_descriptions
1893            };
1894        push(@$query_data,$element_hash);
1895    
1896        $element_hash = {
1897            "title" => $query_id . ': HIT AREA',
1898            "start" => $base_start + $query_start,
1899            "end" =>  $base_start + $query_stop,
1900            "type"=> 'smallbox',
1901            "color"=> $query_color,
1902            "zlayer" => "3",
1903            "links_list" => $query_links_list,
1904            "description" => $query_descriptions
1905            };
1906        push(@$query_data,$element_hash);
1907    
1908        $gd->add_line($query_data, $query_config);
1909    
1910    
1911      $element_hash = {      $element_hash = {
1912          "title" => $peg,          "title" => $peg,
1913          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1914          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1915          "type"=> 'box',          "type"=> 'box',
1916          "color"=> $color,          "color"=> $color,
1917          "zlayer" => "2",          "zlayer" => "2",
1918          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1919          "description" => $descriptions                  "description" => $hit_descriptions
1920                    };
1921        push(@$line_data,$element_hash);
1922    
1923        $element_hash = {
1924            "title" => $peg . ': HIT AREA',
1925            "start" => $base_start + $query_start,
1926            "end" =>  $base_start + $query_stop,
1927            "type"=> 'smallbox',
1928            "color"=> $hit_color,
1929            "zlayer" => "3",
1930            "links_list" => $hit_links_list,
1931            "description" => $hit_descriptions
1932          };          };
1933      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1934    
1935      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1936    
1937      return ($gd);      my $breaker = [];
1938        my $breaker_hash = {};
1939        my $breaker_config = { 'no_middle_line' => "1" };
1940    
1941        push (@$breaker, $breaker_hash);
1942        $gd->add_line($breaker, $breaker_config);
1943    
1944        return ($gd);
1945  }  }
1946    
1947  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1951 
1951  =cut  =cut
1952    
1953  sub display_domain_composition {  sub display_domain_composition {
1954      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1955    
1956      my $fig = new FIG;      #$fig = new FIG;
1957      my $peg = $self->acc;      my $peg = $self->acc;
1958    
1959      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1961 
1961      my $descriptions = [];      my $descriptions = [];
1962    
1963      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1964        #my @domain_query_results = ();
1965      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1966          my $key = @$dqr[1];          my $key = @$dqr[1];
1967          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 1986 
1986              }              }
1987          }          }
1988    
1989          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1990                                    -host     => $WebConfig::DBHOST,
1991                                    -user     => $WebConfig::DBUSER,
1992                                    -password => $WebConfig::DBPWD);
1993          my ($name_value,$description_value);          my ($name_value,$description_value);
1994    
1995          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 2026 
2026          my $link;          my $link;
2027          my $link_url;          my $link_url;
2028          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"}
2029          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"}
2030          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2031    
2032          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 2050 
2050      }      }
2051    
2052      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2053                            'hover_title' => 'Domain',
2054                          'short_title' => $peg,                          'short_title' => $peg,
2055                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2056    
# Line 1848  Line 2070 
2070  =cut  =cut
2071    
2072  sub display_table {  sub display_table {
2073      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2074        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2075    
2076      my $data = [];      my $scroll_list;
2077      my $count = 0;      foreach my $col (@$show_columns){
2078      my $content;          push (@$scroll_list, $col->{key});
2079      my $fig = new FIG;      }
2080      my $cgi = new CGI;  
2081      my @ids;      push (@ids, $query_fid);
2082      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2083          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2084          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2085      }      }
2086    
2087      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2088        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2089    
2090      # get the column for the subsystems      # get the column for the subsystems
2091      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2092    
2093      # get the column for the evidence codes      # get the column for the evidence codes
2094      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2095    
2096      # get the column for pfam_domain      # get the column for pfam_domain
2097      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2098    
2099        # get the column for molecular weight
2100        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2101    
2102        # get the column for organism's habitat
2103        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2104    
2105        # get the column for organism's temperature optimum
2106        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2107    
2108        # get the column for organism's temperature range
2109        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2110    
2111        # get the column for organism's oxygen requirement
2112        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2113    
2114        # get the column for organism's pathogenicity
2115        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2116    
2117        # get the column for organism's pathogenicity host
2118        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2119    
2120        # get the column for organism's salinity
2121        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2122    
2123        # get the column for organism's motility
2124        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2125    
2126        # get the column for organism's gram stain
2127        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2128    
2129        # get the column for organism's endospores
2130        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2131    
2132        # get the column for organism's shape
2133        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2134    
2135        # get the column for organism's disease
2136        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2137    
2138        # get the column for organism's disease
2139        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2140    
2141        # get the column for transmembrane domains
2142        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2143    
2144        # get the column for similar to human
2145        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);
2146    
2147        # get the column for signal peptide
2148        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2149    
2150        # get the column for transmembrane domains
2151        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2152    
2153        # get the column for conserved neighborhood
2154        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2155    
2156        # get the column for cellular location
2157        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2158    
2159        # get the aliases
2160        my $alias_col;
2161        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2162             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2163             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2164             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2165             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2166            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2167        }
2168    
2169      my %e_identical = &get_essentially_identical($query_fid);      # get the colors for the function cell
2170      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $functions = $fig->function_of_bulk(\@ids,1);
2171        $functional_color = &get_function_color_cell($functions, $fig);
2172        my $query_function = $fig->function_of($query_fid);
2173    
2174        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2175    
2176        my $figfam_data = &FIG::get_figfams_data();
2177        my $figfams = new FFs($figfam_data);
2178    
2179        my $func_color_offset=0;
2180        unshift(@$dataset, $query_fid);
2181      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2182            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2);
2183            if ($thing eq $query_fid){
2184                $id = $thing;
2185                $taxid   = $fig->genome_of($id);
2186                $organism = $fig->genus_species($taxid);
2187                $current_function = $fig->function_of($id);
2188            }
2189            else{
2190          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2191    
2192                $id      = $thing->acc;
2193                $evalue  = $thing->evalue;
2194                $taxid   = $fig->genome_of($id);
2195                $iden    = $thing->identity;
2196                $organism= $thing->organism;
2197                $ln1     = $thing->qlength;
2198                $ln2     = $thing->hlength;
2199                $b1      = $thing->qstart;
2200                $e1      = $thing->qstop;
2201                $b2      = $thing->hstart;
2202                $e2      = $thing->hstop;
2203                $d1      = abs($e1 - $b1) + 1;
2204                $d2      = abs($e2 - $b2) + 1;
2205                $color1  = match_color( $b1, $e1, $ln1 );
2206                $color2  = match_color( $b2, $e2, $ln2 );
2207                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2208                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2209                $current_function = $thing->function;
2210            }
2211    
2212          my $single_domain = [];          my $single_domain = [];
2213          $count++;          $count++;
2214    
2215          my $id = $thing->acc;          # organisms cell
2216            my ($org, $org_color) = $fig->org_and_color_of($id);
2217          my $iden    = $thing->identity;          my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
2218    
2219          # checkbox column          # checkbox cell
2220            my ($box_cell,$tax, $radio_cell);
2221          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2222          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2223          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_". $id;
2224            my $replace_id = $id;
2225            $replace_id =~ s/\|/_/ig;
2226            my $white = '#ffffff';
2227            $white = '#999966' if ($id eq $query_fid);
2228            $org_color = '#999966' if ($id eq $query_fid);
2229            my $anchor_name = "anchor_". $replace_id;
2230            if ($id =~ /^fig\|/){
2231              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');">);
2232              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" >);
2233              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2234              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2235              $tax = $fig->genome_of($id);
2236            }
2237            else{
2238              my $box = qq(<a name="$anchor_name"></a>);
2239              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2240            }
2241    
2242          # get the linked fig id          # get the linked fig id
2243          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2244          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2245              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";          $fig_data .= qq(<td><img height='10px' width='20px' src='./Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2246          }          my $fig_col = {'data'=> $fig_data,
2247          else{                         'highlight'=>$white};
2248              $fig_col = &HTML::set_prot_links($cgi,$id);  
2249          }          $replace_id = $peg;
2250            $replace_id =~ s/\|/_/ig;
2251          push(@$single_domain,$box_col);                        # permanent column          $anchor_name = "anchor_". $replace_id;
2252          push(@$single_domain,$fig_col);                        # permanent column          my $query_config = { 'title' => "Query",
2253          push(@$single_domain,$thing->evalue);                  # permanent column                               'short_title' => "Query",
2254          push(@$single_domain,"$iden\%");                       # permanent column                               'title_link' => "changeSimsLocation('$replace_id')",
2255          push(@$single_domain,$reg1);                           # permanent column                               'basepair_offset' => '0'
2256          push(@$single_domain,$reg2);                           # permanent column                               };
2257          push(@$single_domain,$thing->organism);                # permanent column  
2258          push(@$single_domain,$thing->function);                # permanent column          # function cell
2259          foreach my $col (sort keys %$scroll_list){          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2260              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}                                      3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2261              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}                                      6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2262              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
2263              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}          my $function_color;
2264              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}          if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2265              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2266              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}          }
2267              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}          else{
2268              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2269              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}          }
2270              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}          my $function_cell;
2271              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}          if ($current_function){
2272              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}            if ($current_function eq $query_function){
2273                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2274                $func_color_offset=1;
2275              }
2276              else{
2277                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2278              }
2279            }
2280            else{
2281              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2282            }
2283    
2284            if ($id eq $query_fid){
2285                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2286                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2287                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2288            }
2289            else{
2290                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2291                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2292            }
2293    
2294            if ( ( $application->session->user) ){
2295                if ( ($application->session->user->login) && ($application->session->user->login eq "arodri")){
2296                    push (@$single_domain,$radio_cell);
2297          }          }
         push(@$data,$single_domain);  
2298      }      }
2299    
2300            my ($ff) = $figfams->families_containing_peg($id);
2301    
2302            foreach my $col (@$scroll_list){
2303                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2304                else { $highlight_color = "#ffffff"; }
2305    
2306                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2307                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2308                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2309                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2310                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2311                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2312                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2313                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2314                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2315                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2316                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2317                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2318                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2319                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2320                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2340            }
2341            push(@$data,$single_domain);
2342        }
2343      if ($count >0 ){      if ($count >0 ){
2344          $content = $data;          $content = $data;
2345      }      }
2346      else{      else{
2347          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2348      }      }
2349        shift(@$dataset);
2350      return ($content);      return ($content);
2351  }  }
2352    
# Line 1949  Line 2356 
2356      foreach my $id (@$ids){      foreach my $id (@$ids){
2357          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2358          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2359          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2360            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2361      }      }
2362      return (%column);      return (%column);
2363  }  }
2364    
2365    sub get_figfam_column{
2366        my ($ids, $fig, $cgi) = @_;
2367        my $column;
2368    
2369        my $figfam_data = &FIG::get_figfams_data();
2370        my $figfams = new FFs($figfam_data);
2371    
2372        foreach my $id (@$ids){
2373            my ($ff) =  $figfams->families_containing_peg($id);
2374            if ($ff){
2375                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2376            }
2377            else{
2378                push (@$column, " ");
2379            }
2380        }
2381    
2382        return $column;
2383    }
2384    
2385  sub get_subsystems_column{  sub get_subsystems_column{
2386      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2387    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2388      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2389      my %column;      my ($column, $ss);
2390      foreach my $id (@$ids){      foreach my $id (@$ids){
2391          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2392          my @subsystems;          my @subsystems;
2393    
2394          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2395              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2396                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2397                  $count++;                  $ss =~ s/_/ /ig;
2398                    push (@subsystems, "-" . $ss);
2399              }              }
2400              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2401              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2402          } else {          } else {
2403              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2404          }          }
2405            push (@$column, $ss->{$id});
2406      }      }
2407      return (%column);  
2408        if ($returnType eq 'hash') { return $ss; }
2409        elsif ($returnType eq 'array') { return $column; }
2410    }
2411    
2412    sub get_lineage_column{
2413        my ($ids, $fig, $cgi) = @_;
2414    
2415        my $lineages = $fig->taxonomy_list();
2416    
2417        foreach my $id (@$ids){
2418            my $genome = $fig->genome_of($id);
2419            if ($lineages->{$genome}){
2420    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2421                push (@$column, $lineages->{$genome});
2422            }
2423            else{
2424                push (@$column, " ");
2425            }
2426        }
2427        return $column;
2428    }
2429    
2430    sub match_color {
2431        my ( $b, $e, $n , $rgb) = @_;
2432        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2433        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2434        my $cov = ( $r - $l + 1 ) / $n;
2435        my $sat = 1 - 10 * $cov / 9;
2436        my $br  = 1;
2437        if ($rgb){
2438            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2439        }
2440        else{
2441            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2442        }
2443    }
2444    
2445    sub hsb2rgb {
2446        my ( $h, $s, $br ) = @_;
2447        $h = 6 * ($h - floor($h));
2448        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2449        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2450        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2451                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2452                                          :               ( 0,      1,      $h - 2 )
2453                                          )
2454                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2455                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2456                                          :               ( 1,      0,      6 - $h )
2457                                          );
2458        ( ( $r * $s + 1 - $s ) * $br,
2459          ( $g * $s + 1 - $s ) * $br,
2460          ( $b * $s + 1 - $s ) * $br
2461        )
2462    }
2463    
2464    sub html2rgb {
2465        my ($hex) = @_;
2466        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2467        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2468                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2469    
2470        my @R = split(//, $r);
2471        my @G = split(//, $g);
2472        my @B = split(//, $b);
2473    
2474        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2475        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2476        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2477    
2478        my $rgb = [$red, $green, $blue];
2479        return $rgb;
2480    
2481    }
2482    
2483    sub rgb2html {
2484        my ( $r, $g, $b ) = @_;
2485        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2486        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2487        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2488        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2489    }
2490    
2491    sub floor {
2492        my $x = $_[0];
2493        defined( $x ) || return undef;
2494        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2495    }
2496    
2497    sub get_function_color_cell{
2498      my ($functions, $fig) = @_;
2499    
2500      # figure out the quantity of each function
2501      my %hash;
2502      foreach my $key (keys %$functions){
2503        my $func = $functions->{$key};
2504        $hash{$func}++;
2505      }
2506    
2507      my %func_colors;
2508      my $count = 1;
2509      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2510        $func_colors{$key}=$count;
2511        $count++;
2512      }
2513    
2514      return \%func_colors;
2515  }  }
2516    
2517  sub get_essentially_identical{  sub get_essentially_identical{
2518      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2519      my $fig = new FIG;      #my $fig = new FIG;
2520    
2521      my %id_list;      my %id_list;
2522      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);
2523    
2524      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2525            if($thing->class eq "IDENTICAL"){
2526                my $rows = $thing->rows;
2527                my $count_identical = 0;
2528                foreach my $row (@$rows) {
2529                    my $id = $row->[0];
2530          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2531              $id_list{$id} = 1;              $id_list{$id} = 1;
2532          }          }
2533      }      }
2534            }
2535        }
2536    
2537    #    foreach my $id (@maps_to) {
2538    #        if (($id ne $fid) && ($fig->function_of($id))) {
2539    #           $id_list{$id} = 1;
2540    #        }
2541    #    }
2542      return(%id_list);      return(%id_list);
2543  }  }
2544    
2545    
2546  sub get_evidence_column{  sub get_evidence_column{
2547      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2548      my $fig = new FIG;      my ($column, $code_attributes);
2549      my $cgi = new CGI;  
2550      my (%column, %code_attributes);      if (! defined $attributes) {
2551            my @attributes_array = $fig->get_attributes($ids);
2552            $attributes = \@attributes_array;
2553        }
2554    
2555      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2556      foreach my $key (@codes){      foreach my $key (@codes){
2557          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2558      }      }
2559    
2560      foreach my $id (@$ids){      foreach my $id (@$ids){
2561          # add evidence code with tool tip          # add evidence code with tool tip
2562          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2563    
2564          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2565              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2566              foreach my $code (@codes) {              foreach my $code (@codes) {
2567                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2568                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2572 
2572                  }                  }
2573                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2574              }              }
         }  
2575    
2576          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2577              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 2033  Line 2579 
2579                                  {                                  {
2580                                      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));
2581          }          }
2582          $column{$id}=$ev_codes;  
2583            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2584            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2585      }      }
2586      return (%column);      return $column;
2587  }  }
2588    
2589  sub get_pfam_column{  sub get_attrb_column{
2590      my ($ids) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
     my $dbmaster = DBMaster->new(-database =>'Ontology');  
2591    
2592      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my ($column, %code_attributes, %attribute_locations);
2593        my $dbmaster = DBMaster->new(-database =>'Ontology',
2594                                     -host     => $WebConfig::DBHOST,
2595                                     -user     => $WebConfig::DBUSER,
2596                                     -password => $WebConfig::DBPWD);
2597    
2598        if ($colName eq "pfam"){
2599            if (! defined $attributes) {
2600                my @attributes_array = $fig->get_attributes($ids);
2601                $attributes = \@attributes_array;
2602            }
2603    
2604            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2605      foreach my $key (@codes){      foreach my $key (@codes){
2606          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2607                if ($name =~ /_/){
2608                    ($name) = ($key->[1]) =~ /(.*?)_/;
2609                }
2610                push (@{$code_attributes{$key->[0]}}, $name);
2611                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2612      }      }
2613    
2614      foreach my $id (@$ids){      foreach my $id (@$ids){
2615          # add evidence code with tool tip              # add pfam code
2616          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2617          my @pfam_codes = "";          my @pfam_codes = "";
2618          my %description_codes;          my %description_codes;
2619    
2620          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2621              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2622              @pfam_codes = ();              @pfam_codes = ();
2623              foreach my $code (@codes) {  
2624                    # get only unique values
2625                    my %saw;
2626                    foreach my $key (@ncodes) {$saw{$key}=1;}
2627                    @ncodes = keys %saw;
2628    
2629                    foreach my $code (@ncodes) {
2630                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2631                  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>";
2632    
2633                        # get the locations for the domain
2634                        my @locs;
2635                        foreach my $part (@{$attribute_location{$id}{$code}}){
2636                            my ($loc) = ($part) =~ /\;(.*)/;
2637                            push (@locs,$loc);
2638                        }
2639                        my %locsaw;
2640                        foreach my $key (@locs) {$locsaw{$key}=1;}
2641                        @locs = keys %locsaw;
2642    
2643                        my $locations = join (", ", @locs);
2644    
2645                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2646                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1] ($locations)");
2647                  }                  }
2648                  else {                  else {
2649                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2650                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2651                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link ($locations)");
                 }  
2652              }              }
2653          }          }
2654    
2655          $column{$id}=join("<br><br>", @pfam_codes);                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2656                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2657                }
2658            }
2659        }
2660        elsif ($colName eq 'cellular_location'){
2661            if (! defined $attributes) {
2662                my @attributes_array = $fig->get_attributes($ids);
2663                $attributes = \@attributes_array;
2664      }      }
     return (%column);  
2665    
2666            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2667            foreach my $key (@codes){
2668                my ($loc) = ($key->[1]) =~ /::(.*)/;
2669                my ($new_loc, @all);
2670                @all = split (//, $loc);
2671                my $count = 0;
2672                foreach my $i (@all){
2673                    if ( ($i eq uc($i)) && ($count > 0) ){
2674                        $new_loc .= " " . $i;
2675                    }
2676                    else{
2677                        $new_loc .= $i;
2678                    }
2679                    $count++;
2680                }
2681                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2682  }  }
2683    
2684  sub get_prefer {          foreach my $id (@$ids){
2685      my ($fid, $db, $all_aliases) = @_;              my (@values, $entry);
2686      my $fig = new FIG;              #@values = (" ");
2687      my $cgi = new CGI;              if (defined @{$code_attributes{$id}}){
2688                    my @ncodes = @{$code_attributes{$id}};
2689                    foreach my $code (@ncodes){
2690                        push (@values, $code->[0] . ", " . $code->[1]);
2691                    }
2692                }
2693                else{
2694                    @values = ("Not available");
2695                }
2696    
2697      foreach my $alias (@{$$all_aliases{$fid}}){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2698          my $id_db = &Observation::get_database($alias);              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         if ($id_db eq $db){  
             my $acc_col .= &HTML::set_prot_links($cgi,$alias);  
             return ($acc_col);  
2699          }          }
2700      }      }
2701      return (" ");      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2702                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2703            if (! defined $attributes) {
2704                my @attributes_array = $fig->get_attributes($ids);
2705                $attributes = \@attributes_array;
2706  }  }
2707    
2708  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2709            foreach my $key (@codes){
2710                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2711            }
2712    
2713  sub color {          foreach my $id (@$ids){
2714      my ($evalue) = @_;              my (@values, $entry);
2715                #@values = (" ");
2716                if (defined @{$code_attributes{$id}}){
2717                    my @ncodes = @{$code_attributes{$id}};
2718                    foreach my $code (@ncodes){
2719                        push (@values, $code);
2720                    }
2721                }
2722                else{
2723                    @values = ("Not available");
2724                }
2725    
2726      my $color;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2727      if ($evalue <= 1e-170){              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         $color = 51;  
2728      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2729      }      }
2730      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2731          $color = 53;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2732                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2733                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2734                ($colName eq 'gc_content') ) {
2735            if (! defined $attributes) {
2736                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2737                $attributes = \@attributes_array;
2738      }      }
2739      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2740          $color = 54;          my $genomes_with_phenotype;
2741            foreach my $attribute (@$attributes){
2742                my $genome = $attribute->[0];
2743                $genomes_with_phenotype->{$genome} = $attribute->[2];
2744      }      }
2745      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
2746          $color = 55;          foreach my $id (@$ids){
2747                my $genome = $fig->genome_of($id);
2748                my @values = (' ');
2749                if (defined $genomes_with_phenotype->{$genome}){
2750                    push (@values, $genomes_with_phenotype->{$genome});
2751      }      }
2752      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2753          $color = 56;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2754      }      }
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
2755      }      }
2756      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2757          $color = 58;      return $column;
2758      }      }
2759      elsif (($evalue <= 10) && ($evalue > 1)){  
2760          $color = 59;  
2761    sub get_db_aliases {
2762        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2763    
2764        my $db_array;
2765        my $all_aliases = $fig->feature_aliases_bulk($ids);
2766        foreach my $id (@$ids){
2767            foreach my $alias (@{$$all_aliases{$id}}){
2768                my $id_db = &Observation::get_database($alias);
2769                next if ( ($id_db ne $db) && ($db ne 'all') );
2770                next if ($aliases->{$id}->{$db});
2771                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2772      }      }
2773      else{          if (!defined( $aliases->{$id}->{$db})){
2774          $color = 60;              $aliases->{$id}->{$db} = " ";
2775            }
2776            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2777            push (@$db_array, $aliases->{$id}->{$db});
2778      }      }
2779    
2780        if ($returnType eq 'hash') { return $aliases; }
2781        elsif ($returnType eq 'array') { return $db_array; }
2782    }
2783    
2784    
2785    
2786    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2787    
2788    sub color {
2789        my ($evalue) = @_;
2790        my $palette = WebColors::get_palette('vitamins');
2791        my $color;
2792        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2793        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2794        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2795        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2796        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2797        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2798        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2799        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2800        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2801        else{        $color = $palette->[9];    }
2802      return ($color);      return ($color);
2803  }  }
2804    
# Line 2152  Line 2818 
2818  }  }
2819    
2820  sub display {  sub display {
2821      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2822    
2823        $taxes = $fig->taxonomy_list();
2824    
2825      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2826      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2827      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2828      my $fig = new FIG;      my $range = $gd_window_size;
2829      my $all_regions = [];      my $all_regions = [];
2830      my $gene_associations={};      my $gene_associations={};
2831    
# Line 2182  Line 2850 
2850      my ($region_start, $region_end);      my ($region_start, $region_end);
2851      if ($beg < $end)      if ($beg < $end)
2852      {      {
2853          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2854          $region_end = $end+4000;          $region_end = $end+ ($range);
2855          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2856      }      }
2857      else      else
2858      {      {
2859          $region_start = $end-4000;          $region_start = $end-($range);
2860          $region_end = $beg+4000;          $region_end = $beg+($range);
2861          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2862          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2863          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2865 
2865    
2866      # call genes in region      # call genes in region
2867      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);
2868        #foreach my $feat (@$target_gene_features){
2869        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2870        #}
2871      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2872      my (@start_array_region);      my (@start_array_region);
2873      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2874    
2875      my %all_genes;      my %all_genes;
2876      my %all_genomes;      my %all_genomes;
2877      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2878            #if ($feature =~ /peg/){
2879      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2880      {          #}
         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;  
2881                  }                  }
2882    
2883                  push (@start_array_region, $offset);      my @selected_sims;
2884    
2885                  $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"){  
2886          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2887          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2888    
2889          # 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");  
   
2890          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2891              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2892                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2893                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2894                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2895                    #my $genome = $fig->genome_of($sim->[1]);
2896                    my $genome = $fig->genome_of($sim->acc);
2897                    #my ($genome1) = ($genome) =~ /(.*)\./;
2898                    my $lineage = $taxes->{$genome};
2899                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2900                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2901                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2902                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2903                            push (@selected_sims, $sim->acc);
2904                      }                      }
2905                  }                  }
2906                  my %saw;              }
2907                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2908            else{
2909                my $simcount = 0;
2910                foreach my $sim (@$sims_array){
2911                    next if ($sim->class ne "SIM");
2912                    next if ($sim->acc !~ /fig\|/);
2913    
2914                    push (@selected_sims, $sim->acc);
2915                    $simcount++;
2916                    last if ($simcount > 4);
2917              }              }
2918          }          }
2919    
2920            my %saw;
2921            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2922    
2923          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2924          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2925              #get the organism genome              #get the organism genome
# Line 2293  Line 2942 
2942              my ($region_start, $region_end);              my ($region_start, $region_end);
2943              if ($beg < $end)              if ($beg < $end)
2944              {              {
2945                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2946                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2947                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2948              }              }
2949              else              else
2950              {              {
2951                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2952                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2953                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2954                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2955                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2965 
2965    
2966      }      }
2967    
2968        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2969      # cluster the genes      # cluster the genes
2970      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2971      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2972        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2973        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2974    
2975      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2976          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2977          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2978          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2979          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2980            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2981            my $lineage = $taxes->{$region_genome};
2982            #my $lineage = $fig->taxonomy_of($region_genome);
2983            #$region_gs .= "Lineage:$lineage";
2984          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2985                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2986                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2988 
2988    
2989          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2990    
2991          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2992                                     'short_title' => "",                                     'short_title' => "",
2993                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2994                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 3012 
3012    
3013              # get subsystem information              # get subsystem information
3014              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3015              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3016    
3017              my $link;              my $link;
3018              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3019                       "link" => $url_link};                       "link" => $url_link};
3020              push(@$links_list,$link);              push(@$links_list,$link);
3021    
3022              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3023              foreach my $subsystem (@subsystems){              my @subsystems;
3024                foreach my $array (@subs){
3025                    my $subsystem = $$array[0];
3026                    my $ss = $subsystem;
3027                    $ss =~ s/_/ /ig;
3028                    push (@subsystems, $ss);
3029                  my $link;                  my $link;
3030                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3031                           "link_title" => $subsystem};                           "link_title" => $ss};
3032                    push(@$links_list,$link);
3033                }
3034    
3035                if ($fid1 eq $fid){
3036                    my $link;
3037                    $link = {"link_title" => "Annotate this sequence",
3038                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3039                  push(@$links_list,$link);                  push(@$links_list,$link);
3040              }              }
3041    
# Line 2401  Line 3069 
3069                  $prev_stop = $stop;                  $prev_stop = $stop;
3070                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3071    
3072                  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})){
3073                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3074                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3075                  }                  }
3076    
3077                    my $title = $fid1;
3078                    if ($fid1 eq $fid){
3079                        $title = "My query gene: $fid1";
3080                    }
3081    
3082                  $element_hash = {                  $element_hash = {
3083                      "title" => $fid1,                      "title" => $title,
3084                      "start" => $start,                      "start" => $start,
3085                      "end" =>  $stop,                      "end" =>  $stop,
3086                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 3093 
3093                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3094                  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;}
3095                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3096    
3097                    if ($fid1 eq $fid){
3098                        $element_hash = {
3099                            "title" => 'Query',
3100                            "start" => $start,
3101                            "end" =>  $stop,
3102                            "type"=> 'bigbox',
3103                            "color"=> $color,
3104                            "zlayer" => "1"
3105                            };
3106    
3107                        # if there is an overlap, put into second line
3108                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3109                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3110                    }
3111              }              }
3112          }          }
3113          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3114          $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);
3115      }      }
3116      return $gd;      return ($gd, \@selected_sims);
3117  }  }
3118    
3119  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 3183 
3183      }      }
3184    
3185      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3186          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3187              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3188                  foreach $y (@$x) {                  foreach $y (@$x) {
3189                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 3201 
3201      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3202      return ($i < @$xL);      return ($i < @$xL);
3203  }  }
3204    
3205    #############################################
3206    #############################################
3207    package Observation::Commentary;
3208    
3209    use base qw(Observation);
3210    
3211    =head3 display_protein_commentary()
3212    
3213    =cut
3214    
3215    sub display_protein_commentary {
3216        my ($self,$dataset,$mypeg,$fig) = @_;
3217    
3218        my $all_rows = [];
3219        my $content;
3220        #my $fig = new FIG;
3221        my $cgi = new CGI;
3222        my $count = 0;
3223        my $peg_array = [];
3224        my ($evidence_column, $subsystems_column,  %e_identical);
3225    
3226        if (@$dataset != 1){
3227            foreach my $thing (@$dataset){
3228                if ($thing->class eq "SIM"){
3229                    push (@$peg_array, $thing->acc);
3230                }
3231            }
3232            # get the column for the evidence codes
3233            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3234    
3235            # get the column for the subsystems
3236            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3237    
3238            # get essentially identical seqs
3239            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3240        }
3241        else{
3242            push (@$peg_array, @$dataset);
3243        }
3244    
3245        my $selected_sims = [];
3246        foreach my $id (@$peg_array){
3247            last if ($count > 10);
3248            my $row_data = [];
3249            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3250            $org = $fig->org_of($id);
3251            $function = $fig->function_of($id);
3252            if ($mypeg ne $id){
3253                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3254                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3255                if (defined($e_identical{$id})) { $id_cell .= "*";}
3256            }
3257            else{
3258                $function_cell = "&nbsp;&nbsp;$function";
3259                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3260                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3261            }
3262    
3263            push(@$row_data,$id_cell);
3264            push(@$row_data,$org);
3265            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3266            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3267            push(@$row_data, $fig->translation_length($id));
3268            push(@$row_data,$function_cell);
3269            push(@$all_rows,$row_data);
3270            push (@$selected_sims, $id);
3271            $count++;
3272        }
3273    
3274        if ($count >0){
3275            $content = $all_rows;
3276        }
3277        else{
3278            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3279        }
3280        return ($content,$selected_sims);
3281    }
3282    
3283    sub display_protein_history {
3284        my ($self, $id,$fig) = @_;
3285        my $all_rows = [];
3286        my $content;
3287    
3288        my $cgi = new CGI;
3289        my $count = 0;
3290        foreach my $feat ($fig->feature_annotations($id)){
3291            my $row = [];
3292            my $col1 = $feat->[2];
3293            my $col2 = $feat->[1];
3294            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3295            my $text = $feat->[3];
3296    
3297            push (@$row, $col1);
3298            push (@$row, $col2);
3299            push (@$row, $text);
3300            push (@$all_rows, $row);
3301            $count++;
3302        }
3303        if ($count > 0){
3304            $content = $all_rows;
3305        }
3306        else {
3307            $content = "There is no history for this PEG";
3308        }
3309    
3310        return($content);
3311    }
3312    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3