[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.61, Wed Jul 2 15:53:50 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  =head
378  This method returns the housekeeping data for a given peg in a table format      provides layer of abstraction between tools and underlying access method to Attribute Server
379    =cut
380    
381    sub get_attributes{
382        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
383        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
384        return @attributes;
385    }
386    
387    =head3 get_sims_objects()
388    
389    This is the B<REAL WORKHORSE> method of this Package.
390    
391  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
392    
393      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
394      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);  
395    
396      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
397      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
398      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
399      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      # call function that fetches attribute based observations
400      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);      # returns an array of arrays of hashes
401      $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
402    
403      if ( @subsystems ) {      foreach my $dataset (@matched_datasets) {
404          $content .= qq(<tr><td>Subsystems</td><td>);          my $object;
405          foreach my $subsystem ( @subsystems ) {          if ($dataset->{'class'} eq "SIM"){
406              $content .= join(" -- ", @$subsystem) . "<br>\n";              $object = Observation::Sims->new($dataset);
407          }          }
408            push (@$objects, $object);
409      }      }
410        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
411          }          }
412    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
413    
414    =head3 display_housekeeping
415    This method returns the housekeeping data for a given peg in a table format
416    
417          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
418          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
419              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
420          }      my $content = [];
421          $content .= qq(</td></tr></table>\n);      my $row = [];
     }  
422    
423      $content .= qq(</table><p>\n);      my $org_name = $fig->org_of($fid);
424        my $org_id = $fig->genome_of($fid);
425        my $function = $fig->function_of($fid);
426        #my $taxonomy = $fig->taxonomy_of($org_id);
427        my $length = $fig->translation_length($fid);
428    
429        push (@$row, $org_name);
430        push (@$row, $fid);
431        push (@$row, $length);
432        push (@$row, $function);
433    
434        # initialize the table for commentary and annotations
435        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
436        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
437        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
438        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
439        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
440        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
441        #$content .= qq(</table><p>\n);
442    
443        push(@$content, $row);
444    
445      return ($content);      return ($content);
446  }  }
# Line 435  Line 451 
451  =cut  =cut
452    
453  sub get_sims_summary {  sub get_sims_summary {
454      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
455      my %families;      my %families;
456      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
457    
458        foreach my $thing (@$dataset) {
459            my ($id, $evalue);
460            if ($thing =~ /fig\|/){
461                $id = $thing;
462                $evalue = -1;
463            }
464            else{
465                next if ($thing->class ne "SIM");
466                $id      = $thing->acc;
467                $evalue  = $thing->evalue;
468            }
469            next if ($id !~ /fig\|/);
470            next if ($fig->is_deleted_fid($id));
471    
472      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
473          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
474          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
475          my $parent_tax = "Root";          my $parent_tax = "Root";
476          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
477            push (@{$families{figs}{$parent_tax}}, $id);
478            my $level = 2;
479          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
480              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
481                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
482                $families{level}{$tax} = $level;
483              push (@currLineage, $tax);              push (@currLineage, $tax);
484              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
485              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
486                if (defined ($families{evalue}{$tax})){
487                    if ($evalue < $families{evalue}{$tax}){
488                        $families{evalue}{$tax} = $evalue;
489                        $families{color}{$tax} = &get_taxcolor($evalue);
490                    }
491                }
492                else{
493                    $families{evalue}{$tax} = $evalue;
494                    $families{color}{$tax} = &get_taxcolor($evalue);
495                }
496    
497              $parent_tax = $tax;              $parent_tax = $tax;
498                $level++;
499          }          }
500      }      }
501    
# Line 462  Line 506 
506          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
507          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
508      }      }
509      return (\%families);  
510        return \%families;
511  }  }
512    
513  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 518 
518    
519  =cut  =cut
520    
521    sub get_taxcolor{
522        my ($evalue) = @_;
523        my $color;
524        if ($evalue == -1){            $color = "black";      }
525        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
526        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
527        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
528        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
529        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
530        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
531        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
532        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
533        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
534        else{        $color = "#6666FF";    }
535        return ($color);
536    }
537    
538    
539  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
540    
541      # 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)
542      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
543    
544      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546          my @parts = split("::",$key);          my @parts = split("::",$key);
547          my $class = $parts[0];          my $class = $parts[0];
548            my $name = $parts[1];
549            #next if (($class eq "PFAM") && ($name !~ /interpro/));
550    
551          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
552              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 555 
555                  my $from = $2;                  my $from = $2;
556                  my $to = $3;                  my $to = $3;
557                  my $evalue;                  my $evalue;
558                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
559                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
560                      my $part1 = $2/100;                      my $part1 = $2/100;
561                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
562                  }                  }
563                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
564                        $evalue=$raw_evalue;
565                    }
566                  else{                  else{
567                      $evalue = "0.0";                      $evalue = "0.0";
568                  }                  }
# Line 520  Line 585 
585    
586  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
587    
588      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
589      my $fig = new FIG;      #my $fig = new FIG;
590    
591      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
592    
# Line 531  Line 596 
596                     };                     };
597    
598      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
599          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
600          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
601          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 607 
607                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
608                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
609                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
610              }              }
611              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
612                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 645 
645  =cut  =cut
646    
647  sub get_pdb_observations{  sub get_pdb_observations{
648      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
649    
650      my $fig = new FIG;      #my $fig = new FIG;
651    
652      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
653          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
654          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
655          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 642  Line 703 
703  =cut  =cut
704    
705  sub get_sims_observations{  sub get_sims_observations{
706        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
707    
708      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter);
709      my $fig = new FIG;      if ($parameters->{flag}){
710      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
711      my ($dataset);        $max_expand = $parameters->{max_expand};
712          $max_eval = $parameters->{max_eval};
713      my %id_list;        $db_filter = $parameters->{db_filter};
714      foreach my $sim (@sims){        $sim_order = $parameters->{sim_order};
715          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;  
716          }          }
717        else{
718          $max_sims = 50;
719          $max_expand = 5;
720          $max_eval = 1e-5;
721          $db_filter = "figx";
722          $sim_order = "id";
723      }      }
724    
725      my %already;      my($id, $genome, @genomes, %sims);
726      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand);
727      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
728          my $hit = $sim->[1];      my ($dataset);
729          my ($id) = ($hit) =~ /\|(.*)/;  
730          next if (defined($already{$id}));      if ($group_by_genome){
731          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
732          push (@new_sims, $sim);        foreach $sim ( @tmp ){
733          $already{$id} = 1;          $id = $sim->id2;
734            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
735            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
736            push @{ $sims{ $genome } }, $sim;
737          }
738          @tmp = map { @{ $sims{$_} } } @genomes;
739      }      }
740    
741      foreach my $sim (@new_sims){      foreach my $sim (@tmp){
742          my $hit = $sim->[1];          my $hit = $sim->[1];
743          my $percent = $sim->[2];          my $percent = $sim->[2];
744          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 753 
753          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
754    
755          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
756                        'query' => $sim->[0],
757                      'acc' => $hit,                      'acc' => $hit,
758                      'identity' => $percent,                      'identity' => $percent,
759                      'type' => 'seq',                      'type' => 'seq',
# Line 714  Line 783 
783      my ($id) = (@_);      my ($id) = (@_);
784    
785      my ($db);      my ($db);
786      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
787      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
788        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
789      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
790        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
791      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
792      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
793      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 725  Line 796 
796      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
797      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
798      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
799        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
800        elsif ($id =~ /^img\|/)           { $db = "IMG" }
801        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
802        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
803    
804      return ($db);      return ($db);
805    
# Line 739  Line 814 
814    
815  sub get_identical_proteins{  sub get_identical_proteins{
816    
817      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
818      my $fig = new FIG;      #my $fig = new FIG;
819      my $funcs_ref;      my $funcs_ref;
820    
 #    my %id_list;  
821      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;  
 #    }  
   
822      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
823          my ($tmp, $who);          my ($tmp, $who);
824          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}))) {  
825              $who = &get_database($id);              $who = &get_database($id);
826              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
827          }          }
828      }      }
829    
     my ($dataset);  
