[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.64, Tue Jul 15 20:06:55 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 1083  Line 1149 
1149          my $organism = $fig->org_of($id);          my $organism = $fig->org_of($id);
1150          my $single_domain = [];          my $single_domain = [];
1151          push(@$single_domain,$who);          push(@$single_domain,$who);
1152          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1153          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1154          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1155          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# 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><a href='?page=Annotation&feature=$id'>$id</a></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                my $user = $application->session->user;
2309                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2310                    push (@$single_domain,$radio_cell);
2311          }          }
         push(@$data,$single_domain);  
2312      }      }
2313    
2314            my ($ff) = $figfams->families_containing_peg($id);
2315    
2316            foreach my $col (@$scroll_list){
2317                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2318                else { $highlight_color = "#ffffff"; }
2319    
2320                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2340                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2341                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2342                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2343                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2344                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2345                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2346                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2347                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2348                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2349                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2350                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2351                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2352                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2353                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2354            }
2355            push(@$data,$single_domain);
2356        }
2357      if ($count >0 ){      if ($count >0 ){
2358          $content = $data;          $content = $data;
2359      }      }
2360      else{      else{
2361          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2362      }      }
2363        shift(@$dataset);
2364      return ($content);      return ($content);
2365  }  }
2366    
# Line 1949  Line 2370 
2370      foreach my $id (@$ids){      foreach my $id (@$ids){
2371          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2372          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2373          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2374            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2375      }      }
2376      return (%column);      return (%column);
2377  }  }
2378    
2379    sub get_figfam_column{
2380        my ($ids, $fig, $cgi) = @_;
2381        my $column;
2382    
2383        my $figfam_data = &FIG::get_figfams_data();
2384        my $figfams = new FFs($figfam_data);
2385    
2386        foreach my $id (@$ids){
2387            my ($ff) =  $figfams->families_containing_peg($id);
2388            if ($ff){
2389                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2390            }
2391            else{
2392                push (@$column, " ");
2393            }
2394        }
2395    
2396        return $column;
2397    }
2398    
2399  sub get_subsystems_column{  sub get_subsystems_column{
2400      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2401    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2402      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2403      my %column;      my ($column, $ss);
2404      foreach my $id (@$ids){      foreach my $id (@$ids){
2405          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2406          my @subsystems;          my @subsystems;
2407    
2408          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2409              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2410                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2411                  $count++;                  $ss =~ s/_/ /ig;
2412                    push (@subsystems, "-" . $ss);
2413              }              }
2414              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2415              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2416          } else {          } else {
2417              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2418          }          }
2419            push (@$column, $ss->{$id});
2420      }      }
2421      return (%column);  
2422        if ($returnType eq 'hash') { return $ss; }
2423        elsif ($returnType eq 'array') { return $column; }
2424    }
2425    
2426    sub get_lineage_column{
2427        my ($ids, $fig, $cgi) = @_;
2428    
2429        my $lineages = $fig->taxonomy_list();
2430    
2431        foreach my $id (@$ids){
2432            my $genome = $fig->genome_of($id);
2433            if ($lineages->{$genome}){
2434    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2435                push (@$column, $lineages->{$genome});
2436            }
2437            else{
2438                push (@$column, " ");
2439            }
2440        }
2441        return $column;
2442    }
2443    
2444    sub match_color {
2445        my ( $b, $e, $n , $rgb) = @_;
2446        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2447        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2448        my $cov = ( $r - $l + 1 ) / $n;
2449        my $sat = 1 - 10 * $cov / 9;
2450        my $br  = 1;
2451        if ($rgb){
2452            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2453        }
2454        else{
2455            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2456        }
2457    }
2458    
2459    sub hsb2rgb {
2460        my ( $h, $s, $br ) = @_;
2461        $h = 6 * ($h - floor($h));
2462        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2463        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2464        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2465                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2466                                          :               ( 0,      1,      $h - 2 )
2467                                          )
2468                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2469                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2470                                          :               ( 1,      0,      6 - $h )
2471                                          );
2472        ( ( $r * $s + 1 - $s ) * $br,
2473          ( $g * $s + 1 - $s ) * $br,
2474          ( $b * $s + 1 - $s ) * $br
2475        )
2476    }
2477    
2478    sub html2rgb {
2479        my ($hex) = @_;
2480        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2481        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2482                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2483    
2484        my @R = split(//, $r);
2485        my @G = split(//, $g);
2486        my @B = split(//, $b);
2487    
2488        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2489        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2490        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2491    
2492        my $rgb = [$red, $green, $blue];
2493        return $rgb;
2494    
2495    }
2496    
2497    sub rgb2html {
2498        my ( $r, $g, $b ) = @_;
2499        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2500        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2501        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2502        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2503    }
2504    
2505    sub floor {
2506        my $x = $_[0];
2507        defined( $x ) || return undef;
2508        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2509    }
2510    
2511    sub get_function_color_cell{
2512      my ($functions, $fig) = @_;
2513    
2514      # figure out the quantity of each function
2515      my %hash;
2516      foreach my $key (keys %$functions){
2517        my $func = $functions->{$key};
2518        $hash{$func}++;
2519      }
2520    
2521      my %func_colors;
2522      my $count = 1;
2523      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2524        $func_colors{$key}=$count;
2525        $count++;
2526      }
2527    
2528      return \%func_colors;
2529  }  }
2530    
2531  sub get_essentially_identical{  sub get_essentially_identical{
2532      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2533      my $fig = new FIG;      #my $fig = new FIG;
2534    
2535      my %id_list;      my %id_list;
2536      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);
2537    
2538      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2539            if($thing->class eq "IDENTICAL"){
2540                my $rows = $thing->rows;
2541                my $count_identical = 0;
2542                foreach my $row (@$rows) {
2543                    my $id = $row->[0];
2544          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2545              $id_list{$id} = 1;              $id_list{$id} = 1;
2546          }          }
2547      }      }
2548            }
2549        }
2550    
2551    #    foreach my $id (@maps_to) {
2552    #        if (($id ne $fid) && ($fig->function_of($id))) {
2553    #           $id_list{$id} = 1;
2554    #        }
2555    #    }
2556      return(%id_list);      return(%id_list);
2557  }  }
2558    
2559    
2560  sub get_evidence_column{  sub get_evidence_column{
2561      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2562      my $fig = new FIG;      my ($column, $code_attributes);
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
2563    
2564      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      if (! defined $attributes) {
2565            my @attributes_array = $fig->get_attributes($ids);
2566            $attributes = \@attributes_array;
2567        }
2568    
2569        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2570      foreach my $key (@codes){      foreach my $key (@codes){
2571          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2572      }      }
2573    
2574      foreach my $id (@$ids){      foreach my $id (@$ids){
2575          # add evidence code with tool tip          # add evidence code with tool tip
2576          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2577    
2578          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2579              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2580              foreach my $code (@codes) {              foreach my $code (@codes) {
2581                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2582                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2586 
2586                  }                  }
2587                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2588              }              }
         }  
2589    
2590          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2591              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 2593 
2593                                  {                                  {
2594                                      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));
2595          }          }
2596          $column{$id}=$ev_codes;  
2597            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2598            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2599      }      }
2600      return (%column);      return $column;
2601  }  }
2602    
2603  sub get_pfam_column{  sub get_attrb_column{
2604      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');  
2605    
2606      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my ($column, %code_attributes, %attribute_locations);
2607        my $dbmaster = DBMaster->new(-database =>'Ontology',
2608                                     -host     => $WebConfig::DBHOST,
2609                                     -user     => $WebConfig::DBUSER,
2610                                     -password => $WebConfig::DBPWD);
2611    
2612        if ($colName eq "pfam"){
2613            if (! defined $attributes) {
2614                my @attributes_array = $fig->get_attributes($ids);
2615                $attributes = \@attributes_array;
2616            }
2617    
2618            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2619      foreach my $key (@codes){      foreach my $key (@codes){
2620          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2621                if ($name =~ /_/){
2622                    ($name) = ($key->[1]) =~ /(.*?)_/;
2623                }
2624                push (@{$code_attributes{$key->[0]}}, $name);
2625                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2626      }      }
2627    
2628      foreach my $id (@$ids){      foreach my $id (@$ids){
2629          # add evidence code with tool tip              # add pfam code
2630          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2631          my @pfam_codes = "";          my @pfam_codes = "";
2632          my %description_codes;          my %description_codes;
2633    
2634          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2635              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2636              @pfam_codes = ();              @pfam_codes = ();
2637              foreach my $code (@codes) {  
2638                    # get only unique values
2639                    my %saw;
2640                    foreach my $key (@ncodes) {$saw{$key}=1;}
2641                    @ncodes = keys %saw;
2642    
2643                    foreach my $code (@ncodes) {
2644                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2645                  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>";
2646    
2647                        # get the locations for the domain
2648                        my @locs;
2649                        foreach my $part (@{$attribute_location{$id}{$code}}){
2650                            my ($loc) = ($part) =~ /\;(.*)/;
2651                            push (@locs,$loc);
2652                        }
2653                        my %locsaw;
2654                        foreach my $key (@locs) {$locsaw{$key}=1;}
2655                        @locs = keys %locsaw;
2656    
2657                        my $locations = join (", ", @locs);
2658    
2659                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2660                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1] ($locations)");
2661                  }                  }
2662                  else {                  else {
2663                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2664                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2665                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link ($locations)");
                 }  
2666              }              }
2667          }          }
2668    
2669          $column{$id}=join("<br><br>", @pfam_codes);                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2670                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2671                }
2672            }
2673        }
2674        elsif ($colName eq 'cellular_location'){
2675            if (! defined $attributes) {
2676                my @attributes_array = $fig->get_attributes($ids);
2677                $attributes = \@attributes_array;
2678      }      }
     return (%column);  
