[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.62, Wed Jul 9 19:55:31 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3  use lib '/vol/ontologies';  #use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5  use Data::Dumper;  use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10    use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  #use strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 86  Line 88 
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91    =head3 query()
92    
93    The query id
94    
95    =cut
96    
97    sub query {
98        my ($self) = @_;
99        return $self->{query};
100    }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 305  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 360  Line 374 
374    
375  }  }
376    
377  =head3 display_housekeeping  =head
378  This method returns the housekeeping data for a given peg in a table format      provides layer of abstraction between tools and underlying access method to Attribute Server
379    =cut
380    
381    sub get_attributes{
382        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
383        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
384        return @attributes;
385    }
386    
387    =head3 get_sims_objects()
388    
389    This is the B<REAL WORKHORSE> method of this Package.
390    
391  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
392    
393      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
394      my $org_id   = $fig->orgid_of_orgname($org_name);      my ($self,$fid,$fig,$parameters) = @_;
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
     my $function = $fig->function_of($fid);  
     my @aliases  = $fig->feature_aliases($fid);  
     my $taxonomy = $fig->taxonomy_of($org_id);  
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
395    
396      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
397      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
398      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
399      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      # call function that fetches attribute based observations
400      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);      # returns an array of arrays of hashes
401      $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
402    
403      if ( @subsystems ) {      foreach my $dataset (@matched_datasets) {
404          $content .= qq(<tr><td>Subsystems</td><td>);          my $object;
405          foreach my $subsystem ( @subsystems ) {          if ($dataset->{'class'} eq "SIM"){
406              $content .= join(" -- ", @$subsystem) . "<br>\n";              $object = Observation::Sims->new($dataset);
407          }          }
408            push (@$objects, $object);
409      }      }
410        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
411          }          }
412    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
413    
414    =head3 display_housekeeping
415    This method returns the housekeeping data for a given peg in a table format
416    
417          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
418          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
419              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
420          }      my $content = [];
421          $content .= qq(</td></tr></table>\n);      my $row = [];
     }  