830      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
831                     'type' => 'seq',                     'type' => 'seq',
832                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 846 
846    
847  sub get_functional_coupling{  sub get_functional_coupling{
848    
849      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
850      my $fig = new FIG;      #my $fig = new FIG;
851      my @funcs = ();      my @funcs = ();
852    
853      # initialize some variables      # initialize some variables
# Line 797  Line 864 
864                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
865                    } @fc_data;                    } @fc_data;
866    
     my ($dataset);  
867      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
868                     'type' => 'fc',                     'type' => 'fc',
869                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 974 
974      return $self->{database};      return $self->{database};
975  }  }
976    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
977  ############################################################  ############################################################
978  ############################################################  ############################################################
979  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 999 
999  =cut  =cut
1000    
1001  sub display{  sub display{
1002      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1003    
1004      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1005      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1006                                    -host     => $WebConfig::DBHOST,
1007                                    -user     => $WebConfig::DBUSER,
1008                                    -password => $WebConfig::DBPWD);
1009    
1010      my $acc = $self->acc;      my $acc = $self->acc;
1011    
# Line 963  Line 1026 
1026      my $lines = [];      my $lines = [];
1027      my $line_data = [];      my $line_data = [];
1028      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1029                            'hover_title' => 'PDB',
1030                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1031                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1032    
1033      my $fig = new FIG;      #my $fig = new FIG;
1034      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1035      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1036    
# Line 1067  Line 1131 
1131    
1132    
1133  sub display_table{  sub display_table{
1134      my ($self) = @_;      my ($self,$fig) = @_;
1135    
1136      my $fig = new FIG;      #my $fig = new FIG;
1137      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1138      my $rows = $self->rows;      my $rows = $self->rows;
1139      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1195 
1195    
1196  sub display_table {  sub display_table {
1197    
1198      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1199      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1200      my $rows = $self->rows;      my $rows = $self->rows;
1201      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1210 
1210          # construct the score link          # construct the score link
1211          my $score = $row->[0];          my $score = $row->[0];
1212          my $toid = $row->[1];          my $toid = $row->[1];
1213          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";
1214          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1215    
1216          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1217          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1264 
1264      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1265      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1266    
1267      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1268                                    -host     => $WebConfig::DBHOST,
1269                                    -user     => $WebConfig::DBUSER,
1270                                    -password => $WebConfig::DBPWD);
1271    
1272      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1273      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1286 
1286              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1287          }          }
1288      }      }
1289        elsif($db =~ /PFAM/){
1290            my ($new_id) = ($id) =~ /(.*?)_/;
1291            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1292            if(!scalar(@$pfam_objs)){
1293                $name_title = "name";
1294                $name_value = "not available";
1295                $description_title = "description";
1296                $description_value = "not available";
1297            }
1298            else{
1299                my $pfam_obj = $pfam_objs->[0];
1300                $name_title = "name";
1301                $name_value = $pfam_obj->term;
1302                #$description_title = "description";
1303                #$description_value = $pfam_obj->description;
1304            }
1305        }
1306    
1307      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1308                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1309        my $new_short_title=$short_title;
1310        if ($short_title =~ /interpro/){
1311            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1312        }
1313        my $line_config = { 'title' => $name_value,
1314                            'hover_title', => 'Domain',
1315                            'short_title' => $new_short_title,
1316                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1317    
1318      my $name;      my $name;
1319      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1320               "value" => $name_value};      $name = {"title" => $db,
1321                 "value" => $new_id};
1322      push(@$descriptions,$name);      push(@$descriptions,$name);
1323    
1324      my $description;  #    my $description;
1325      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1326                               "value" => $description_value};  #                   "value" => $description_value};
1327      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1328    
1329      my $score;      my $score;
1330      $score = {"title" => "score",      $score = {"title" => "score",
1331                "value" => $thing->evalue};                "value" => $thing->evalue};
1332      push(@$descriptions,$score);      push(@$descriptions,$score);
1333    
1334        my $location;
1335        $location = {"title" => "location",
1336                     "value" => $thing->start . " - " . $thing->stop};
1337        push(@$descriptions,$location);
1338    
1339      my $link_id;      my $link_id;
1340      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1341          $link_id = $1;          $link_id = $1;
1342      }      }
1343    
1344      my $link;      my $link;
1345      my $link_url;      my $link_url;
1346      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"}
1347      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"}
1348      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1349    
1350      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1255  Line 1352 
1352      push(@$links_list,$link);      push(@$links_list,$link);
1353    
1354      my $element_hash = {      my $element_hash = {
1355          "title" => $thing->type,          "title" => $name_value,
1356          "start" => $thing->start,          "start" => $thing->start,
1357          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1358          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1382 
1382          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1383          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1384    
1385          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1386                                    -host     => $WebConfig::DBHOST,
1387                                    -user     => $WebConfig::DBUSER,
1388                                    -password => $WebConfig::DBPWD);
1389    
1390          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1391          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1404 
1404                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1405              }              }
1406          }          }
1407            elsif($db =~ /PFAM/){
1408                my ($new_id) = ($id) =~ /(.*?)_/;
1409                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1410                if(!scalar(@$pfam_objs)){
1411                    $name_title = "name";
1412                    $name_value = "not available";
1413                    $description_title = "description";
1414                    $description_value = "not available";
1415                }
1416                else{
1417                    my $pfam_obj = $pfam_objs->[0];
1418                    $name_title = "name";
1419                    $name_value = $pfam_obj->term;
1420                    #$description_title = "description";
1421                    #$description_value = $pfam_obj->description;
1422                }
1423            }
1424    
1425          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1426    
# Line 1356  Line 1473 
1473      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1474      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1475      if($cello_location){      if($cello_location){
1476          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1477          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1478      }      }
1479      return ($html);      return ($html);
1480  }  }
1481    
1482  sub display {  sub display {
1483      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1484    
1485      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1486      my $fig= new FIG;      #my $fig= new FIG;
1487      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1488    
1489      my $cleavage_prob;      my $cleavage_prob;
# Line 1386  Line 1503 
1503      #color is      #color is
1504      my $color = "6";      my $color = "6";
1505    
1506  =pod=  =head3
1507    
1508      if($cello_location){      if($cello_location){
1509          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1394  Line 1511 
1511    
1512          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1513                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1514                                'hover_title' => 'Localization',
1515                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1516    
1517          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1536 
1536          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1537      }      }
1538    
 =cut  
   
1539      $color = "2";      $color = "2";
1540      if($tmpred_score){      if($tmpred_score){
1541          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1565 
1565          }          }
1566          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1567      }      }
1568    =cut
1569    
1570      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1571          my $line_data =[];          my $line_data =[];
1572          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1573                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1574                                'hover_title' => 'Localization',
1575                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1576    
1577          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1578              my $descriptions = [];              my $descriptions = [];
1579              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1580                               "value" => $tm_loc};                               "value" => $tm_loc};
1581              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1582    
1583              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1584    
1585              my $element_hash = {              my $element_hash = {
1586              "title" => "phobius transmembrane location",              "title" => "Phobius",
1587              "start" => $begin + 1,              "start" => $begin + 1,
1588              "end" =>  $end + 1,              "end" =>  $end + 1,
1589              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1617 
1617          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1618      }      }
1619    
1620    =head3
1621      $color = "1";      $color = "1";
1622      if($signal_peptide_score){      if($signal_peptide_score){
1623          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1625 
1625    
1626          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1627                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1628                                'hover_title' => 'Localization',
1629                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1630    
1631          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1650 
1650          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1651          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1652      }      }
1653    =cut
1654    
1655      return ($gd);      return ($gd);
1656    
# Line 1602  Line 1722 
1722      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1723      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1724      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1725        $self->{query} = $dataset->{'query'};
1726      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1727      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1728      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1746 
1746  =cut  =cut
1747    
1748  sub display {  sub display {
1749      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
1750    
1751      my $organism = $self->organism;      # declare variables
1752        my $window_size = $gd->window_size;
1753        my $peg = $thing->acc;
1754        my $query_id = $thing->query;
1755        my $organism = $thing->organism;
1756        my $abbrev_name = $fig->abbrev($organism);
1757        if (!$organism){
1758          $organism = $peg;
1759          $abbrev_name = $peg;
1760        }
1761      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1762      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1763      my $function = $self->function;      my $function = $thing->function;
1764      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1765      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1766      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1767      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1768      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1769        my $ln_hit = $thing->hlength;
1770    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1771    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1772        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1773        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1774    
1775      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;
1776    
1777        # hit sequence title
1778      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1779                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1780                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1781                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1782                            'no_middle_line' => '1'
1783                          };                          };
1784    
1785        # query sequence title
1786        my $replace_id = $peg;
1787        $replace_id =~ s/\|/_/ig;
1788        my $anchor_name = "anchor_". $replace_id;
1789        my $query_config = { 'title' => "Query",
1790                             'short_title' => "Query",
1791                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1792                             'basepair_offset' => '0',
1793                             'no_middle_line' => '1'
1794                             };
1795      my $line_data = [];      my $line_data = [];
1796        my $query_data = [];
1797    
1798      my $element_hash;      my $element_hash;
1799      my $links_list = [];      my $hit_links_list = [];
1800      my $descriptions = [];      my $hit_descriptions = [];
1801        my $query_descriptions = [];
1802      # get subsystem information  
1803      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1804        # evidence link
1805      my $link;      my $evidence_link;
1806      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1807               "link" => $url_link};        $evidence_link = "?page=Evidence&feature=".$peg;
1808      push(@$links_list,$link);      }
1809        else{
1810          my $db = &Observation::get_database($peg);
1811          my ($link_id) = ($peg) =~ /\|(.*)/;
1812          $evidence_link = &HTML::alias_url($link_id, $db);
1813          #print STDERR "LINK: $db    $evidence_link";
1814        }
1815        my $link = {"link_title" => $peg,
1816                    "link" => $evidence_link};
1817        push(@$hit_links_list,$link) if ($evidence_link);
1818    
1819      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1820      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1821          my $link;      my @subsystems;
1822          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1823            my $subsystem = $$array[0];
1824            push(@subsystems,$subsystem);
1825            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1826                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1827          push(@$links_list,$link);          push(@$hit_links_list,$link);
1828      }      }
1829    
1830        # blast alignment
1831        $link = {"link_title" => "view blast alignment",
1832                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1833        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1834    
1835        # description data
1836      my $description_function;      my $description_function;
1837      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1838                               "value" => $function};                               "value" => $function};
1839      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1840    
1841      my ($description_ss, $ss_string);      # subsystem description
1842      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1843      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1844        my $description_ss = {"title" => "subsystems",
1845                         "value" => $ss_string};                         "value" => $ss_string};
1846      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1847    
1848        # location description
1849        # hit
1850      my $description_loc;      my $description_loc;
1851      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1852                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1853      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1854    
1855      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1856                          "value" => $hit_stop};                          "value" => $ln_hit};
1857      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1858    
1859        # query
1860        $description_loc = {"title" => "Hit Location",
1861                            "value" => $query_start . " - " . $query_stop};
1862        push(@$query_descriptions, $description_loc);
1863    
1864        $description_loc = {"title" => "Sequence Length",
1865                            "value" => $ln_query};
1866        push(@$query_descriptions, $description_loc);
1867    
1868    
1869      my $evalue = $self->evalue;  
1870        # evalue score description
1871        my $evalue = $thing->evalue;
1872      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1873      {      {
1874          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1699  Line 1877 
1877      }      }
1878    
1879      my $color = &color($evalue);      my $color = &color($evalue);
   