2679    
2680            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2681            foreach my $key (@codes){
2682                my ($loc) = ($key->[1]) =~ /::(.*)/;
2683                my ($new_loc, @all);
2684                @all = split (//, $loc);
2685                my $count = 0;
2686                foreach my $i (@all){
2687                    if ( ($i eq uc($i)) && ($count > 0) ){
2688                        $new_loc .= " " . $i;
2689                    }
2690                    else{
2691                        $new_loc .= $i;
2692                    }
2693                    $count++;
2694                }
2695                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2696  }  }
2697    
2698  sub get_prefer {          foreach my $id (@$ids){
2699      my ($fid, $db, $all_aliases) = @_;              my (@values, $entry);
2700      my $fig = new FIG;              #@values = (" ");
2701      my $cgi = new CGI;              if (defined @{$code_attributes{$id}}){
2702                    my @ncodes = @{$code_attributes{$id}};
2703                    foreach my $code (@ncodes){
2704                        push (@values, $code->[0] . ", " . $code->[1]);
2705                    }
2706                }
2707                else{
2708                    @values = ("Not available");
2709                }
2710    
2711      foreach my $alias (@{$$all_aliases{$fid}}){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2712          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);  
2713          }          }
2714      }      }
2715      return (" ");      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2716                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2717            if (! defined $attributes) {
2718                my @attributes_array = $fig->get_attributes($ids);
2719                $attributes = \@attributes_array;
2720  }  }
2721    
2722  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2723            foreach my $key (@codes){
2724                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2725            }
2726    
2727  sub color {          foreach my $id (@$ids){
2728      my ($evalue) = @_;              my (@values, $entry);
2729                #@values = (" ");
2730                if (defined @{$code_attributes{$id}}){
2731                    my @ncodes = @{$code_attributes{$id}};
2732                    foreach my $code (@ncodes){
2733                        push (@values, $code);
2734                    }
2735                }
2736                else{
2737                    @values = ("Not available");
2738                }
2739    
2740      my $color;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2741      if ($evalue <= 1e-170){              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         $color = 51;  
2742      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2743      }      }
2744      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2745          $color = 53;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2746                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2747                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2748                ($colName eq 'gc_content') ) {
2749            if (! defined $attributes) {
2750                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2751                $attributes = \@attributes_array;
2752      }      }
2753      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2754          $color = 54;          my $genomes_with_phenotype;
2755            foreach my $attribute (@$attributes){
2756                my $genome = $attribute->[0];
2757                $genomes_with_phenotype->{$genome} = $attribute->[2];
2758      }      }
2759      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
2760          $color = 55;          foreach my $id (@$ids){
2761                my $genome = $fig->genome_of($id);
2762                my @values = (' ');
2763                if (defined $genomes_with_phenotype->{$genome}){
2764                    push (@values, $genomes_with_phenotype->{$genome});
2765      }      }
2766      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2767          $color = 56;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2768      }      }
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
2769      }      }
2770      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2771          $color = 58;      return $column;
2772      }      }
2773      elsif (($evalue <= 10) && ($evalue > 1)){  
2774          $color = 59;  
2775    sub get_db_aliases {
2776        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2777    
2778        my $db_array;
2779        my $all_aliases = $fig->feature_aliases_bulk($ids);
2780        foreach my $id (@$ids){
2781            foreach my $alias (@{$$all_aliases{$id}}){
2782                my $id_db = &Observation::get_database($alias);
2783                next if ( ($id_db ne $db) && ($db ne 'all') );
2784                next if ($aliases->{$id}->{$db});
2785                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2786      }      }
2787      else{          if (!defined( $aliases->{$id}->{$db})){
2788          $color = 60;              $aliases->{$id}->{$db} = " ";
2789            }
2790            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2791            push (@$db_array, $aliases->{$id}->{$db});
2792        }
2793    
2794        if ($returnType eq 'hash') { return $aliases; }
2795        elsif ($returnType eq 'array') { return $db_array; }
2796      }      }
2797    
2798    
2799    
2800    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2801    
2802    sub color {
2803        my ($evalue) = @_;
2804        my $palette = WebColors::get_palette('vitamins');
2805        my $color;
2806        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2807        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2808        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2809        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2810        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2811        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2812        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2813        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2814        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2815        else{        $color = $palette->[9];    }
2816      return ($color);      return ($color);
2817  }  }
2818    
# Line 2152  Line 2832 
2832  }  }
2833    
2834  sub display {  sub display {
2835      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2836    
2837        $taxes = $fig->taxonomy_list();
2838    
2839      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2840      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2841      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2842      my $fig = new FIG;      my $range = $gd_window_size;
2843      my $all_regions = [];      my $all_regions = [];
2844      my $gene_associations={};      my $gene_associations={};
2845    
# Line 2182  Line 2864 
2864      my ($region_start, $region_end);      my ($region_start, $region_end);
2865      if ($beg < $end)      if ($beg < $end)
2866      {      {
2867          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2868          $region_end = $end+4000;          $region_end = $end+ ($range);
2869          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2870      }      }
2871      else      else
2872      {      {
2873          $region_start = $end-4000;          $region_start = $end-($range);
2874          $region_end = $beg+4000;          $region_end = $beg+($range);
2875          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2876          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2877          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2879 
2879    
2880      # call genes in region      # call genes in region
2881      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);
2882        #foreach my $feat (@$target_gene_features){
2883        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2884        #}
2885      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2886      my (@start_array_region);      my (@start_array_region);
2887      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2888    
2889      my %all_genes;      my %all_genes;
2890      my %all_genomes;      my %all_genomes;
2891      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2892            #if ($feature =~ /peg/){
2893      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2894      {          #}
         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;  
2895                  }                  }
2896    
2897                  push (@start_array_region, $offset);      my @selected_sims;
2898    
2899                  $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"){  
2900          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2901          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2902    
2903          # 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");  
   
2904          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2905              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2906                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2907                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2908                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2909                    #my $genome = $fig->genome_of($sim->[1]);
2910                    my $genome = $fig->genome_of($sim->acc);
2911                    #my ($genome1) = ($genome) =~ /(.*)\./;
2912                    my $lineage = $taxes->{$genome};
2913                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2914                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2915                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2916                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2917                            push (@selected_sims, $sim->acc);
2918                      }                      }
2919                  }                  }
2920                  my %saw;              }
2921                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2922            else{
2923                my $simcount = 0;
2924                foreach my $sim (@$sims_array){
2925                    next if ($sim->class ne "SIM");
2926                    next if ($sim->acc !~ /fig\|/);
2927    
2928                    push (@selected_sims, $sim->acc);
2929                    $simcount++;
2930                    last if ($simcount > 4);
2931              }              }
2932          }          }
2933    
2934            my %saw;
2935            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2936    
2937          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2938          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2939              #get the organism genome              #get the organism genome
# Line 2293  Line 2956 
2956              my ($region_start, $region_end);              my ($region_start, $region_end);
2957              if ($beg < $end)              if ($beg < $end)
2958              {              {
2959                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2960                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2961                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2962              }              }
2963              else              else
2964              {              {
2965                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2966                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2967                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2968                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2969                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2979 
2979    
2980      }      }
2981    
2982        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2983      # cluster the genes      # cluster the genes
2984      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2985      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2986        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2987        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2988    
2989      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2990          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2991          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2992          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2993          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2994            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2995            my $lineage = $taxes->{$region_genome};
2996            #my $lineage = $fig->taxonomy_of($region_genome);
2997            #$region_gs .= "Lineage:$lineage";
2998          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2999                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3000                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 3002 
3002    
3003          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3004    
3005          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3006                                     'short_title' => "",                                     'short_title' => "",
3007                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
3008                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 3026 
3026    
3027              # get subsystem information              # get subsystem information
3028              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3029              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3030    
3031              my $link;              my $link;
3032              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3033                       "link" => $url_link};                       "link" => $url_link};
3034              push(@$links_list,$link);              push(@$links_list,$link);
3035    
3036              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3037              foreach my $subsystem (@subsystems){              my @subsystems;
3038                foreach my $array (@subs){
3039                    my $subsystem = $$array[0];
3040                    my $ss = $subsystem;
3041                    $ss =~ s/_/ /ig;
3042                    push (@subsystems, $ss);
3043                  my $link;                  my $link;
3044                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3045                           "link_title" => $subsystem};                           "link_title" => $ss};
3046                    push(@$links_list,$link);
3047                }
3048    
3049                if ($fid1 eq $fid){
3050                    my $link;
3051                    $link = {"link_title" => "Annotate this sequence",
3052                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3053                  push(@$links_list,$link);                  push(@$links_list,$link);
3054              }              }
3055    
# Line 2401  Line 3083 
3083                  $prev_stop = $stop;                  $prev_stop = $stop;
3084                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3085    
3086                  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})){
3087                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3088                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3089                  }                  }
3090    
3091                    my $title = $fid1;
3092                    if ($fid1 eq $fid){
3093                        $title = "My query gene: $fid1";
3094                    }
3095    
3096                  $element_hash = {                  $element_hash = {
3097                      "title" => $fid1,                      "title" => $title,
3098                      "start" => $start,                      "start" => $start,
3099                      "end" =>  $stop,                      "end" =>  $stop,
3100                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 3107 
3107                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3108                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3109                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3110    
3111                    if ($fid1 eq $fid){
3112                        $element_hash = {
3113                            "title" => 'Query',
3114                            "start" => $start,
3115                            "end" =>  $stop,
3116                            "type"=> 'bigbox',
3117                            "color"=> $color,
3118                            "zlayer" => "1"
3119                            };
3120    
3121                        # if there is an overlap, put into second line
3122                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3123                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3124                    }
3125              }              }
3126          }          }
3127          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3128          $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);
3129      }      }
3130      return $gd;      return ($gd, \@selected_sims);
3131  }  }
3132    
3133  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 3197 
3197      }      }
3198    
3199      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3200          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3201              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3202                  foreach $y (@$x) {                  foreach $y (@$x) {
3203                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 3215 
3215      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3216      return ($i < @$xL);      return ($i < @$xL);
3217  }  }
3218    
3219    #############################################
3220    #############################################
3221    package Observation::Commentary;
3222    
3223    use base qw(Observation);
3224    
3225    =head3 display_protein_commentary()
3226    
3227    =cut
3228    
3229    sub display_protein_commentary {
3230        my ($self,$dataset,$mypeg,$fig) = @_;
3231    
3232        my $all_rows = [];
3233        my $content;
3234        #my $fig = new FIG;
3235        my $cgi = new CGI;
3236        my $count = 0;
3237        my $peg_array = [];
3238        my ($evidence_column, $subsystems_column,  %e_identical);
3239    
3240        if (@$dataset != 1){
3241            foreach my $thing (@$dataset){
3242                if ($thing->class eq "SIM"){
3243                    push (@$peg_array, $thing->acc);
3244                }
3245            }
3246            # get the column for the evidence codes
3247            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3248    
3249            # get the column for the subsystems
3250            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3251    
3252            # get essentially identical seqs
3253            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3254        }
3255        else{
3256            push (@$peg_array, @$dataset);
3257        }
3258    
3259        my $selected_sims = [];
3260        foreach my $id (@$peg_array){
3261            last if ($count > 10);
3262            my $row_data = [];
3263            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3264            $org = $fig->org_of($id);
3265            $function = $fig->function_of($id);
3266            if ($mypeg ne $id){
3267                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3268                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3269                if (defined($e_identical{$id})) { $id_cell .= "*";}
3270            }
3271            else{
3272                $function_cell = "&nbsp;&nbsp;$function";
3273                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3274                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3275            }
3276    
3277            push(@$row_data,$id_cell);
3278            push(@$row_data,$org);
3279            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3280            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3281            push(@$row_data, $fig->translation_length($id));
3282            push(@$row_data,$function_cell);
3283            push(@$all_rows,$row_data);
3284            push (@$selected_sims, $id);
3285            $count++;
3286        }
3287    
3288        if ($count >0){
3289            $content = $all_rows;
3290        }
3291        else{
3292            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3293        }
3294        return ($content,$selected_sims);
3295    }
3296    
3297    sub display_protein_history {
3298        my ($self, $id,$fig) = @_;
3299        my $all_rows = [];
3300        my $content;
3301    
3302        my $cgi = new CGI;
3303        my $count = 0;
3304        foreach my $feat ($fig->feature_annotations($id)){
3305            my $row = [];
3306            my $col1 = $feat->[2];
3307            my $col2 = $feat->[1];
3308            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3309            my $text = $feat->[3];
3310    
3311            push (@$row, $col1);
3312            push (@$row, $col2);
3313            push (@$row, $text);
3314            push (@$all_rows, $row);
3315            $count++;
3316        }
3317        if ($count > 0){
3318            $content = $all_rows;
3319        }
3320        else {
3321            $content = "There is no history for this PEG";
3322        }
3323    
3324        return($content);
3325    }
3326    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3