422    
423      $content .= qq(</table><p>\n);      my $org_name = $fig->org_of($fid);
424        my $org_id = $fig->genome_of($fid);
425        my $function = $fig->function_of($fid);
426        #my $taxonomy = $fig->taxonomy_of($org_id);
427        my $length = $fig->translation_length($fid);
428    
429        push (@$row, $org_name);
430        push (@$row, $fid);
431        push (@$row, $length);
432        push (@$row, $function);
433    
434        # initialize the table for commentary and annotations
435        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
436        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
437        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
438        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
439        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
440        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
441        #$content .= qq(</table><p>\n);
442    
443        push(@$content, $row);
444    
445      return ($content);      return ($content);
446  }  }
# Line 435  Line 451 
451  =cut  =cut
452    
453  sub get_sims_summary {  sub get_sims_summary {
454      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
455      my %families;      my %families;
456      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
457    
458        foreach my $thing (@$dataset) {
459            my ($id, $evalue);
460            if ($thing =~ /fig\|/){
461                $id = $thing;
462                $evalue = -1;
463            }
464            else{
465                next if ($thing->class ne "SIM");
466                $id      = $thing->acc;
467                $evalue  = $thing->evalue;
468            }
469            next if ($id !~ /fig\|/);
470            next if ($fig->is_deleted_fid($id));
471    
472      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
473          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
474          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
475          my $parent_tax = "Root";          my $parent_tax = "Root";
476          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
477            push (@{$families{figs}{$parent_tax}}, $id);
478            my $level = 2;
479          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
480              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
481                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
482                $families{level}{$tax} = $level;
483              push (@currLineage, $tax);              push (@currLineage, $tax);
484              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
485              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
486                if (defined ($families{evalue}{$tax})){
487                    if ($evalue < $families{evalue}{$tax}){
488                        $families{evalue}{$tax} = $evalue;
489                        $families{color}{$tax} = &get_taxcolor($evalue);
490                    }
491                }
492                else{
493                    $families{evalue}{$tax} = $evalue;
494                    $families{color}{$tax} = &get_taxcolor($evalue);
495                }
496    
497              $parent_tax = $tax;              $parent_tax = $tax;
498                $level++;
499          }          }
500      }      }
501    
# Line 462  Line 506 
506          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
507          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
508      }      }
509      return (\%families);  
510        return \%families;
511  }  }
512    
513  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 518 
518    
519  =cut  =cut
520    
521    sub get_taxcolor{
522        my ($evalue) = @_;
523        my $color;
524        if ($evalue == -1){            $color = "black";      }
525        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
526        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
527        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
528        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
529        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
530        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
531        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
532        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
533        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
534        else{        $color = "#6666FF";    }
535        return ($color);
536    }
537    
538    
539  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
540    
541      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
542      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
543    
544      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546          my @parts = split("::",$key);          my @parts = split("::",$key);
547          my $class = $parts[0];          my $class = $parts[0];
548            my $name = $parts[1];
549            #next if (($class eq "PFAM") && ($name !~ /interpro/));
550    
551          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
552              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 555 
555                  my $from = $2;                  my $from = $2;
556                  my $to = $3;                  my $to = $3;
557                  my $evalue;                  my $evalue;
558                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
559                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
560                      my $part1 = $2/100;                      my $part1 = $2/100;
561                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
562                  }                  }
563                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
564                        $evalue=$raw_evalue;
565                    }
566                  else{                  else{
567                      $evalue = "0.0";                      $evalue = "0.0";
568                  }                  }
# Line 520  Line 585 
585    
586  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
587    
588      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
589      my $fig = new FIG;      #my $fig = new FIG;
590    
591      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
592    
# Line 531  Line 596 
596                     };                     };
597    
598      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
599          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
600          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
601          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 607 
607                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
608                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
609                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
610              }              }
611              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
612                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 645 
645  =cut  =cut
646    
647  sub get_pdb_observations{  sub get_pdb_observations{
648      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
649    
650      my $fig = new FIG;      #my $fig = new FIG;
651    
652      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
653          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
654          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
655          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 642  Line 703 
703  =cut  =cut
704    
705  sub get_sims_observations{  sub get_sims_observations{
706        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
707    
708      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $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) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
1752    
1753      my $organism = $self->organism;      # declare variables
1754        my $window_size = $gd->window_size;
1755        my $peg = $thing->acc;
1756        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      my $evalue = $self->evalue;  
1872        # 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      my %e_identical = &get_essentially_identical($query_fid);      # get the column for organism's pathogenicity
2127      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2128    
2129        # get the column for organism's pathogenicity host
2130        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 $iden    = $thing->identity;          my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
2230    
2231          # checkbox column          # checkbox cell
2232            my ($box_cell,$tax, $radio_cell);
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};
2279              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}          }
2280              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}          else{
2281              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2282              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}          }
2283              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}          my $function_cell;
2284              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}          if ($current_function){
2285              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}            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                if ( ($application->session->user->login) && ($application->session->user->login eq "arodri")){
2309                    push (@$single_domain,$radio_cell);
2310          }          }
         push(@$data,$single_domain);  