1880      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1881                              "value" => $evalue};                              "value" => $evalue};
1882      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1883        push(@$query_descriptions, $description_eval);
1884    
1885      my $identity = $self->identity;      my $identity = $self->identity;
1886      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1887                                  "value" => $identity};                                  "value" => $identity};
1888      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1889        push(@$query_descriptions, $description_identity);
1890    
1891    
1892        my $number = $base_start + ($query_start-$hit_start);
1893        #print STDERR "START: $number";
1894        $element_hash = {
1895            "title" => $query_id,
1896            "start" => $base_start,
1897            "end" => $base_start+$ln_query,
1898            "type"=> 'box',
1899            "color"=> $color,
1900            "zlayer" => "2",
1901            "links_list" => $query_links_list,
1902            "description" => $query_descriptions
1903            };
1904        push(@$query_data,$element_hash);
1905    
1906        $element_hash = {
1907            "title" => $query_id . ': HIT AREA',
1908            "start" => $base_start + $query_start,
1909            "end" =>  $base_start + $query_stop,
1910            "type"=> 'smallbox',
1911            "color"=> $query_color,
1912            "zlayer" => "3",
1913            "links_list" => $query_links_list,
1914            "description" => $query_descriptions
1915            };
1916        push(@$query_data,$element_hash);
1917    
1918        $gd->add_line($query_data, $query_config);
1919    
1920    
1921      $element_hash = {      $element_hash = {
1922          "title" => $peg,          "title" => $peg,
1923          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1924          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1925          "type"=> 'box',          "type"=> 'box',
1926          "color"=> $color,          "color"=> $color,
1927          "zlayer" => "2",          "zlayer" => "2",
1928          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1929          "description" => $descriptions                  "description" => $hit_descriptions
1930          };          };
1931      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1932    
1933        $element_hash = {
1934            "title" => $peg . ': HIT AREA',
1935            "start" => $base_start + $query_start,
1936            "end" =>  $base_start + $query_stop,
1937            "type"=> 'smallbox',
1938            "color"=> $hit_color,
1939            "zlayer" => "3",
1940            "links_list" => $hit_links_list,
1941            "description" => $hit_descriptions
1942            };
1943        push(@$line_data,$element_hash);
1944    
1945      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1946    
1947      return ($gd);      my $breaker = [];
1948        my $breaker_hash = {};
1949        my $breaker_config = { 'no_middle_line' => "1" };
1950    
1951        push (@$breaker, $breaker_hash);
1952        $gd->add_line($breaker, $breaker_config);
1953    
1954        return ($gd);
1955  }  }
1956    
1957  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1961 
1961  =cut  =cut
1962    
1963  sub display_domain_composition {  sub display_domain_composition {
1964      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1965    
1966      my $fig = new FIG;      #$fig = new FIG;
1967      my $peg = $self->acc;      my $peg = $self->acc;
1968    
1969      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1971 
1971      my $descriptions = [];      my $descriptions = [];
1972    
1973      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1974        #my @domain_query_results = ();
1975      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1976          my $key = @$dqr[1];          my $key = @$dqr[1];
1977          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 1996 
1996              }              }
1997          }          }
1998    
1999          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2000                                    -host     => $WebConfig::DBHOST,
2001                                    -user     => $WebConfig::DBUSER,
2002                                    -password => $WebConfig::DBPWD);
2003          my ($name_value,$description_value);          my ($name_value,$description_value);
2004    
2005          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 2036 
2036          my $link;          my $link;
2037          my $link_url;          my $link_url;
2038          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"}
2039          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"}
2040          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2041    
2042          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 2060 
2060      }      }
2061    
2062      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2063                            'hover_title' => 'Domain',
2064                          'short_title' => $peg,                          'short_title' => $peg,
2065                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2066    
# Line 1848  Line 2080 
2080  =cut  =cut
2081    
2082  sub display_table {  sub display_table {
2083      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2084        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2085    
2086      my $data = [];      my $scroll_list;
2087      my $count = 0;      foreach my $col (@$show_columns){
2088      my $content;          push (@$scroll_list, $col->{key});
2089      my $fig = new FIG;      }
2090      my $cgi = new CGI;  
2091      my @ids;      push (@ids, $query_fid);
2092      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2093          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2094          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2095      }      }
2096    
2097      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2098        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2099    
2100      # get the column for the subsystems      # get the column for the subsystems
2101      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2102    
2103      # get the column for the evidence codes      # get the column for the evidence codes
2104      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2105    
2106      # get the column for pfam_domain      # get the column for pfam_domain
2107      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2108    
2109        # get the column for molecular weight
2110        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2111    
2112        # get the column for organism's habitat
2113        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2114    
2115        # get the column for organism's temperature optimum
2116        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2117    
2118        # get the column for organism's temperature range
2119        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2120    
2121        # get the column for organism's oxygen requirement
2122        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2123    
2124      my %e_identical = &get_essentially_identical($query_fid);      # get the column for organism's pathogenicity
2125      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2126    
2127        # get the column for organism's pathogenicity host
2128        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2129    
2130        # get the column for organism's salinity
2131        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2132    
2133        # get the column for organism's motility
2134        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2135    
2136        # get the column for organism's gram stain
2137        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2138    
2139        # get the column for organism's endospores
2140        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2141    
2142        # get the column for organism's shape
2143        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2144    
2145        # get the column for organism's disease
2146        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2147    
2148        # get the column for organism's disease
2149        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2150    
2151        # get the column for transmembrane domains
2152        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2153    
2154        # get the column for similar to human
2155        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);
2156    
2157        # get the column for signal peptide
2158        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2159    
2160        # get the column for transmembrane domains
2161        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2162    
2163        # get the column for conserved neighborhood
2164        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2165    
2166        # get the column for cellular location
2167        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2168    
2169        # get the aliases
2170        my $alias_col;
2171        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2172             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2173             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2174             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2175             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2176            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2177        }
2178    
2179        # get the colors for the function cell
2180        my $functions = $fig->function_of_bulk(\@ids,1);
2181        $functional_color = &get_function_color_cell($functions, $fig);
2182        my $query_function = $fig->function_of($query_fid);
2183    
2184        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2185    
2186        my $figfam_data = &FIG::get_figfams_data();
2187        my $figfams = new FFs($figfam_data);
2188    
2189        my $func_color_offset=0;
2190        unshift(@$dataset, $query_fid);
2191      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2192            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2);
2193            if ($thing eq $query_fid){
2194                $id = $thing;
2195                $taxid   = $fig->genome_of($id);
2196                $organism = $fig->genus_species($taxid);
2197                $current_function = $fig->function_of($id);
2198            }
2199            else{
2200          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2201    
2202                $id      = $thing->acc;
2203                $evalue  = $thing->evalue;
2204                $taxid   = $fig->genome_of($id);
2205                $iden    = $thing->identity;
2206                $organism= $thing->organism;
2207                $ln1     = $thing->qlength;
2208                $ln2     = $thing->hlength;
2209                $b1      = $thing->qstart;
2210                $e1      = $thing->qstop;
2211                $b2      = $thing->hstart;
2212                $e2      = $thing->hstop;
2213                $d1      = abs($e1 - $b1) + 1;
2214                $d2      = abs($e2 - $b2) + 1;
2215                $color1  = match_color( $b1, $e1, $ln1 );
2216                $color2  = match_color( $b2, $e2, $ln2 );
2217                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2218                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2219                $current_function = $thing->function;
2220            }
2221    
2222          my $single_domain = [];          my $single_domain = [];
2223          $count++;          $count++;
2224    
2225          my $id = $thing->acc;          # organisms cell
2226            my ($org, $org_color) = $fig->org_and_color_of($id);
2227          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>)";  
2228    
2229          # checkbox column          # checkbox cell
2230            my ($box_cell,$tax, $radio_cell);
2231          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2232          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2233          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;
2234            my $replace_id = $id;
2235            $replace_id =~ s/\|/_/ig;
2236            my $white = '#ffffff';
2237            $white = '#999966' if ($id eq $query_fid);
2238            $org_color = '#999966' if ($id eq $query_fid);
2239            my $anchor_name = "anchor_". $replace_id;
2240            if ($id =~ /^fig\|/){
2241              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');">);
2242              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" >);
2243              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2244              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2245              $tax = $fig->genome_of($id);
2246            }
2247            else{
2248              my $box = qq(<a name="$anchor_name"></a>);
2249              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2250            }
2251    
2252          # get the linked fig id          # get the linked fig id
2253          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2254          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2255              $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>);
2256          }          my $fig_col = {'data'=> $fig_data,
2257          else{                         'highlight'=>$white};
2258              $fig_col = &HTML::set_prot_links($cgi,$id);  
2259          }          $replace_id = $peg;
2260            $replace_id =~ s/\|/_/ig;
2261          push(@$single_domain,$box_col);                        # permanent column          $anchor_name = "anchor_". $replace_id;
2262          push(@$single_domain,$fig_col);                        # permanent column          my $query_config = { 'title' => "Query",
2263          push(@$single_domain,$thing->evalue);                  # permanent column                               'short_title' => "Query",
2264          push(@$single_domain,"$iden\%");                       # permanent column                               'title_link' => "changeSimsLocation('$replace_id')",
2265          push(@$single_domain,$reg1);                           # permanent column                               'basepair_offset' => '0'
2266          push(@$single_domain,$reg2);                           # permanent column                               };
2267          push(@$single_domain,$thing->organism);                # permanent column  
2268          push(@$single_domain,$thing->function);                # permanent column          # function cell
2269          foreach my $col (sort keys %$scroll_list){          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2270              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}                                      3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2271              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}                                      6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2272              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
2273              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}          my $function_color;
2274              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) ){
2275              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};
2276              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}          }
2277              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}          else{
2278              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2279              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}          }
2280              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}          my $function_cell;
2281              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}          if ($current_function){
2282              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}            if ($current_function eq $query_function){
2283                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2284                $func_color_offset=1;
2285              }
2286              else{
2287                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2288              }
2289            }
2290            else{
2291              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2292            }
2293    
2294            if ($id eq $query_fid){
2295                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2296                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2297                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2298            }
2299            else{
2300                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2301                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2302            }
2303    
2304            if ( ( $application->session->user) ){
2305                if ( ($application->session->user->login) && ($application->session->user->login eq "arodri")){
2306                    push (@$single_domain,$radio_cell);
2307          }          }
         push(@$data,$single_domain);  
