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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3