2311      }      }
2312    
2313            my ($ff) = $figfams->families_containing_peg($id);
2314    
2315            foreach my $col (@$scroll_list){
2316                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2317                else { $highlight_color = "#ffffff"; }
2318    
2319                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2320                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2340                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2341                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2342                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2343                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2344                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2345                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2346                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2347                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2348                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2349                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2350                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2351                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2352                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2353            }
2354            push(@$data,$single_domain);
2355        }
2356      if ($count >0 ){      if ($count >0 ){
2357          $content = $data;          $content = $data;
2358      }      }
2359      else{      else{
2360          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2361      }      }
2362        shift(@$dataset);
2363      return ($content);      return ($content);
2364  }  }
2365    
# Line 1949  Line 2369 
2369      foreach my $id (@$ids){      foreach my $id (@$ids){
2370          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2371          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2372          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2373            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2374      }      }
2375      return (%column);      return (%column);
2376  }  }
2377    
2378    sub get_figfam_column{
2379        my ($ids, $fig, $cgi) = @_;
2380        my $column;
2381    
2382        my $figfam_data = &FIG::get_figfams_data();
2383        my $figfams = new FFs($figfam_data);
2384    
2385        foreach my $id (@$ids){
2386            my ($ff) =  $figfams->families_containing_peg($id);
2387            if ($ff){
2388                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2389            }
2390            else{
2391                push (@$column, " ");
2392            }
2393        }
2394    
2395        return $column;
2396    }
2397    
2398  sub get_subsystems_column{  sub get_subsystems_column{
2399      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2400    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2401      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2402      my %column;      my ($column, $ss);
2403      foreach my $id (@$ids){      foreach my $id (@$ids){
2404          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2405          my @subsystems;          my @subsystems;
2406    
2407          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2408              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2409                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2410                  $count++;                  $ss =~ s/_/ /ig;
2411                    push (@subsystems, "-" . $ss);
2412              }              }
2413              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2414              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2415          } else {          } else {
2416              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2417          }          }
2418            push (@$column, $ss->{$id});
2419      }      }
2420      return (%column);  
2421        if ($returnType eq 'hash') { return $ss; }
2422        elsif ($returnType eq 'array') { return $column; }
2423    }
2424    
2425    sub get_lineage_column{
2426        my ($ids, $fig, $cgi) = @_;
2427    
2428        my $lineages = $fig->taxonomy_list();
2429    
2430        foreach my $id (@$ids){
2431            my $genome = $fig->genome_of($id);
2432            if ($lineages->{$genome}){
2433    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2434                push (@$column, $lineages->{$genome});
2435            }
2436            else{
2437                push (@$column, " ");
2438            }
2439        }
2440        return $column;
2441    }
2442    
2443    sub match_color {
2444        my ( $b, $e, $n , $rgb) = @_;
2445        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2446        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2447        my $cov = ( $r - $l + 1 ) / $n;
2448        my $sat = 1 - 10 * $cov / 9;
2449        my $br  = 1;
2450        if ($rgb){
2451            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2452        }
2453        else{
2454            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2455        }
2456    }
2457    
2458    sub hsb2rgb {
2459        my ( $h, $s, $br ) = @_;
2460        $h = 6 * ($h - floor($h));
2461        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2462        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2463        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2464                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2465                                          :               ( 0,      1,      $h - 2 )
2466                                          )
2467                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2468                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2469                                          :               ( 1,      0,      6 - $h )
2470                                          );
2471        ( ( $r * $s + 1 - $s ) * $br,
2472          ( $g * $s + 1 - $s ) * $br,
2473          ( $b * $s + 1 - $s ) * $br
2474        )
2475    }
2476    
2477    sub html2rgb {
2478        my ($hex) = @_;
2479        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2480        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2481                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2482    
2483        my @R = split(//, $r);
2484        my @G = split(//, $g);
2485        my @B = split(//, $b);
2486    
2487        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2488        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2489        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2490    
2491        my $rgb = [$red, $green, $blue];
2492        return $rgb;
2493    
2494    }
2495    
2496    sub rgb2html {
2497        my ( $r, $g, $b ) = @_;
2498        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2499        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2500        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2501        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2502    }
2503    
2504    sub floor {
2505        my $x = $_[0];
2506        defined( $x ) || return undef;
2507        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2508    }
2509    
2510    sub get_function_color_cell{
2511      my ($functions, $fig) = @_;
2512    
2513      # figure out the quantity of each function
2514      my %hash;
2515      foreach my $key (keys %$functions){
2516        my $func = $functions->{$key};
2517        $hash{$func}++;
2518      }
2519    
2520      my %func_colors;
2521      my $count = 1;
2522      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2523        $func_colors{$key}=$count;
2524        $count++;
2525      }
2526    
2527      return \%func_colors;
2528  }  }
2529    
2530  sub get_essentially_identical{  sub get_essentially_identical{
2531      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2532      my $fig = new FIG;      #my $fig = new FIG;
2533    
2534      my %id_list;      my %id_list;
2535      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);
2536    
2537      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2538            if($thing->class eq "IDENTICAL"){
2539                my $rows = $thing->rows;
2540                my $count_identical = 0;
2541                foreach my $row (@$rows) {
2542                    my $id = $row->[0];
2543          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2544              $id_list{$id} = 1;              $id_list{$id} = 1;
2545          }          }
2546      }      }
2547            }
2548        }
2549    
2550    #    foreach my $id (@maps_to) {
2551    #        if (($id ne $fid) && ($fig->function_of($id))) {
2552    #           $id_list{$id} = 1;
2553    #        }
2554    #    }
2555      return(%id_list);      return(%id_list);
2556  }  }
2557    
2558    
2559  sub get_evidence_column{  sub get_evidence_column{
2560      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2561      my $fig = new FIG;      my ($column, $code_attributes);
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
2562    
2563      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      if (! defined $attributes) {
2564            my @attributes_array = $fig->get_attributes($ids);
2565            $attributes = \@attributes_array;
2566        }
2567    
2568        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2569      foreach my $key (@codes){      foreach my $key (@codes){
2570          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2571      }      }
2572    
2573      foreach my $id (@$ids){      foreach my $id (@$ids){
2574          # add evidence code with tool tip          # add evidence code with tool tip
2575          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2576    
2577          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2578              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2579              foreach my $code (@codes) {              foreach my $code (@codes) {
2580                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2581                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2585 
2585                  }                  }
2586                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2587              }              }
         }  
2588    
2589          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2590              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 2592 
2592                                  {                                  {
2593                                      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));
2594          }          }
2595          $column{$id}=$ev_codes;  
2596            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2597            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2598      }      }
2599      return (%column);      return $column;
2600  }  }
2601    
2602  sub get_pfam_column{  sub get_attrb_column{
2603      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');  
2604    
2605      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my ($column, %code_attributes, %attribute_locations);
2606        my $dbmaster = DBMaster->new(-database =>'Ontology',
2607                                     -host     => $WebConfig::DBHOST,
2608                                     -user     => $WebConfig::DBUSER,
2609                                     -password => $WebConfig::DBPWD);
2610    
2611        if ($colName eq "pfam"){
2612            if (! defined $attributes) {
2613                my @attributes_array = $fig->get_attributes($ids);
2614                $attributes = \@attributes_array;
2615            }
2616    
2617            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2618      foreach my $key (@codes){      foreach my $key (@codes){
2619          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2620                if ($name =~ /_/){
2621                    ($name) = ($key->[1]) =~ /(.*?)_/;
2622                }
2623                push (@{$code_attributes{$key->[0]}}, $name);
2624                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2625      }      }
2626    
2627      foreach my $id (@$ids){      foreach my $id (@$ids){
2628          # add evidence code with tool tip              # add pfam code
2629          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2630          my @pfam_codes = "";          my @pfam_codes = "";
2631          my %description_codes;          my %description_codes;
2632    
2633          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2634              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2635              @pfam_codes = ();              @pfam_codes = ();
2636              foreach my $code (@codes) {  
2637                    # get only unique values
2638                    my %saw;
2639                    foreach my $key (@ncodes) {$saw{$key}=1;}
2640                    @ncodes = keys %saw;
2641    
2642                    foreach my $code (@ncodes) {
2643                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2644                  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>";
2645    
2646                        # get the locations for the domain
2647                        my @locs;
2648                        foreach my $part (@{$attribute_location{$id}{$code}}){
2649                            my ($loc) = ($part) =~ /\;(.*)/;
2650                            push (@locs,$loc);
2651                        }
2652                        my %locsaw;
2653                        foreach my $key (@locs) {$locsaw{$key}=1;}
2654                        @locs = keys %locsaw;
2655    
2656                        my $locations = join (", ", @locs);
2657    
2658                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2659                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1] ($locations)");
2660                  }                  }
2661                  else {                  else {
2662                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2663                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2664                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link ($locations)");
                 }  
2665              }              }
2666          }          }
2667    
2668          $column{$id}=join("<br><br>", @pfam_codes);                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2669                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2670                }
2671            }
2672        }
2673        elsif ($colName eq 'cellular_location'){
2674            if (! defined $attributes) {
2675                my @attributes_array = $fig->get_attributes($ids);
2676                $attributes = \@attributes_array;
2677      }      }
     return (%column);  