2308      }      }
2309    
2310            my ($ff) = $figfams->families_containing_peg($id);
2311    
2312            foreach my $col (@$scroll_list){
2313                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2314                else { $highlight_color = "#ffffff"; }
2315    
2316                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2317                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2318                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2319                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2320                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2340                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2341                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2342                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2343                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2344                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2345                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2346                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2347                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2348                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2349                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2350            }
2351            push(@$data,$single_domain);
2352        }
2353      if ($count >0 ){      if ($count >0 ){
2354          $content = $data;          $content = $data;
2355      }      }
2356      else{      else{
2357          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2358      }      }
2359        shift(@$dataset);
2360      return ($content);      return ($content);
2361  }  }
2362    
# Line 1949  Line 2366 
2366      foreach my $id (@$ids){      foreach my $id (@$ids){
2367          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2368          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2369          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2370            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2371      }      }
2372      return (%column);      return (%column);
2373  }  }
2374    
2375    sub get_figfam_column{
2376        my ($ids, $fig, $cgi) = @_;
2377        my $column;
2378    
2379        my $figfam_data = &FIG::get_figfams_data();
2380        my $figfams = new FFs($figfam_data);
2381    
2382        foreach my $id (@$ids){
2383            my ($ff) =  $figfams->families_containing_peg($id);
2384            if ($ff){
2385                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2386            }
2387            else{
2388                push (@$column, " ");
2389            }
2390        }
2391    
2392        return $column;
2393    }
2394    
2395  sub get_subsystems_column{  sub get_subsystems_column{
2396      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2397    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2398      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2399      my %column;      my ($column, $ss);
2400      foreach my $id (@$ids){      foreach my $id (@$ids){
2401          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2402          my @subsystems;          my @subsystems;
2403    
2404          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2405              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2406                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2407                  $count++;                  $ss =~ s/_/ /ig;
2408                    push (@subsystems, "-" . $ss);
2409              }              }
2410              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2411              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2412          } else {          } else {
2413              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2414          }          }
2415            push (@$column, $ss->{$id});
2416      }      }
2417      return (%column);  
2418        if ($returnType eq 'hash') { return $ss; }
2419        elsif ($returnType eq 'array') { return $column; }
2420    }
2421    
2422    sub get_lineage_column{
2423        my ($ids, $fig, $cgi) = @_;
2424    
2425        my $lineages = $fig->taxonomy_list();
2426    
2427        foreach my $id (@$ids){
2428            my $genome = $fig->genome_of($id);
2429            if ($lineages->{$genome}){
2430    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2431                push (@$column, $lineages->{$genome});
2432            }
2433            else{
2434                push (@$column, " ");
2435            }
2436        }
2437        return $column;
2438    }
2439    
2440    sub match_color {
2441        my ( $b, $e, $n , $rgb) = @_;
2442        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2443        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2444        my $cov = ( $r - $l + 1 ) / $n;
2445        my $sat = 1 - 10 * $cov / 9;
2446        my $br  = 1;
2447        if ($rgb){
2448            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2449        }
2450        else{
2451            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2452        }
2453    }
2454    
2455    sub hsb2rgb {
2456        my ( $h, $s, $br ) = @_;
2457        $h = 6 * ($h - floor($h));
2458        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2459        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2460        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2461                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2462                                          :               ( 0,      1,      $h - 2 )
2463                                          )
2464                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2465                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2466                                          :               ( 1,      0,      6 - $h )
2467                                          );
2468        ( ( $r * $s + 1 - $s ) * $br,
2469          ( $g * $s + 1 - $s ) * $br,
2470          ( $b * $s + 1 - $s ) * $br
2471        )
2472    }
2473    
2474    sub html2rgb {
2475        my ($hex) = @_;
2476        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2477        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2478                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2479    
2480        my @R = split(//, $r);
2481        my @G = split(//, $g);
2482        my @B = split(//, $b);
2483    
2484        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2485        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2486        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2487    
2488        my $rgb = [$red, $green, $blue];
2489        return $rgb;
2490    
2491    }
2492    
2493    sub rgb2html {
2494        my ( $r, $g, $b ) = @_;
2495        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2496        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2497        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2498        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2499    }
2500    
2501    sub floor {
2502        my $x = $_[0];
2503        defined( $x ) || return undef;
2504        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2505    }
2506    
2507    sub get_function_color_cell{
2508      my ($functions, $fig) = @_;
2509    
2510      # figure out the quantity of each function
2511      my %hash;
2512      foreach my $key (keys %$functions){
2513        my $func = $functions->{$key};
2514        $hash{$func}++;
2515      }
2516    
2517      my %func_colors;
2518      my $count = 1;
2519      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2520        $func_colors{$key}=$count;
2521        $count++;
2522      }
2523    
2524      return \%func_colors;
2525  }  }
2526    
2527  sub get_essentially_identical{  sub get_essentially_identical{
2528      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2529      my $fig = new FIG;      #my $fig = new FIG;
2530    
2531      my %id_list;      my %id_list;
2532      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);
2533    
2534      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2535            if($thing->class eq "IDENTICAL"){
2536                my $rows = $thing->rows;
2537                my $count_identical = 0;
2538                foreach my $row (@$rows) {
2539                    my $id = $row->[0];
2540          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2541              $id_list{$id} = 1;              $id_list{$id} = 1;
2542          }          }
2543      }      }
2544            }
2545        }
2546    
2547    #    foreach my $id (@maps_to) {
2548    #        if (($id ne $fid) && ($fig->function_of($id))) {
2549    #           $id_list{$id} = 1;
2550    #        }
2551    #    }
2552      return(%id_list);      return(%id_list);
2553  }  }
2554    
2555    
2556  sub get_evidence_column{  sub get_evidence_column{
2557      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2558      my $fig = new FIG;      my ($column, $code_attributes);
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
2559    
2560      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      if (! defined $attributes) {
2561            my @attributes_array = $fig->get_attributes($ids);
2562            $attributes = \@attributes_array;
2563        }
2564    
2565        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2566      foreach my $key (@codes){      foreach my $key (@codes){
2567          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2568      }      }
2569    
2570      foreach my $id (@$ids){      foreach my $id (@$ids){
2571          # add evidence code with tool tip          # add evidence code with tool tip
2572          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2573    
2574          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2575              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2576              foreach my $code (@codes) {              foreach my $code (@codes) {
2577                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2578                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2582 
2582                  }                  }
2583                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2584              }              }
         }  
2585    
2586          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2587              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 2589 
2589                                  {                                  {
2590                                      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));
2591          }          }
2592          $column{$id}=$ev_codes;  
2593            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2594            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2595      }      }
2596      return (%column);      return $column;
2597  }  }
2598    
2599  sub get_pfam_column{  sub get_attrb_column{
2600      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');  
2601    
2602      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my ($column, %code_attributes, %attribute_locations);
2603        my $dbmaster = DBMaster->new(-database =>'Ontology',
2604                                     -host     => $WebConfig::DBHOST,
2605                                     -user     => $WebConfig::DBUSER,
2606                                     -password => $WebConfig::DBPWD);
2607    
2608        if ($colName eq "pfam"){
2609            if (! defined $attributes) {
2610                my @attributes_array = $fig->get_attributes($ids);
2611                $attributes = \@attributes_array;
2612            }
2613    
2614            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2615      foreach my $key (@codes){      foreach my $key (@codes){
2616          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2617                if ($name =~ /_/){
2618                    ($name) = ($key->[1]) =~ /(.*?)_/;
2619                }
2620                push (@{$code_attributes{$key->[0]}}, $name);
2621                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2622      }      }
2623    
2624      foreach my $id (@$ids){      foreach my $id (@$ids){
2625          # add evidence code with tool tip              # add pfam code
2626          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2627          my @pfam_codes = "";          my @pfam_codes = "";
2628          my %description_codes;          my %description_codes;
2629    
2630          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2631              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2632              @pfam_codes = ();              @pfam_codes = ();
2633              foreach my $code (@codes) {  
2634                    # get only unique values
2635                    my %saw;
2636                    foreach my $key (@ncodes) {$saw{$key}=1;}
2637                    @ncodes = keys %saw;
2638    
2639                    foreach my $code (@ncodes) {
2640                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2641                  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>";
2642    
2643                        # get the locations for the domain
2644                        my @locs;
2645                        foreach my $part (@{$attribute_location{$id}{$code}}){
2646                            my ($loc) = ($part) =~ /\;(.*)/;
2647                            push (@locs,$loc);
2648                        }
2649                        my %locsaw;
2650                        foreach my $key (@locs) {$locsaw{$key}=1;}
2651                        @locs = keys %locsaw;
2652    
2653                        my $locations = join (", ", @locs);
2654    
2655                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2656                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1] ($locations)");
2657                  }                  }
2658                  else {                  else {
2659                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2660                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2661                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link ($locations)");
                 }  
2662              }              }
2663          }          }
2664    
2665          $column{$id}=join("<br><br>", @pfam_codes);                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2666                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2667                }
2668            }
2669        }
2670        elsif ($colName eq 'cellular_location'){
2671            if (! defined $attributes) {
2672                my @attributes_array = $fig->get_attributes($ids);
2673                $attributes = \@attributes_array;
2674      }      }
     return (%column);  
2675    
2676            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2677            foreach my $key (@codes){
2678                my ($loc) = ($key->[1]) =~ /::(.*)/;
2679                my ($new_loc, @all);
2680                @all = split (//, $loc);
2681                my $count = 0;
2682                foreach my $i (@all){
2683                    if ( ($i eq uc($i)) && ($count > 0) ){
2684                        $new_loc .= " " . $i;
2685                    }
2686                    else{
2687                        $new_loc .= $i;
2688                    }
2689                    $count++;
2690                }
2691                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2692  }  }
2693    
2694  sub get_prefer {          foreach my $id (@$ids){
2695      my ($fid, $db, $all_aliases) = @_;              my (@values, $entry);
2696      my $fig = new FIG;              #@values = (" ");
2697      my $cgi = new CGI;              if (defined @{$code_attributes{$id}}){
2698                    my @ncodes = @{$code_attributes{$id}};
2699                    foreach my $code (@ncodes){
2700                        push (@values, $code->[0] . ", " . $code->[1]);
2701                    }
2702                }
2703                else{
2704                    @values = ("Not available");
2705                }
2706    
2707      foreach my $alias (@{$$all_aliases{$fid}}){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2708          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);  
2709          }          }
2710      }      }
2711      return (" ");      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2712                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2713            if (! defined $attributes) {
2714                my @attributes_array = $fig->get_attributes($ids);
2715                $attributes = \@attributes_array;
2716  }  }
2717    
2718  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2719            foreach my $key (@codes){
2720                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2721            }
2722    
2723  sub color {          foreach my $id (@$ids){
2724      my ($evalue) = @_;              my (@values, $entry);
2725                #@values = (" ");
2726                if (defined @{$code_attributes{$id}}){
2727                    my @ncodes = @{$code_attributes{$id}};
2728                    foreach my $code (@ncodes){
2729                        push (@values, $code);
2730                    }
2731                }
2732                else{
2733                    @values = ("Not available");
2734                }
2735    
2736      my $color;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2737      if ($evalue <= 1e-170){              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         $color = 51;  
2738      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2739      }      }
2740      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2741          $color = 53;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2742                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2743                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2744                ($colName eq 'gc_content') ) {
2745            if (! defined $attributes) {
2746                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2747                $attributes = \@attributes_array;
2748      }      }
2749      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2750          $color = 54;          my $genomes_with_phenotype;
2751            foreach my $attribute (@$attributes){
2752                my $genome = $attribute->[0];
2753                $genomes_with_phenotype->{$genome} = $attribute->[2];
2754      }      }
2755      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
2756          $color = 55;          foreach my $id (@$ids){
2757                my $genome = $fig->genome_of($id);
2758                my @values = (' ');
2759                if (defined $genomes_with_phenotype->{$genome}){
2760                    push (@values, $genomes_with_phenotype->{$genome});
2761      }      }
2762      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2763          $color = 56;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2764      }      }
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
2765      }      }
2766      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2767          $color = 58;      return $column;
2768      }      }
2769      elsif (($evalue <= 10) && ($evalue > 1)){  
2770          $color = 59;  
2771    sub get_db_aliases {
2772        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2773    
2774        my $db_array;
2775        my $all_aliases = $fig->feature_aliases_bulk($ids);
2776        foreach my $id (@$ids){
2777            foreach my $alias (@{$$all_aliases{$id}}){
2778                my $id_db = &Observation::get_database($alias);
2779                next if ( ($id_db ne $db) && ($db ne 'all') );
2780                next if ($aliases->{$id}->{$db});
2781                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2782      }      }
2783      else{          if (!defined( $aliases->{$id}->{$db})){
2784          $color = 60;              $aliases->{$id}->{$db} = " ";
2785            }
2786            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2787            push (@$db_array, $aliases->{$id}->{$db});
2788        }
2789    
2790        if ($returnType eq 'hash') { return $aliases; }
2791        elsif ($returnType eq 'array') { return $db_array; }
2792      }      }
2793    
2794    
2795    
2796    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2797    
2798    sub color {
2799        my ($evalue) = @_;
2800        my $palette = WebColors::get_palette('vitamins');
2801        my $color;
2802        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2803        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2804        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2805        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2806        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2807        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2808        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2809        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2810        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2811        else{        $color = $palette->[9];    }
2812      return ($color);      return ($color);
2813  }  }
2814    
# Line 2152  Line 2828 
2828  }  }
2829    
2830  sub display {  sub display {
2831      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2832    
2833        $taxes = $fig->taxonomy_list();
2834    
2835      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2836      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2837      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2838      my $fig = new FIG;      my $range = $gd_window_size;
2839      my $all_regions = [];      my $all_regions = [];
2840      my $gene_associations={};      my $gene_associations={};
2841    
# Line 2182  Line 2860 
2860      my ($region_start, $region_end);      my ($region_start, $region_end);
2861      if ($beg < $end)      if ($beg < $end)
2862      {      {
2863          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2864          $region_end = $end+4000;          $region_end = $end+ ($range);
2865          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2866      }      }
2867      else      else
2868      {      {
2869          $region_start = $end-4000;          $region_start = $end-($range);
2870          $region_end = $beg+4000;          $region_end = $beg+($range);
2871          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2872          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2873          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2875 
2875    
2876      # call genes in region      # call genes in region
2877      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);
2878        #foreach my $feat (@$target_gene_features){
2879        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2880        #}
2881      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2882      my (@start_array_region);      my (@start_array_region);
2883      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2884    
2885      my %all_genes;      my %all_genes;
2886      my %all_genomes;      my %all_genomes;
2887      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2888            #if ($feature =~ /peg/){
2889      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2890      {          #}
         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;  
2891                  }                  }
2892    
2893                  push (@start_array_region, $offset);      my @selected_sims;
2894    
2895                  $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"){  
2896          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2897          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2898    
2899          # 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");  
   
2900          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2901              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2902                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2903                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2904                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2905                    #my $genome = $fig->genome_of($sim->[1]);
2906                    my $genome = $fig->genome_of($sim->acc);
2907                    #my ($genome1) = ($genome) =~ /(.*)\./;
2908                    my $lineage = $taxes->{$genome};
2909                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2910                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2911                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2912                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2913                            push (@selected_sims, $sim->acc);
2914                      }                      }
2915                  }                  }
2916                  my %saw;              }
2917                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2918            else{
2919                my $simcount = 0;
2920                foreach my $sim (@$sims_array){
2921                    next if ($sim->class ne "SIM");
2922                    next if ($sim->acc !~ /fig\|/);
2923    
2924                    push (@selected_sims, $sim->acc);
2925                    $simcount++;
2926                    last if ($simcount > 4);
2927              }              }
2928          }          }
2929    
2930            my %saw;
2931            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2932    
2933          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2934          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2935              #get the organism genome              #get the organism genome
# Line 2293  Line 2952 
2952              my ($region_start, $region_end);              my ($region_start, $region_end);
2953              if ($beg < $end)              if ($beg < $end)
2954              {              {
2955                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2956                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2957                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2958              }              }
2959              else              else
2960              {              {
2961                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2962                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2963                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2964                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2965                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2975 
2975    
2976      }      }
2977    
2978        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2979      # cluster the genes      # cluster the genes
2980      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2981      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2982        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2983        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2984    
2985      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2986          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2987          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2988          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2989          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2990            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2991            my $lineage = $taxes->{$region_genome};
2992            #my $lineage = $fig->taxonomy_of($region_genome);
2993            #$region_gs .= "Lineage:$lineage";
2994          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2995                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2996                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2998 
2998    
2999          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3000    
3001          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3002                                     'short_title' => "",                                     'short_title' => "",
3003                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
3004                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 3022 
3022    
3023              # get subsystem information              # get subsystem information
3024              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3025              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3026    
3027              my $link;              my $link;
3028              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3029                       "link" => $url_link};                       "link" => $url_link};
3030              push(@$links_list,$link);              push(@$links_list,$link);
3031    
3032              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3033              foreach my $subsystem (@subsystems){              my @subsystems;
3034                foreach my $array (@subs){
3035                    my $subsystem = $$array[0];
3036                    my $ss = $subsystem;
3037                    $ss =~ s/_/ /ig;
3038                    push (@subsystems, $ss);
3039                  my $link;                  my $link;
3040                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3041                           "link_title" => $subsystem};                           "link_title" => $ss};
3042                    push(@$links_list,$link);
3043                }
3044    
3045                if ($fid1 eq $fid){
3046                    my $link;
3047                    $link = {"link_title" => "Annotate this sequence",
3048                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3049                  push(@$links_list,$link);                  push(@$links_list,$link);
3050              }              }
3051    
# Line 2401  Line 3079 
3079                  $prev_stop = $stop;                  $prev_stop = $stop;
3080                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3081    
3082                  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})){
3083                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3084                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3085                  }                  }
3086    
3087                    my $title = $fid1;
3088                    if ($fid1 eq $fid){
3089                        $title = "My query gene: $fid1";
3090                    }
3091    
3092                  $element_hash = {                  $element_hash = {
3093                      "title" => $fid1,                      "title" => $title,
3094                      "start" => $start,                      "start" => $start,
3095                      "end" =>  $stop,                      "end" =>  $stop,
3096                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 3103 
3103                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3104                  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;}
3105                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3106    
3107                    if ($fid1 eq $fid){
3108                        $element_hash = {
3109                            "title" => 'Query',
3110                            "start" => $start,
3111                            "end" =>  $stop,
3112                            "type"=> 'bigbox',
3113                            "color"=> $color,
3114                            "zlayer" => "1"
3115                            };
3116    
3117                        # if there is an overlap, put into second line
3118                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3119                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3120                    }
3121              }              }
3122          }          }
3123          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3124          $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);
3125      }      }
3126      return $gd;      return ($gd, \@selected_sims);
3127  }  }
3128    
3129  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 3193 
3193      }      }
3194    
3195      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3196          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3197              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3198                  foreach $y (@$x) {                  foreach $y (@$x) {
3199                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 3211 
3211      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3212      return ($i < @$xL);      return ($i < @$xL);
3213  }  }
3214    
3215    #############################################
3216    #############################################
3217    package Observation::Commentary;
3218    
3219    use base qw(Observation);
3220    
3221    =head3 display_protein_commentary()
3222    
3223    =cut
3224    
3225    sub display_protein_commentary {
3226        my ($self,$dataset,$mypeg,$fig) = @_;
3227    
3228        my $all_rows = [];
3229        my $content;
3230        #my $fig = new FIG;
3231        my $cgi = new CGI;
3232        my $count = 0;
3233        my $peg_array = [];
3234        my ($evidence_column, $subsystems_column,  %e_identical);
3235    
3236        if (@$dataset != 1){
3237            foreach my $thing (@$dataset){
3238                if ($thing->class eq "SIM"){
3239                    push (@$peg_array, $thing->acc);
3240                }
3241            }
3242            # get the column for the evidence codes
3243            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3244    
3245            # get the column for the subsystems
3246            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3247    
3248            # get essentially identical seqs
3249            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3250        }
3251        else{
3252            push (@$peg_array, @$dataset);
3253        }
3254    
3255        my $selected_sims = [];
3256        foreach my $id (@$peg_array){
3257            last if ($count > 10);
3258            my $row_data = [];
3259            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3260            $org = $fig->org_of($id);
3261            $function = $fig->function_of($id);
3262            if ($mypeg ne $id){
3263                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3264                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3265                if (defined($e_identical{$id})) { $id_cell .= "*";}
3266            }
3267            else{
3268                $function_cell = "&nbsp;&nbsp;$function";
3269                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3270                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3271            }
3272    
3273            push(@$row_data,$id_cell);
3274            push(@$row_data,$org);
3275            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3276            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3277            push(@$row_data, $fig->translation_length($id));
3278            push(@$row_data,$function_cell);
3279            push(@$all_rows,$row_data);
3280            push (@$selected_sims, $id);
3281            $count++;
3282        }
3283    
3284        if ($count >0){
3285            $content = $all_rows;
3286        }
3287        else{
3288            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3289        }
3290        return ($content,$selected_sims);
3291    }
3292    
3293    sub display_protein_history {
3294        my ($self, $id,$fig) = @_;
3295        my $all_rows = [];
3296        my $content;
3297    
3298        my $cgi = new CGI;
3299        my $count = 0;
3300        foreach my $feat ($fig->feature_annotations($id)){
3301            my $row = [];
3302            my $col1 = $feat->[2];
3303            my $col2 = $feat->[1];
3304            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3305            my $text = $feat->[3];
3306    
3307            push (@$row, $col1);
3308            push (@$row, $col2);
3309            push (@$row, $text);
3310            push (@$all_rows, $row);
3311            $count++;
3312        }
3313        if ($count > 0){
3314            $content = $all_rows;
3315        }
3316        else {
3317            $content = "There is no history for this PEG";
3318        }
3319    
3320        return($content);
3321    }
3322    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3