2678    
2679            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2680            foreach my $key (@codes){
2681                my ($loc) = ($key->[1]) =~ /::(.*)/;
2682                my ($new_loc, @all);
2683                @all = split (//, $loc);
2684                my $count = 0;
2685                foreach my $i (@all){
2686                    if ( ($i eq uc($i)) && ($count > 0) ){
2687                        $new_loc .= " " . $i;
2688                    }
2689                    else{
2690                        $new_loc .= $i;
2691                    }
2692                    $count++;
2693                }
2694                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2695  }  }
2696    
2697  sub get_prefer {          foreach my $id (@$ids){
2698      my ($fid, $db, $all_aliases) = @_;              my (@values, $entry);
2699      my $fig = new FIG;              #@values = (" ");
2700      my $cgi = new CGI;              if (defined @{$code_attributes{$id}}){
2701                    my @ncodes = @{$code_attributes{$id}};
2702                    foreach my $code (@ncodes){
2703                        push (@values, $code->[0] . ", " . $code->[1]);
2704                    }
2705                }
2706                else{
2707                    @values = ("Not available");
2708                }
2709    
2710      foreach my $alias (@{$$all_aliases{$fid}}){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2711          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);  
2712          }          }
2713      }      }
2714      return (" ");      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2715                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2716            if (! defined $attributes) {
2717                my @attributes_array = $fig->get_attributes($ids);
2718                $attributes = \@attributes_array;
2719  }  }
2720    
2721  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2722            foreach my $key (@codes){
2723                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2724            }
2725    
2726  sub color {          foreach my $id (@$ids){
2727      my ($evalue) = @_;              my (@values, $entry);
2728                #@values = (" ");
2729                if (defined @{$code_attributes{$id}}){
2730                    my @ncodes = @{$code_attributes{$id}};
2731                    foreach my $code (@ncodes){
2732                        push (@values, $code);
2733                    }
2734                }
2735                else{
2736                    @values = ("Not available");
2737                }
2738    
2739      my $color;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2740      if ($evalue <= 1e-170){              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         $color = 51;  
2741      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2742      }      }
2743      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2744          $color = 53;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2745                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2746                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2747                ($colName eq 'gc_content') ) {
2748            if (! defined $attributes) {
2749                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2750                $attributes = \@attributes_array;
2751      }      }
2752      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2753          $color = 54;          my $genomes_with_phenotype;
2754            foreach my $attribute (@$attributes){
2755                my $genome = $attribute->[0];
2756                $genomes_with_phenotype->{$genome} = $attribute->[2];
2757      }      }
2758      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
2759          $color = 55;          foreach my $id (@$ids){
2760                my $genome = $fig->genome_of($id);
2761                my @values = (' ');
2762                if (defined $genomes_with_phenotype->{$genome}){
2763                    push (@values, $genomes_with_phenotype->{$genome});
2764      }      }
2765      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2766          $color = 56;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2767      }      }
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
2768      }      }
2769      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2770          $color = 58;      return $column;
2771      }      }
2772      elsif (($evalue <= 10) && ($evalue > 1)){  
2773          $color = 59;  
2774    sub get_db_aliases {
2775        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2776    
2777        my $db_array;
2778        my $all_aliases = $fig->feature_aliases_bulk($ids);
2779        foreach my $id (@$ids){
2780            foreach my $alias (@{$$all_aliases{$id}}){
2781                my $id_db = &Observation::get_database($alias);
2782                next if ( ($id_db ne $db) && ($db ne 'all') );
2783                next if ($aliases->{$id}->{$db});
2784                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2785      }      }
2786      else{          if (!defined( $aliases->{$id}->{$db})){
2787          $color = 60;              $aliases->{$id}->{$db} = " ";
2788            }
2789            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2790            push (@$db_array, $aliases->{$id}->{$db});
2791        }
2792    
2793        if ($returnType eq 'hash') { return $aliases; }
2794        elsif ($returnType eq 'array') { return $db_array; }
2795      }      }
2796    
2797    
2798    
2799    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2800    
2801    sub color {
2802        my ($evalue) = @_;
2803        my $palette = WebColors::get_palette('vitamins');
2804        my $color;
2805        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2806        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2807        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2808        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2809        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2810        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2811        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2812        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2813        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2814        else{        $color = $palette->[9];    }
2815      return ($color);      return ($color);
2816  }  }
2817    
# Line 2152  Line 2831 
2831  }  }
2832    
2833  sub display {  sub display {
2834      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2835    
2836        $taxes = $fig->taxonomy_list();
2837    
2838      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2839      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2840      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2841      my $fig = new FIG;      my $range = $gd_window_size;
2842      my $all_regions = [];      my $all_regions = [];
2843      my $gene_associations={};      my $gene_associations={};
2844    
# Line 2182  Line 2863 
2863      my ($region_start, $region_end);      my ($region_start, $region_end);
2864      if ($beg < $end)      if ($beg < $end)
2865      {      {
2866          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2867          $region_end = $end+4000;          $region_end = $end+ ($range);
2868          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2869      }      }
2870      else      else
2871      {      {
2872          $region_start = $end-4000;          $region_start = $end-($range);
2873          $region_end = $beg+4000;          $region_end = $beg+($range);
2874          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2875          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2876          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2878 
2878    
2879      # call genes in region      # call genes in region
2880      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);
2881        #foreach my $feat (@$target_gene_features){
2882        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2883        #}
2884      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2885      my (@start_array_region);      my (@start_array_region);
2886      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2887    
2888      my %all_genes;      my %all_genes;
2889      my %all_genomes;      my %all_genomes;
2890      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2891            #if ($feature =~ /peg/){
2892      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2893      {          #}
         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;  
2894                  }                  }
2895    
2896                  push (@start_array_region, $offset);      my @selected_sims;
2897    
2898                  $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"){  
2899          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2900          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2901    
2902          # 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");  
   
2903          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2904              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2905                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2906                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2907                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2908                    #my $genome = $fig->genome_of($sim->[1]);
2909                    my $genome = $fig->genome_of($sim->acc);
2910                    #my ($genome1) = ($genome) =~ /(.*)\./;
2911                    my $lineage = $taxes->{$genome};
2912                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2913                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2914                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2915                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2916                            push (@selected_sims, $sim->acc);
2917                      }                      }
2918                  }                  }
2919                  my %saw;              }
2920                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2921            else{
2922                my $simcount = 0;
2923                foreach my $sim (@$sims_array){
2924                    next if ($sim->class ne "SIM");
2925                    next if ($sim->acc !~ /fig\|/);
2926    
2927                    push (@selected_sims, $sim->acc);
2928                    $simcount++;
2929                    last if ($simcount > 4);
2930              }              }
2931          }          }
2932    
2933            my %saw;
2934            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2935    
2936          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2937          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2938              #get the organism genome              #get the organism genome
# Line 2293  Line 2955 
2955              my ($region_start, $region_end);              my ($region_start, $region_end);
2956              if ($beg < $end)              if ($beg < $end)
2957              {              {
2958                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2959                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2960                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2961              }              }
2962              else              else
2963              {              {
2964                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2965                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2966                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2967                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2968                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2978 
2978    
2979      }      }
2980    
2981        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2982      # cluster the genes      # cluster the genes
2983      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2984      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2985        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2986        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2987    
2988      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2989          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2990          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2991          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2992          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2993            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2994            my $lineage = $taxes->{$region_genome};
2995            #my $lineage = $fig->taxonomy_of($region_genome);
2996            #$region_gs .= "Lineage:$lineage";
2997          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2998                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2999                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 3001 
3001    
3002          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3003    
3004          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3005                                     'short_title' => "",                                     'short_title' => "",
3006                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
3007                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 3025 
3025    
3026              # get subsystem information              # get subsystem information
3027              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3028              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3029    
3030              my $link;              my $link;
3031              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3032                       "link" => $url_link};                       "link" => $url_link};
3033              push(@$links_list,$link);              push(@$links_list,$link);
3034    
3035              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3036              foreach my $subsystem (@subsystems){              my @subsystems;
3037                foreach my $array (@subs){
3038                    my $subsystem = $$array[0];
3039                    my $ss = $subsystem;
3040                    $ss =~ s/_/ /ig;
3041                    push (@subsystems, $ss);
3042                  my $link;                  my $link;
3043                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3044                           "link_title" => $subsystem};                           "link_title" => $ss};
3045                    push(@$links_list,$link);
3046                }
3047    
3048                if ($fid1 eq $fid){
3049                    my $link;
3050                    $link = {"link_title" => "Annotate this sequence",
3051                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3052                  push(@$links_list,$link);                  push(@$links_list,$link);
3053              }              }
3054    
# Line 2401  Line 3082 
3082                  $prev_stop = $stop;                  $prev_stop = $stop;
3083                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3084    
3085                  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})){
3086                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3087                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3088                  }                  }
3089    
3090                    my $title = $fid1;
3091                    if ($fid1 eq $fid){
3092                        $title = "My query gene: $fid1";
3093                    }
3094    
3095                  $element_hash = {                  $element_hash = {
3096                      "title" => $fid1,                      "title" => $title,
3097                      "start" => $start,                      "start" => $start,
3098                      "end" =>  $stop,                      "end" =>  $stop,
3099                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 3106 
3106                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3107                  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;}
3108                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3109    
3110                    if ($fid1 eq $fid){
3111                        $element_hash = {
3112                            "title" => 'Query',
3113                            "start" => $start,
3114                            "end" =>  $stop,
3115                            "type"=> 'bigbox',
3116                            "color"=> $color,
3117                            "zlayer" => "1"
3118                            };
3119    
3120                        # if there is an overlap, put into second line
3121                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3122                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3123                    }
3124              }              }
3125          }          }
3126          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3127          $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);
3128      }      }
3129      return $gd;      return ($gd, \@selected_sims);
3130  }  }
3131    
3132  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 3196 
3196      }      }
3197    
3198      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3199          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3200              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3201                  foreach $y (@$x) {                  foreach $y (@$x) {
3202                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 3214 
3214      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3215      return ($i < @$xL);      return ($i < @$xL);
3216  }  }
3217    
3218    #############################################
3219    #############################################
3220    package Observation::Commentary;
3221    
3222    use base qw(Observation);
3223    
3224    =head3 display_protein_commentary()
3225    
3226    =cut
3227    
3228    sub display_protein_commentary {
3229        my ($self,$dataset,$mypeg,$fig) = @_;
3230    
3231        my $all_rows = [];
3232        my $content;
3233        #my $fig = new FIG;
3234        my $cgi = new CGI;
3235        my $count = 0;
3236        my $peg_array = [];
3237        my ($evidence_column, $subsystems_column,  %e_identical);
3238    
3239        if (@$dataset != 1){
3240            foreach my $thing (@$dataset){
3241                if ($thing->class eq "SIM"){
3242                    push (@$peg_array, $thing->acc);
3243                }
3244            }
3245            # get the column for the evidence codes
3246            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3247    
3248            # get the column for the subsystems
3249            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3250    
3251            # get essentially identical seqs
3252            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3253        }
3254        else{
3255            push (@$peg_array, @$dataset);
3256        }
3257    
3258        my $selected_sims = [];
3259        foreach my $id (@$peg_array){
3260            last if ($count > 10);
3261            my $row_data = [];
3262            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3263            $org = $fig->org_of($id);
3264            $function = $fig->function_of($id);
3265            if ($mypeg ne $id){
3266                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3267                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3268                if (defined($e_identical{$id})) { $id_cell .= "*";}
3269            }
3270            else{
3271                $function_cell = "&nbsp;&nbsp;$function";
3272                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3273                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3274            }
3275    
3276            push(@$row_data,$id_cell);
3277            push(@$row_data,$org);
3278            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3279            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3280            push(@$row_data, $fig->translation_length($id));
3281            push(@$row_data,$function_cell);
3282            push(@$all_rows,$row_data);
3283            push (@$selected_sims, $id);
3284            $count++;
3285        }
3286    
3287        if ($count >0){
3288            $content = $all_rows;
3289        }
3290        else{
3291            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3292        }
3293        return ($content,$selected_sims);
3294    }
3295    
3296    sub display_protein_history {
3297        my ($self, $id,$fig) = @_;
3298        my $all_rows = [];
3299        my $content;
3300    
3301        my $cgi = new CGI;
3302        my $count = 0;
3303        foreach my $feat ($fig->feature_annotations($id)){
3304            my $row = [];
3305            my $col1 = $feat->[2];
3306            my $col2 = $feat->[1];
3307            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3308            my $text = $feat->[3];
3309    
3310            push (@$row, $col1);
3311            push (@$row, $col2);
3312            push (@$row, $text);
3313            push (@$all_rows, $row);
3314            $count++;
3315        }
3316        if ($count > 0){
3317            $content = $all_rows;
3318        }
3319        else {
3320            $content = "There is no history for this PEG";
3321        }
3322    
3323        return($content);
3324    }
3325    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3