[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.32, Tue Aug 21 22:45:54 2007 UTC revision 1.80, Mon Jun 29 16:49:01 2009 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;
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 LWP::Simple;
15  #use strict;  #use strict;
16  #use warnings;  #use warnings;
17  use HTML;  use HTML;
18    use FFs;
19    
20  1;  1;
21    
 # $Id$  
   
22  =head1 NAME  =head1 NAME
23    
24  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 85  Line 89 
89    return $self->{acc};    return $self->{acc};
90  }  }
91    
92    =head3 query()
93    
94    The query id
95    
96    =cut
97    
98    sub query {
99        my ($self) = @_;
100        return $self->{query};
101    }
102    
103    
104  =head3 class()  =head3 class()
105    
106  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 304  Line 320 
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
327    
328      # call function that fetches attribute based observations      # call function that fetches attribute based observations
329      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 319  Line 334 
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
337          $domain_classes{'CDD'} = 1;          #$domain_classes{'CDD'} = 1;
338          #get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
339          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
343          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
345      }      }
346    
347      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 333  Line 349 
349          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
350              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
351          }          }
352          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
353              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
356              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
357          }          }
358          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
359              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
360          }          }
361          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
362              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
363          }          }
364          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
365              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
366          }          }
367          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
368              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
369          }          }
370    
# Line 359  Line 375 
375    
376  }  }
377    
378  =head3 display_housekeeping  =head3 get_attributes
379  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
380    =cut
381    
382    sub get_attributes{
383        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
384        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
385        return @attributes;
386    }
387    
388    =head3 get_sims_objects()
389    
390    This is the B<REAL WORKHORSE> method of this Package.
391    
392  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
393    
394      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
395      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);  
396    
397      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
398      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
399      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
400      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      # call function that fetches attribute based observations
401      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);      # returns an array of arrays of hashes
402      $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);  
     }  
403    
404      if ( @subsystems ) {      foreach my $dataset (@matched_datasets) {
405          $content .= qq(<tr><td>Subsystems</td><td>);          my $object;
406          foreach my $subsystem ( @subsystems ) {          if ($dataset->{'class'} eq "SIM"){
407              $content .= join(" -- ", @$subsystem) . "<br>\n";              $object = Observation::Sims->new($dataset);
408          }          }
409            push (@$objects, $object);
410      }      }
411        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
412          }          }
413    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
414    
415    =head3 display_housekeeping
416    This method returns the housekeeping data for a given peg in a table format
417    
418          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
419          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
420              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
421          }      my $content = [];
422          $content .= qq(</td></tr></table>\n);      my $row = [];
423    
424        my $org_name = "Data not available";
425        if ( $fig->org_of($fid)){
426            $org_name = $fig->org_of($fid);
427      }      }
428        my $org_id = $fig->genome_of($fid);
429        my $function = $fig->function_of($fid);
430        #my $taxonomy = $fig->taxonomy_of($org_id);
431        my $length = $fig->translation_length($fid);
432    
433        push (@$row, $org_name);
434        push (@$row, $fid);
435        push (@$row, $length);
436        push (@$row, $function);
437    
438        # initialize the table for commentary and annotations
439        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
440        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
441        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
442        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
443        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
444        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
445        #$content .= qq(</table><p>\n);
446    
447      $content .= qq(</table><p>\n);      push(@$content, $row);
448    
449      return ($content);      return ($content);
450  }  }
# Line 434  Line 455 
455  =cut  =cut
456    
457  sub get_sims_summary {  sub get_sims_summary {
458      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
459      my %families;      my %families;
460      my @sims= $fig->nsims($fid,20000,10,"all");      my $taxes = $fig->taxonomy_list();
461    
462        foreach my $thing (@$dataset) {
463            my ($id, $evalue);
464            if ($thing =~ /fig\|/){
465                $id = $thing;
466                $evalue = -1;
467            }
468            else{
469                next if ($thing->class ne "SIM");
470                $id      = $thing->acc;
471                $evalue  = $thing->evalue;
472            }
473            next if ($id !~ /fig\|/);
474            next if ($fig->is_deleted_fid($id));
475    
476      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
477          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
478          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
479          my $parent_tax = "Root";          my $parent_tax = "Root";
480          foreach my $tax (split(/\; /, $taxonomy)){          my @currLineage = ($parent_tax);
481              push (@{$families{children}{$parent_tax}}, $tax);          push (@{$families{figs}{$parent_tax}}, $id);
482            my $level = 2;
483    
484            foreach my $tax (split(/\; /, $taxonomy),$id){
485              next if ($tax eq $parent_tax);
486              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
487              push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
488              $families{level}{$tax} = $level;
489              push (@currLineage, $tax);
490              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
491              $families{lineage}{$tax} = join(";", @currLineage);
492              if (defined ($families{evalue}{$tax})){
493                if ($evalue < $families{evalue}{$tax}){
494                  $families{evalue}{$tax} = $evalue;
495                  $families{color}{$tax} = &get_taxcolor($evalue);
496                }
497              }
498              else{
499                $families{evalue}{$tax} = $evalue;
500                $families{color}{$tax} = &get_taxcolor($evalue);
501              }
502    
503              $parent_tax = $tax;              $parent_tax = $tax;
504              $level++;
505          }          }
506      }      }
507    
# Line 458  Line 512 
512          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
513          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
514      }      }
515      return (\%families);  
516        return \%families;
517  }  }
518    
519  =head1 Internal Methods  =head1 Internal Methods
# Line 469  Line 524 
524    
525  =cut  =cut
526    
527  sub get_attribute_based_domain_observations{  sub get_taxcolor{
528        my ($evalue) = @_;
529        my $color;
530        if ($evalue == -1){            $color = "black";      }
531        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
532        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
533        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
534        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
535        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
536        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
537        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
538        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
539        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
540        else{        $color = "#6666FF";    }
541        return ($color);
542    }
543    
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);  
544    
545      my $fig = new FIG;  sub get_attribute_based_domain_observations{
546    
547        # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
548        my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
550      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
551          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $class = $parts[0];          my $class = $parts[0];
554            my $name = $parts[1];
555            next if ($seen->{$name});
556            $seen->{$name}++;
557            #next if (($class eq "PFAM") && ($name !~ /interpro/));
558    
559          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
560              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 489  Line 563 
563                  my $from = $2;                  my $from = $2;
564                  my $to = $3;                  my $to = $3;
565                  my $evalue;                  my $evalue;
566                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
567                        my $part2 = 1000 - $1;
568                        my $part1 = $2/100;
569                        $evalue = $part1."e-".$part2;
570                    }
571                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
572                        #$evalue=$raw_evalue;
573                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
574                      my $part1 = $2/100;                      my $part1 = $2/100;
575                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
576    
577                  }                  }
578                  else{                  else{
579                      $evalue = "0.0";                      $evalue = "0.0";
# Line 516  Line 597 
597    
598  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
599    
600      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
601      my $fig = new FIG;      #my $fig = new FIG;
602    
603      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
604    
# Line 527  Line 608 
608                     };                     };
609    
610      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
611          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
612          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
613          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 539  Line 619 
619                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
620                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
621                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
622              }              }
623              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
624                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 578  Line 657 
657  =cut  =cut
658    
659  sub get_pdb_observations{  sub get_pdb_observations{
660      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
661    
662      my $fig = new FIG;      #my $fig = new FIG;
663    
664      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
665          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
666          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
667          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 638  Line 715 
715  =cut  =cut
716    
717  sub get_sims_observations{  sub get_sims_observations{
718        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
719    
720      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
721      my $fig = new FIG;      if ( (defined $parameters->{flag}) && ($parameters->{flag})){
722      my @sims= $fig->nsims($fid,500,1e-20,"all");        $max_sims = $parameters->{max_sims};
723      my ($dataset);        $max_expand = $parameters->{max_expand};
724          $max_eval = $parameters->{max_eval};
725          $db_filter = $parameters->{db_filter};
726          $sim_filters->{ sort_by } = $parameters->{sim_order};
727          #$sim_order = $parameters->{sim_order};
728          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
729        }
730        elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
731          $max_sims = 50;
732          $max_expand = 5;
733          $max_eval = 1e-5;
734          $db_filter = "all";
735          $sim_filters->{ sort_by } = 'id';
736        }
737        else{
738          $max_sims = 50;
739          $max_expand = 5;
740          $max_eval = 1e-5;
741          $db_filter = "figx";
742          $sim_filters->{ sort_by } = 'id';
743          #$sim_order = "id";
744        }
745    
746      my %id_list;      my($id, $genome, @genomes, %sims);
747      foreach my $sim (@sims){  #    my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
748          my $hit = $sim->[1];      my @tmp= $fig->sims($fid,1000000,$max_eval,$db_filter,$max_expand,$sim_filters);
749        @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
750        my ($dataset);
751    
752          next if ($hit !~ /^fig\|/);      if ($group_by_genome){
753          my @aliases = $fig->feature_aliases($hit);        #  Collect all sims from genome with the first occurance of the genome:
754          foreach my $alias (@aliases){        foreach $sim ( @tmp ){
755              $id_list{$alias} = 1;          $id = $sim->id2;
756            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
757            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
758            push @{ $sims{ $genome } }, $sim;
759          }          }
760          @tmp = map { @{ $sims{$_} } } @genomes;
761      }      }
762    
763      my %already;      my $seen_sims={};
764      my (@new_sims, @uniprot);      my $count=1;
765      foreach my $sim (@sims){      foreach my $sim (@tmp){
         my $hit = $sim->[1];  
         my ($id) = ($hit) =~ /\|(.*)/;  
         next if (defined($already{$id}));  
         next if (defined($id_list{$hit}));  
         push (@new_sims, $sim);  
         $already{$id} = 1;  
     }  
766    
     foreach my $sim (@new_sims){  
767          my $hit = $sim->[1];          my $hit = $sim->[1];
768            next if ($seen_sims->{$hit});
769            next if ($hit =~ /nmpdr\||gnl\|md5\|/);
770            $seen_sims->{$hit}++;
771    
772            last if ($count>$max_sims);
773            $count++;
774    
775          my $percent = $sim->[2];          my $percent = $sim->[2];
776          my $evalue = $sim->[10];          my $evalue = $sim->[10];
777          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 678  Line 782 
782          my $hlength = $sim->[13];          my $hlength = $sim->[13];
783          my $db = get_database($hit);          my $db = get_database($hit);
784          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
785          my $organism = $fig->org_of($hit);          my $organism;
786            if ($fig->org_of($hit)){
787                $organism = $fig->org_of($hit);
788            }
789            else{
790                $organism = "Data not available";
791            }
792    
793          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
794                        'query' => $sim->[0],
795                      'acc' => $hit,                      'acc' => $hit,
796                      'identity' => $percent,                      'identity' => $percent,
797                      'type' => 'seq',                      'type' => 'seq',
# Line 710  Line 821 
821      my ($id) = (@_);      my ($id) = (@_);
822    
823      my ($db);      my ($db);
824      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
825      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
826        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
827      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
828        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
829      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
830      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
831      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 721  Line 834 
834      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
835      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
836      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
837        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
838        elsif ($id =~ /^img\|/)           { $db = "IMG" }
839        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
840        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
841    
842      return ($db);      return ($db);
843    
# Line 735  Line 852 
852    
853  sub get_identical_proteins{  sub get_identical_proteins{
854    
855      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
856      my $fig = new FIG;      #my $fig = new FIG;
857      my $funcs_ref;      my $funcs_ref;
858    
     my %id_list;  
859      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;  
     }  
   
860      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
861          my ($tmp, $who);          my ($tmp, $who);
862          if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
863              $who = &get_database($id);              $who = &get_database($id);
864              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
865          }          }
866      }      }
867    
     my ($dataset);  
868      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
869                     'type' => 'seq',                     'type' => 'seq',
870                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 774  Line 884 
884    
885  sub get_functional_coupling{  sub get_functional_coupling{
886    
887      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
888      my $fig = new FIG;      #my $fig = new FIG;
889      my @funcs = ();      my @funcs = ();
890    
891      # initialize some variables      # initialize some variables
# Line 785  Line 895 
895      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
896    
897      # get the fc data      # get the fc data
898      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff);
899    
900      # retrieve data      # retrieve data
901      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
902                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
903                    } @fc_data;                    } @fc_data;
904    
     my ($dataset);  
905      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
906                     'type' => 'fc',                     'type' => 'fc',
907                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 903  Line 1012 
1012      return $self->{database};      return $self->{database};
1013  }  }
1014    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
1015  ############################################################  ############################################################
1016  ############################################################  ############################################################
1017  package Observation::PDB;  package Observation::PDB;
# Line 934  Line 1037 
1037  =cut  =cut
1038    
1039  sub display{  sub display{
1040      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1041    
1042      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1043      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1044                                     -host     => $WebConfig::DBHOST,
1045                                     -user     => $WebConfig::DBUSER,
1046                                     -password => $WebConfig::DBPWD);
1047    
1048      my $acc = $self->acc;      my $acc = $self->acc;
1049    
# Line 958  Line 1064 
1064      my $lines = [];      my $lines = [];
1065      my $line_data = [];      my $line_data = [];
1066      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1067                            'hover_title' => 'PDB',
1068                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1069                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1070    
1071      my $fig = new FIG;      #my $fig = new FIG;
1072      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1073      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1074    
# Line 1062  Line 1169 
1169    
1170    
1171  sub display_table{  sub display_table{
1172      my ($self) = @_;      my ($self,$fig) = @_;
1173    
1174      my $fig = new FIG;      #my $fig = new FIG;
1175      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1176      my $rows = $self->rows;      my $rows = $self->rows;
1177      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1075  Line 1182 
1182          my $id = $row->[0];          my $id = $row->[0];
1183          my $who = $row->[1];          my $who = $row->[1];
1184          my $assignment = $row->[2];          my $assignment = $row->[2];
1185          my $organism = $fig->org_of($id);          my $organism = "Data not available";
1186            if ($fig->org_of($id)){
1187                $organism = $fig->org_of($id);
1188            }
1189          my $single_domain = [];          my $single_domain = [];
1190          push(@$single_domain,$who);          push(@$single_domain,$who);
1191          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1192          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1193          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1194          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1126  Line 1236 
1236    
1237  sub display_table {  sub display_table {
1238    
1239      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1240      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1241      my $rows = $self->rows;      my $rows = $self->rows;
1242      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1141  Line 1251 
1251          # construct the score link          # construct the score link
1252          my $score = $row->[0];          my $score = $row->[0];
1253          my $toid = $row->[1];          my $toid = $row->[1];
1254          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";
1255          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1256    
1257          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1258          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1195  Line 1305 
1305      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1306      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1307    
1308      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1309                                    -host     => $WebConfig::DBHOST,
1310                                    -user     => $WebConfig::DBUSER,
1311                                    -password => $WebConfig::DBPWD);
1312    
1313      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1314      if($db eq "CDD"){  
1315          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1316          if(!scalar(@$cdd_objs)){          my $new_id;
1317            if ($id =~ /_/){
1318                ($new_id) = ($id) =~ /(.*?)_/;
1319            }
1320            else{
1321                $new_id = $id;
1322            }
1323    
1324            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1325            if(!scalar(@$pfam_objs)){
1326              $name_title = "name";              $name_title = "name";
1327              $name_value = "not available";              $name_value = "not available";
1328              $description_title = "description";              $description_title = "description";
1329              $description_value = "not available";              $description_value = "not available";
1330          }          }
1331          else{          else{
1332              my $cdd_obj = $cdd_objs->[0];              my $pfam_obj = $pfam_objs->[0];
1333              $name_title = "name";              $name_title = "name";
1334              $name_value = $cdd_obj->term;              $name_value = $pfam_obj->term;
1335              $description_title = "description";              #$description_title = "description";
1336              $description_value = $cdd_obj->description;              #$description_value = $pfam_obj->description;
1337          }          }
1338      }      }
1339    
1340      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1341                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1342        my $new_short_title=$short_title;
1343        if ($short_title =~ /interpro/){
1344            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1345        }
1346        my $line_config = { 'title' => $name_value,
1347                            'hover_title', => 'Domain',
1348                            'short_title' => $new_short_title,
1349                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1350    
1351      my $name;      my $name;
1352      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1353               "value" => $name_value};      $name = {"title" => $db,
1354                 "value" => $new_id};
1355      push(@$descriptions,$name);      push(@$descriptions,$name);
1356    
1357      my $description;  #    my $description;
1358      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1359                               "value" => $description_value};  #                   "value" => $description_value};
1360      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1361    
1362      my $score;      my $score;
1363      $score = {"title" => "score",      $score = {"title" => "score",
1364                "value" => $thing->evalue};                "value" => $thing->evalue};
1365      push(@$descriptions,$score);      push(@$descriptions,$score);
1366    
1367        my $location;
1368        $location = {"title" => "location",
1369                     "value" => $thing->start . " - " . $thing->stop};
1370        push(@$descriptions,$location);
1371    
1372      my $link_id;      my $link_id;
1373      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1374          $link_id = $1;          $link_id = $1;
1375      }      }
1376    
1377      my $link;      my $link;
1378      my $link_url;      my $link_url;
1379      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"}
1380      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      if($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1381      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1382    
1383      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1250  Line 1385 
1385      push(@$links_list,$link);      push(@$links_list,$link);
1386    
1387      my $element_hash = {      my $element_hash = {
1388          "title" => $thing->type,          "title" => $name_value,
1389          "start" => $thing->start,          "start" => $thing->start,
1390          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1391          "color"=> $color,          "color"=> $color,
# Line 1271  Line 1406 
1406      my $data = [];      my $data = [];
1407      my $count = 0;      my $count = 0;
1408      my $content;      my $content;
1409        my $seen = {};
1410    
1411      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1412          next if ($thing->type !~ /dom/);          next if ($thing->type !~ /dom/);
# Line 1280  Line 1416 
1416          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1417          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1418    
1419          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1420                                    -host     => $WebConfig::DBHOST,
1421                                    -user     => $WebConfig::DBUSER,
1422                                    -password => $WebConfig::DBPWD);
1423    
1424          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1425          if($db eq "CDD"){  
1426              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );          my $new_id;
1427              if(!scalar(@$cdd_objs)){          if($db =~ /PFAM/){
1428                if ($id =~ /_/){
1429                    ($new_id) = ($id) =~ /(.*?)_/;
1430                }
1431                else{
1432                    $new_id = $id;
1433                }
1434    
1435                next if ($seen->{$new_id});
1436                $seen->{$new_id}=1;
1437    
1438                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1439    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1440                if(!scalar(@$pfam_objs)){
1441                  $name_title = "name";                  $name_title = "name";
1442                  $name_value = "not available";                  $name_value = "not available";
1443                  $description_title = "description";                  $description_title = "description";
1444                  $description_value = "not available";                  $description_value = "not available";
1445              }              }
1446              else{              else{
1447                  my $cdd_obj = $cdd_objs->[0];                  my $pfam_obj = $pfam_objs->[0];
1448                  $name_title = "name";                  $name_title = "name";
1449                  $name_value = $cdd_obj->term;                  $name_value = $pfam_obj->term;
1450                  $description_title = "description";                  #$description_title = "description";
1451                  $description_value = $cdd_obj->description;                  #$description_value = $pfam_obj->description;
1452              }              }
1453          }          }
1454    
1455          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1456    
1457          push(@$single_domain,$db);          push(@$single_domain,$db);
1458          push(@$single_domain,$thing->acc);          push(@$single_domain,$new_id);
1459          push(@$single_domain,$name_value);          push(@$single_domain,$name_value);
1460          push(@$single_domain,$location);          push(@$single_domain,$location);
1461          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
# Line 1345  Line 1497 
1497      return $self;      return $self;
1498  }  }
1499    
1500    sub display_cello {
1501        my ($thing) = @_;
1502        my $html;
1503        my $cello_location = $thing->cello_location;
1504        my $cello_score = $thing->cello_score;
1505        if($cello_location){
1506            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1507            #$html .= "<p>CELLO score: $cello_score </p>";
1508        }
1509        return ($html);
1510    }
1511    
1512  sub display {  sub display {
1513      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1514    
1515      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1516      my $fig= new FIG;      #my $fig= new FIG;
1517      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1518    
1519      my $cleavage_prob;      my $cleavage_prob;
# Line 1369  Line 1533 
1533      #color is      #color is
1534      my $color = "6";      my $color = "6";
1535    
     if($cello_location){  
         my $cello_descriptions = [];  
         my $line_data =[];  
   
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'CELLO',  
                             'basepair_offset' => '1' };  
   
         my $description_cello_location = {"title" => 'Best Cello Location',  
                                           "value" => $cello_location};  
   
         push(@$cello_descriptions,$description_cello_location);  
   
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
   
         push(@$cello_descriptions,$description_cello_score);  
   
         my $element_hash = {  
             "title" => "CELLO",  
             "start" => "1",  
             "end" =>  $length + 1,  
             "color"=> $color,  
             "type" => 'box',  
             "zlayer" => '1',  
             "description" => $cello_descriptions};  
   
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
   
   
     $color = "2";  
     if($tmpred_score){  
         my $line_data =[];  
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'Transmembrane',  
                             'basepair_offset' => '1' };  
   
   
         foreach my $tmpred (@tmpred_locations){  
             my $descriptions = [];  
             my ($begin,$end) =split("-",$tmpred);  
             my $description_tmpred_score = {"title" => 'TMPRED score',  
                              "value" => $tmpred_score};  
   
             push(@$descriptions,$description_tmpred_score);  
1536    
             my $element_hash = {  
             "title" => "transmembrane location",  
             "start" => $begin + 1,  
             "end" =>  $end + 1,  
             "color"=> $color,  
             "zlayer" => '5',  
             "type" => 'smallbox',  
             "description" => $descriptions};  
1537    
1538              push(@$line_data,$element_hash);  #    if($cello_location){
1539    #       my $cello_descriptions = [];
1540    #       my $line_data =[];
1541    #
1542    #       my $line_config = { 'title' => 'Localization Evidence',
1543    #                           'short_title' => 'CELLO',
1544    #                            'hover_title' => 'Localization',
1545    #                           'basepair_offset' => '1' };
1546    #
1547    #       my $description_cello_location = {"title" => 'Best Cello Location',
1548    #                                         "value" => $cello_location};
1549    #
1550    #       push(@$cello_descriptions,$description_cello_location);
1551    #
1552    #       my $description_cello_score = {"title" => 'Cello Score',
1553    #                                      "value" => $cello_score};
1554    #
1555    #       push(@$cello_descriptions,$description_cello_score);
1556    #
1557    #       my $element_hash = {
1558    #           "title" => "CELLO",
1559    #           "color"=> $color,
1560    #           "start" => "1",
1561    #           "end" =>  $length + 1,
1562    #           "zlayer" => '1',
1563    #           "description" => $cello_descriptions};
1564    #
1565    #       push(@$line_data,$element_hash);
1566    #       $gd->add_line($line_data, $line_config);
1567    #    }
1568    #
1569    #    $color = "2";
1570    #    if($tmpred_score){
1571    #       my $line_data =[];
1572    #       my $line_config = { 'title' => 'Localization Evidence',
1573    #                           'short_title' => 'Transmembrane',
1574    #                           'basepair_offset' => '1' };
1575    #
1576    #       foreach my $tmpred (@tmpred_locations){
1577    #           my $descriptions = [];
1578    #           my ($begin,$end) =split("-",$tmpred);
1579    #           my $description_tmpred_score = {"title" => 'TMPRED score',
1580    #                            "value" => $tmpred_score};
1581    #
1582    #           push(@$descriptions,$description_tmpred_score);
1583    #
1584    #           my $element_hash = {
1585    #           "title" => "transmembrane location",
1586    #           "start" => $begin + 1,
1587    #           "end" =>  $end + 1,
1588    #           "color"=> $color,
1589    #           "zlayer" => '5',
1590    #           "type" => 'box',
1591    #           "description" => $descriptions};
1592    #
1593    #           push(@$line_data,$element_hash);
1594    #
1595    #       }
1596    #       $gd->add_line($line_data, $line_config);
1597    #    }
1598    
         }  
         $gd->add_line($line_data, $line_config);  
     }  
1599    
1600      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1601          my $line_data =[];          my $line_data =[];
1602          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1603                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1604                                'hover_title' => 'Localization',
1605                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1606    
1607          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1608              my $descriptions = [];              my $descriptions = [];
1609              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1610                               "value" => $tm_loc};                               "value" => $tm_loc};
1611              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1612    
1613              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1614    
1615              my $element_hash = {              my $element_hash = {
1616              "title" => "phobius transmembrane location",              "title" => "Phobius",
1617              "start" => $begin + 1,              "start" => $begin + 1,
1618              "end" =>  $end + 1,              "end" =>  $end + 1,
1619              "color"=> '6',              "color"=> '6',
# Line 1482  Line 1648 
1648      }      }
1649    
1650    
1651      $color = "1";  #    $color = "1";
1652      if($signal_peptide_score){  #    if($signal_peptide_score){
1653          my $line_data = [];  #       my $line_data = [];
1654          my $descriptions = [];  #       my $descriptions = [];
1655    #
1656          my $line_config = { 'title' => 'Localization Evidence',  #       my $line_config = { 'title' => 'Localization Evidence',
1657                              'short_title' => 'SignalP',  #                           'short_title' => 'SignalP',
1658                              'basepair_offset' => '1' };  #                            'hover_title' => 'Localization',
1659    #                           'basepair_offset' => '1' };
1660          my $description_signal_peptide_score = {"title" => 'signal peptide score',  #
1661                                                  "value" => $signal_peptide_score};  #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1662    #                                               "value" => $signal_peptide_score};
1663          push(@$descriptions,$description_signal_peptide_score);  #
1664    #       push(@$descriptions,$description_signal_peptide_score);
1665          my $description_cleavage_prob = {"title" => 'cleavage site probability',  #
1666                                           "value" => $cleavage_prob};  #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1667    #                                        "value" => $cleavage_prob};
1668          push(@$descriptions,$description_cleavage_prob);  #
1669    #       push(@$descriptions,$description_cleavage_prob);
1670          my $element_hash = {  #
1671              "title" => "SignalP",  #       my $element_hash = {
1672              "start" => $cleavage_loc_begin - 2,  #           "title" => "SignalP",
1673              "end" =>  $cleavage_loc_end + 1,  #           "start" => $cleavage_loc_begin - 2,
1674              "type" => 'bigbox',  #           "end" =>  $cleavage_loc_end + 1,
1675              "color"=> $color,  #           "type" => 'bigbox',
1676              "zlayer" => '10',  #           "color"=> $color,
1677              "description" => $descriptions};  #           "zlayer" => '10',
1678    #           "description" => $descriptions};
1679    #
1680    #       push(@$line_data,$element_hash);
1681    #       $gd->add_line($line_data, $line_config);
1682    #    }
1683    
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
1684    
1685      return ($gd);      return ($gd);
1686    
# Line 1584  Line 1752 
1752      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1753      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1754      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1755        $self->{query} = $dataset->{'query'};
1756      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1757      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1758      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1607  Line 1776 
1776  =cut  =cut
1777    
1778  sub display {  sub display {
1779      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
1780    
1781      my $organism = $self->organism;      # declare variables
1782        my $window_size = $gd->window_size;
1783        my $peg = $thing->acc;
1784        my $query_id = $thing->query;
1785        my $organism = $thing->organism;
1786        my $abbrev_name = $fig->abbrev($organism);
1787        if (!$organism){
1788          $organism = $peg;
1789          $abbrev_name = $peg;
1790        }
1791      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1792      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1793      my $function = $self->function;      my $function = $thing->function;
1794      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1795      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1796      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1797      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1798      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1799        my $ln_hit = $thing->hlength;
1800    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1801    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1802        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1803        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1804    
1805      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;
1806    
1807        # hit sequence title
1808      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1809                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1810                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1811                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1812                            'no_middle_line' => '1'
1813                          };                          };
1814    
1815        # query sequence title
1816        my $replace_id = $peg;
1817        $replace_id =~ s/\|/_/ig;
1818        my $anchor_name = "anchor_". $replace_id;
1819        my $query_config = { 'title' => "Query",
1820                             'short_title' => "Query",
1821                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1822                             'basepair_offset' => '0',
1823                             'no_middle_line' => '1'
1824                             };
1825      my $line_data = [];      my $line_data = [];
1826        my $query_data = [];
1827    
1828      my $element_hash;      my $element_hash;
1829      my $links_list = [];      my $hit_links_list = [];
1830      my $descriptions = [];      my $hit_descriptions = [];
1831        my $query_descriptions = [];
1832      # get subsystem information  
1833      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1834        # evidence link
1835      my $link;      my $evidence_link;
1836      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1837               "link" => $url_link};        $evidence_link = "?page=Annotation&feature=".$peg;
1838      push(@$links_list,$link);      }
1839        else{
1840          my $db = &Observation::get_database($peg);
1841          my ($link_id) = ($peg) =~ /\|(.*)/;
1842          $evidence_link = &HTML::alias_url($link_id, $db);
1843          #print STDERR "LINK: $db    $evidence_link";
1844        }
1845        my $link = {"link_title" => $peg,
1846                    "link" => $evidence_link};
1847        push(@$hit_links_list,$link) if ($evidence_link);
1848    
1849      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1850      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1851          my $link;      my @subsystems;
1852          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1853            my $subsystem = $$array[0];
1854            push(@subsystems,$subsystem);
1855            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1856                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1857          push(@$links_list,$link);          push(@$hit_links_list,$link);
1858      }      }
1859    
1860        # blast alignment
1861        $link = {"link_title" => "view blast alignment",
1862                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1863        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1864    
1865        # description data
1866      my $description_function;      my $description_function;
1867      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1868                               "value" => $function};                               "value" => $function};
1869      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1870    
1871      my ($description_ss, $ss_string);      # subsystem description
1872      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1873      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1874        my $description_ss = {"title" => "subsystems",
1875                         "value" => $ss_string};                         "value" => $ss_string};
1876      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1877    
1878        # location description
1879        # hit
1880      my $description_loc;      my $description_loc;
1881      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1882                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1883      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1884    
1885      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1886                          "value" => $hit_stop};                          "value" => $ln_hit};
1887      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1888    
1889        # query
1890        $description_loc = {"title" => "Hit Location",
1891                            "value" => $query_start . " - " . $query_stop};
1892        push(@$query_descriptions, $description_loc);
1893    
1894        $description_loc = {"title" => "Sequence Length",
1895                            "value" => $ln_query};
1896        push(@$query_descriptions, $description_loc);
1897    
1898    
1899    
1900      my $evalue = $self->evalue;      # evalue score description
1901        my $evalue = $thing->evalue;
1902      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1903      {      {
1904          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1681  Line 1907 
1907      }      }
1908    
1909      my $color = &color($evalue);      my $color = &color($evalue);
   
1910      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1911                              "value" => $evalue};                              "value" => $evalue};
1912      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1913        push(@$query_descriptions, $description_eval);
1914    
1915      my $identity = $self->identity;      my $identity = $self->identity;
1916      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1917                                  "value" => $identity};                                  "value" => $identity};
1918      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1919        push(@$query_descriptions, $description_identity);
1920    
1921    
1922        my $number = $base_start + ($query_start-$hit_start);
1923        #print STDERR "START: $number";
1924      $element_hash = {      $element_hash = {
1925          "title" => $peg,          "title" => $query_id,
1926          "start" => $align_start,          "start" => $base_start,
1927          "end" =>  $align_stop,          "end" => $base_start+$ln_query,
1928          "type"=> 'box',          "type"=> 'box',
1929          "color"=> $color,          "color"=> $color,
1930          "zlayer" => "2",          "zlayer" => "2",
1931          "links_list" => $links_list,          "links_list" => $query_links_list,
1932          "description" => $descriptions          "description" => $query_descriptions
1933          };          };
1934      push(@$line_data,$element_hash);      push(@$query_data,$element_hash);
     $gd->add_line($line_data, $line_config);  
1935    
1936      return ($gd);      $element_hash = {
1937            "title" => $query_id . ': HIT AREA',
1938            "start" => $base_start + $query_start,
1939            "end" =>  $base_start + $query_stop,
1940            "type"=> 'smallbox',
1941            "color"=> $query_color,
1942            "zlayer" => "3",
1943            "links_list" => $query_links_list,
1944            "description" => $query_descriptions
1945            };
1946        push(@$query_data,$element_hash);
1947    
1948        $gd->add_line($query_data, $query_config);
1949    
1950    
1951        $element_hash = {
1952                    "title" => $peg,
1953                    "start" => $base_start + ($query_start-$hit_start),
1954                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1955                    "type"=> 'box',
1956                    "color"=> $color,
1957                    "zlayer" => "2",
1958                    "links_list" => $hit_links_list,
1959                    "description" => $hit_descriptions
1960                    };
1961        push(@$line_data,$element_hash);
1962    
1963        $element_hash = {
1964            "title" => $peg . ': HIT AREA',
1965            "start" => $base_start + $query_start,
1966            "end" =>  $base_start + $query_stop,
1967            "type"=> 'smallbox',
1968            "color"=> $hit_color,
1969            "zlayer" => "3",
1970            "links_list" => $hit_links_list,
1971            "description" => $hit_descriptions
1972            };
1973        push(@$line_data,$element_hash);
1974    
1975        $gd->add_line($line_data, $line_config);
1976    
1977        my $breaker = [];
1978        my $breaker_hash = {};
1979        my $breaker_config = { 'no_middle_line' => "1" };
1980    
1981        push (@$breaker, $breaker_hash);
1982        $gd->add_line($breaker, $breaker_config);
1983    
1984        return ($gd);
1985    }
1986    
1987    =head3 display_domain_composition()
1988    
1989    If available use the function specified here to display a graphical observation of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1990    
1991    =cut
1992    
1993    sub display_domain_composition {
1994        my ($self,$gd,$fig) = @_;
1995    
1996        #$fig = new FIG;
1997        my $peg = $self->acc;
1998    
1999        my $line_data = [];
2000        my $links_list = [];
2001        my $descriptions = [];
2002    
2003        my @domain_query_results =$fig->get_attributes($peg,"CDD");
2004        #my @domain_query_results = ();
2005        foreach $dqr (@domain_query_results){
2006            my $key = @$dqr[1];
2007            my @parts = split("::",$key);
2008            my $db = $parts[0];
2009            my $id = $parts[1];
2010            my $val = @$dqr[2];
2011            my $from;
2012            my $to;
2013            my $evalue;
2014    
2015            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
2016                my $raw_evalue = $1;
2017                $from = $2;
2018                $to = $3;
2019                if($raw_evalue =~/(\d+)\.(\d+)/){
2020                    my $part2 = 1000 - $1;
2021                    my $part1 = $2/100;
2022                    $evalue = $part1."e-".$part2;
2023                }
2024                else{
2025                    $evalue = "0.0";
2026                }
2027            }
2028    
2029            my $dbmaster = DBMaster->new(-database =>'Ontology',
2030                                    -host     => $WebConfig::DBHOST,
2031                                    -user     => $WebConfig::DBUSER,
2032                                    -password => $WebConfig::DBPWD);
2033            my ($name_value,$description_value);
2034    
2035            if($db eq "CDD"){
2036                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
2037                if(!scalar(@$cdd_objs)){
2038                    $name_title = "name";
2039                    $name_value = "not available";
2040                    $description_title = "description";
2041                    $description_value = "not available";
2042                }
2043                else{
2044                    my $cdd_obj = $cdd_objs->[0];
2045                    $name_value = $cdd_obj->term;
2046                    $description_value = $cdd_obj->description;
2047                }
2048            }
2049    
2050            my $domain_name;
2051            $domain_name = {"title" => "name",
2052                            "value" => $name_value};
2053            push(@$descriptions,$domain_name);
2054    
2055            my $description;
2056            $description = {"title" => "description",
2057                            "value" => $description_value};
2058            push(@$descriptions,$description);
2059    
2060            my $score;
2061            $score = {"title" => "score",
2062                      "value" => $evalue};
2063            push(@$descriptions,$score);
2064    
2065            my $link_id = $id;
2066            my $link;
2067            my $link_url;
2068            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"}
2069            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2070            else{$link_url = "NO_URL"}
2071    
2072            $link = {"link_title" => $name_value,
2073                     "link" => $link_url};
2074            push(@$links_list,$link);
2075    
2076            my $domain_element_hash = {
2077                "title" => $peg,
2078                "start" => $from,
2079                "end" =>  $to,
2080                "type"=> 'box',
2081                "zlayer" => '4',
2082                "links_list" => $links_list,
2083                "description" => $descriptions
2084                };
2085    
2086            push(@$line_data,$domain_element_hash);
2087    
2088            #just one CDD domain for now, later will add option for multiple domains from selected DB
2089            last;
2090        }
2091    
2092        my $line_config = { 'title' => $peg,
2093                            'hover_title' => 'Domain',
2094                            'short_title' => $peg,
2095                            'basepair_offset' => '1' };
2096    
2097        $gd->add_line($line_data, $line_config);
2098    
2099        return ($gd);
2100    
2101  }  }
2102    
# Line 1718  Line 2110 
2110  =cut  =cut
2111    
2112  sub display_table {  sub display_table {
2113      my ($self,$dataset, $columns, $query_fid) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2114        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2115    
2116      my $data = [];      my $scroll_list;
2117      my $count = 0;      foreach my $col (@$show_columns){
2118      my $content;          push (@$scroll_list, $col->{key});
2119      my $fig = new FIG;      }
2120      my $cgi = new CGI;  
2121      my @ids;      push (@ids, $query_fid);
2122      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2123          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2124          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2125      }      }
2126    
2127      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2128      foreach my $col (@$columns){      my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2129    
2130          # get the column for the subsystems          # get the column for the subsystems
2131          if ($col eq "subsystem"){      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2132              %subsystems_column = &get_subsystems_column(\@ids);  
         }  
2133          # get the column for the evidence codes          # get the column for the evidence codes
2134          elsif ($col eq "evidence"){      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2135              %evidence_column = &get_evidence_column(\@ids);  
2136          }      # get the column for pfam_domain
2137        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2138    
2139        # get the column for molecular weight
2140        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2141    
2142        # get the column for organism's habitat
2143        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2144    
2145        # get the column for organism's temperature optimum
2146        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2147    
2148        # get the column for organism's temperature range
2149        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2150    
2151        # get the column for organism's oxygen requirement
2152        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2153    
2154        # get the column for organism's pathogenicity
2155        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2156    
2157        # get the column for organism's pathogenicity host
2158        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2159    
2160        # get the column for organism's salinity
2161        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2162    
2163        # get the column for organism's motility
2164        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2165    
2166        # get the column for organism's gram stain
2167        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2168    
2169        # get the column for organism's endospores
2170        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2171    
2172        # get the column for organism's shape
2173        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2174    
2175        # get the column for organism's disease
2176        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2177    
2178        # get the column for organism's disease
2179        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2180    
2181        # get the column for transmembrane domains
2182        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2183    
2184        # get the column for similar to human
2185        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);
2186    
2187        # get the column for signal peptide
2188        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2189    
2190        # get the column for transmembrane domains
2191        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2192    
2193        # get the column for conserved neighborhood
2194        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2195    
2196        # get the column for cellular location
2197        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2198    
2199        # get the aliases
2200        my $alias_col;
2201        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2202             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2203             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2204             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2205             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2206            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2207      }      }
2208    
2209      my %e_identical = &get_essentially_identical($query_fid);      # get the colors for the function cell
2210        my $functions = $fig->function_of_bulk(\@ids,1);
2211        $functional_color = &get_function_color_cell($functions, $fig);
2212        my $query_function = $fig->function_of($query_fid);
2213    
2214      foreach my $thing (@$dataset) {      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2215    
2216        my $figfam_data = &FIG::get_figfams_data();
2217        my $figfams = new FFs($figfam_data);
2218        my $same_genome_flag = 0;
2219    
2220        my $func_color_offset=0;
2221        unshift(@$dataset, $query_fid);
2222        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2223    #    foreach my $thing ( @$dataset){
2224            my $thing = $dataset->[$thing_count];
2225            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2226            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2227            if ($thing eq $query_fid){
2228                $id = $thing;
2229                $taxid   = $fig->genome_of($id);
2230                $organism = $fig->genus_species($taxid);
2231                $current_function = $fig->function_of($id);
2232            }
2233            else{
2234          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2235    
2236                $id      = $thing->acc;
2237                $evalue  = $thing->evalue;
2238                $taxid   = $fig->genome_of($id);
2239                $iden    = $thing->identity;
2240                $organism= $thing->organism;
2241                $ln1     = $thing->qlength;
2242                $ln2     = $thing->hlength;
2243                $b1      = $thing->qstart;
2244                $e1      = $thing->qstop;
2245                $b2      = $thing->hstart;
2246                $e2      = $thing->hstop;
2247                $d1      = abs($e1 - $b1) + 1;
2248                $d2      = abs($e2 - $b2) + 1;
2249                $color1  = match_color( $b1, $e1, $ln1 );
2250                $color2  = match_color( $b2, $e2, $ln2 );
2251                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2252                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2253                $current_function = $thing->function;
2254                $next_org = $next_thing->organism if (defined $next_thing);
2255            }
2256    
2257            next if ($id =~ /nmpdr\||gnl\|md5\|/);
2258    
2259          my $single_domain = [];          my $single_domain = [];
2260          $count++;          $count++;
2261    
2262          my $id = $thing->acc;          # organisms cell
2263            my ($org, $org_color) = $fig->org_and_color_of($id);
2264    
2265          my $iden    = $thing->identity;          my $org_cell;
2266          my $ln1     = $thing->qlength;          if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2267          my $ln2     = $thing->hlength;              $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2268          my $b1      = $thing->qstart;          }
2269          my $e1      = $thing->qstop;          elsif ($next_org eq $organism){
2270          my $b2      = $thing->hstart;              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2271          my $e2      = $thing->hstop;              $same_genome_flag = 1;
2272          my $d1      = abs($e1 - $b1) + 1;          }
2273          my $d2      = abs($e2 - $b2) + 1;          elsif ($same_genome_flag == 1){
2274          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2275          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";              $same_genome_flag = 0;
2276            }
2277    
2278          # checkbox column          # checkbox cell
2279            my ($box_cell,$tax, $radio_cell);
2280          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2281          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2282          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;
2283            my $replace_id = $id;
2284            $replace_id =~ s/\|/_/ig;
2285            my $white = '#ffffff';
2286            $white = '#999966' if ($id eq $query_fid);
2287            $org_color = '#999966' if ($id eq $query_fid);
2288            my $anchor_name = "anchor_". $replace_id;
2289            my $checked = "";
2290            #$checked = "checked" if ($id eq $query_fid);
2291    #       if ($id =~ /^fig\|/){
2292              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>~;
2293              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2294              $tax = $fig->genome_of($id) if ($id =~ /^fig\|/);
2295    #       }
2296    #       else{
2297    #         my $box = qq(<a name="$anchor_name"></a>);
2298    #         $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2299    #       }
2300    
2301            # create the radio cell for any sequence, not just fig ids
2302            my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2303            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2304    
2305          # get the linked fig id          # get the linked fig id
2306          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2307          if (defined ($e_identical{$id})){  
2308              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";          my $fig_data;
2309          }          if ($id =~ /^fig\|/)
2310          else{          {
2311              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
         }  
   
         push(@$single_domain,$box_col);                        # permanent column  
         push(@$single_domain,$fig_col);                        # permanent column  
         push(@$single_domain,$thing->evalue);                  # permanent column  
         push(@$single_domain,"$iden\%");                       # permanent column  
         push(@$single_domain,$reg1);                           # permanent column  
         push(@$single_domain,$reg2);                           # permanent column  
         push(@$single_domain,$thing->organism);                # permanent column  
         push(@$single_domain,$thing->function);                # permanent column  
         foreach my $col (@$columns){  
             (push(@$single_domain,$subsystems_column{$id}) && (next)) if ($col eq "subsystem");  
             (push(@$single_domain,$evidence_column{$id}) && (next)) if ($col eq "evidence");  
             (push(@$single_domain,&get_prefer($thing->acc, 'NCBI')) && (next)) if ($col eq "ncbi_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'RefSeq')) && (next)) if ($col eq "refseq_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'SwissProt')) && (next)) if ($col eq "swissprot_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'UniProt')) && (next)) if ($col eq "uniprot_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'TIGR')) && (next)) if ($col eq "tigr_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'PIR')) && (next)) if ($col eq "pir_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'KEGG')) && (next)) if ($col eq "kegg_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL')) && (next)) if ($col eq "trembl_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'ASAP')) && (next)) if ($col eq "asap_id");  
             (push(@$single_domain,&get_prefer($thing->acc, 'JGI')) && (next)) if ($col eq "jgi_id");  
2312          }          }
2313          push(@$data,$single_domain);          else
2314            {
2315                my $url_link = &HTML::set_prot_links($cgi,$id);
2316                $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2317      }      }
2318            $fig_data .= qq(<td><img height='10px' width='20px' src='$FIG_Config::cgi_url/Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2319            my $fig_col = {'data'=> $fig_data,
2320                           'highlight'=>$white};
2321    
2322            $replace_id = $peg;
2323            $replace_id =~ s/\|/_/ig;
2324            $anchor_name = "anchor_". $replace_id;
2325            my $query_config = { 'title' => "Query",
2326                                 'short_title' => "Query",
2327                                 'title_link' => "changeSimsLocation('$replace_id')",
2328                                 'basepair_offset' => '0'
2329                                 };
2330    
2331            # function cell
2332            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2333                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2334                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2335    
2336            my $function_color;
2337            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2338                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2339            }
2340            else{
2341                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2342            }
2343            my $function_cell;
2344            if ($current_function){
2345              if ($current_function eq $query_function){
2346                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2347                $func_color_offset=1;
2348              }
2349              else{
2350                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2351              }
2352            }
2353            else{
2354              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2355            }
2356    
2357            if ($id eq $query_fid){
2358                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2359                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2360                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white},
2361                      {'data'=>$subsystems_column->{$id},'highlight'=>$white},
2362                      {'data'=>$evidence_column->{$id},'highlight'=>$white});  # permanent columns
2363            }
2364            else{
2365                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2366                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell,
2367                      {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"},
2368                      {'data'=>$evidence_column->{$id},'highlight'=>"#ffffff"});  # permanent columns
2369    
2370            }
2371    
2372            if ( ( $application->session->user) ){
2373                my $user = $application->session->user;
2374                if ($user && $user->has_right(undef, 'annotate', 'genome')) {
2375                    push (@$single_domain,$radio_cell);
2376                }
2377            }
2378    
2379            my ($ff) = $figfams->families_containing_peg($id);
2380    
2381            foreach my $col (@$scroll_list){
2382                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2383                else { $highlight_color = "#ffffff"; }
2384    
2385                if ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2393                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2394                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2395                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2396                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2397                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2398                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2399                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2400                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2401                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2402                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2403                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2404                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2405                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2406                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2407                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2408                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2409                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2410                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2411                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2412                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2413                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2414                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2415                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2416                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2417            }
2418            push(@$data,$single_domain);
2419        }
2420      if ($count >0 ){      if ($count >0 ){
2421          $content = $data;          $content = $data;
2422      }      }
2423      else{      else{
2424          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2425      }      }
2426        shift(@$dataset);
2427        return ($content);
2428    }
2429    
2430    
2431    =head3 display_figfam_table()
2432    
2433    If available use the function specified here to display the "raw" observation.
2434    This code will display a table for the similarities protein
2435    
2436    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
2437    
2438    =cut
2439    
2440    sub display_figfam_table {
2441      my ($self,$ids, $show_columns, $fig, $application, $cgi) = @_;
2442      my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2443    
2444      my $scroll_list;
2445      foreach my $col (@$show_columns){
2446        push (@$scroll_list, $col->{key});
2447      }
2448    
2449      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2450      my @attributes = $fig->get_attributes($ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2451    
2452      # get the column for the subsystems
2453      $subsystems_column = &get_subsystems_column($ids,$fig,$cgi,'hash');
2454    
2455      # get the column for the evidence codes
2456      $evidence_column = &get_evidence_column($ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2457    
2458      # get the column for pfam_domain
2459      $pfam_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2460    
2461      # get the column for molecular weight
2462      $mw_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2463    
2464      # get the column for organism's habitat
2465      my $habitat_column = &get_attrb_column($ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2466    
2467      # get the column for organism's temperature optimum
2468      my $temperature_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2469    
2470      # get the column for organism's temperature range
2471      my $temperature_range_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2472    
2473      # get the column for organism's oxygen requirement
2474      my $oxygen_req_column = &get_attrb_column($ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2475    
2476      # get the column for organism's pathogenicity
2477      my $pathogenic_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2478    
2479      # get the column for organism's pathogenicity host
2480      my $pathogenic_in_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2481    
2482      # get the column for organism's salinity
2483      my $salinity_column = &get_attrb_column($ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2484    
2485      # get the column for organism's motility
2486      my $motility_column = &get_attrb_column($ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2487    
2488      # get the column for organism's gram stain
2489      my $gram_stain_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2490    
2491      # get the column for organism's endospores
2492      my $endospores_column = &get_attrb_column($ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2493    
2494      # get the column for organism's shape
2495      my $shape_column = &get_attrb_column($ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2496    
2497      # get the column for organism's disease
2498      my $disease_column = &get_attrb_column($ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2499    
2500      # get the column for organism's disease
2501      my $gc_content_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2502    
2503      # get the column for transmembrane domains
2504      my $transmembrane_column = &get_attrb_column($ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2505    
2506      # get the column for similar to human
2507      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);
2508    
2509      # get the column for signal peptide
2510      my $signal_peptide_column = &get_attrb_column($ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2511    
2512      # get the column for transmembrane domains
2513      my $isoelectric_column = &get_attrb_column($ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2514    
2515      # get the column for conserved neighborhood
2516      my $cons_neigh_column = &get_attrb_column($ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2517    
2518      # get the column for cellular location
2519      my $cell_location_column = &get_attrb_column($ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2520    
2521      # get the aliases
2522      my $alias_col;
2523      if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2524           (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2525           (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2526           (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2527           (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2528        $alias_col = &get_db_aliases($ids,$fig,'all',$cgi,'hash');
2529      }
2530    
2531      foreach my $id ( @$ids){
2532        my $current_function = $fig->function_of($id);
2533        my $organism = $fig->org_of($id);
2534        my $single_domain = [];
2535    
2536        # organisms cell comehere2
2537        my ($org, $org_color) = $fig->org_and_color_of($id);
2538        my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2539    
2540        # get the linked fig id
2541        my $fig_data;
2542        if ($id =~ /^fig\|/)
2543        {
2544            $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2545        }
2546        else
2547        {
2548            my $url_link = &HTML::set_prot_links($cgi,$id);
2549            $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2550        }
2551    
2552        my $fig_col = {'data'=> $fig_data,
2553                       'highlight'=>"#ffffff"};
2554    
2555        # get sequence length
2556        my $length_col = {'data'=> $fig->translation_length($id),
2557                          'highlight'=>"#ffffff"};
2558    
2559        # function cell
2560        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2561    
2562        # insert data
2563        push (@$single_domain, $fig_col, $length_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2564    
2565        foreach my $col (@$scroll_list){
2566          my $highlight_color = "#ffffff";
2567    
2568          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2569          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2570          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2571          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2572          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2573          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2574          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2575          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2576          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2577          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2578          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2579          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2580          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2581          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2582          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2583          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2584          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2585          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2586          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2587          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2588          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2589          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2590          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2591          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2592          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2593          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2594          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2595          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2596          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2597          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2598          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2599          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2600          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2601        }
2602        push(@$data,$single_domain);
2603      }
2604    
2605      $content = $data;
2606      return ($content);      return ($content);
2607  }  }
2608    
# Line 1818  Line 2612 
2612      foreach my $id (@$ids){      foreach my $id (@$ids){
2613          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2614          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2615          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2616            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2617      }      }
2618      return (%column);      return (%column);
2619  }  }
2620    
2621    sub get_figfam_column{
2622        my ($ids, $fig, $cgi) = @_;
2623        my $column;
2624    
2625        my $figfam_data = &FIG::get_figfams_data();
2626        my $figfams = new FFs($figfam_data);
2627    
2628        foreach my $id (@$ids){
2629            my ($ff);
2630            if ($id =~ /\.peg\./){
2631                ($ff) =  $figfams->families_containing_peg($id);
2632            }
2633            if ($ff){
2634                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2635            }
2636            else{
2637                push (@$column, " ");
2638            }
2639        }
2640    
2641        return $column;
2642    }
2643    
2644  sub get_subsystems_column{  sub get_subsystems_column{
2645      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2646    
2647      my $fig = new FIG;      my %in_subs  = $fig->subsystems_for_pegs($ids,1);
2648      my $cgi = new CGI;      my ($column, $ss);
     my %in_subs  = $fig->subsystems_for_pegs($ids);  
     my %column;  
2649      foreach my $id (@$ids){      foreach my $id (@$ids){
2650          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2651          my @subsystems;          my @subsystems;
2652    
2653          if (@in_sub > 0) {          if (@in_sub > 0) {
2654              my $count = 1;              foreach my $array(@in_sub){
2655              foreach my $array(@in_sub){                  my $ss = $array->[0];
2656                  push (@subsystems, $count . ". " . $$array[0]);                  $ss =~ s/_/ /ig;
2657                  $count++;                  push (@subsystems, "-" . $ss);
2658                }
2659                my $in_sub_line = join ("<br>", @subsystems);
2660                $ss->{$id} = $in_sub_line;
2661            } else {
2662                $ss->{$id} = "None added";
2663            }
2664            push (@$column, $ss->{$id});
2665        }
2666    
2667        if ($returnType eq 'hash') { return $ss; }
2668        elsif ($returnType eq 'array') { return $column; }
2669    }
2670    
2671    sub get_lineage_column{
2672        my ($ids, $fig, $cgi) = @_;
2673    
2674        my $lineages = $fig->taxonomy_list();
2675    
2676        foreach my $id (@$ids){
2677            my $genome = $fig->genome_of($id);
2678            if ($lineages->{$genome}){
2679    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2680                push (@$column, $lineages->{$genome});
2681            }
2682            else{
2683                push (@$column, " ");
2684            }
2685        }
2686        return $column;
2687    }
2688    
2689    sub match_color {
2690        my ( $b, $e, $n , $rgb) = @_;
2691        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2692        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2693        my $cov = ( $r - $l + 1 ) / $n;
2694        my $sat = 1 - 10 * $cov / 9;
2695        my $br  = 1;
2696        if ($rgb){
2697            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2698        }
2699        else{
2700            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2701        }
2702    }
2703    
2704    sub hsb2rgb {
2705        my ( $h, $s, $br ) = @_;
2706        $h = 6 * ($h - floor($h));
2707        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2708        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2709        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2710                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2711                                          :               ( 0,      1,      $h - 2 )
2712                                          )
2713                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2714                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2715                                          :               ( 1,      0,      6 - $h )
2716                                          );
2717        ( ( $r * $s + 1 - $s ) * $br,
2718          ( $g * $s + 1 - $s ) * $br,
2719          ( $b * $s + 1 - $s ) * $br
2720        )
2721    }
2722    
2723    sub html2rgb {
2724        my ($hex) = @_;
2725        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2726        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2727                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2728    
2729        my @R = split(//, $r);
2730        my @G = split(//, $g);
2731        my @B = split(//, $b);
2732    
2733        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2734        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2735        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2736    
2737        my $rgb = [$red, $green, $blue];
2738        return $rgb;
2739    
2740    }
2741    
2742    sub rgb2html {
2743        my ( $r, $g, $b ) = @_;
2744        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2745        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2746        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2747        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2748    }
2749    
2750    sub floor {
2751        my $x = $_[0];
2752        defined( $x ) || return undef;
2753        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2754    }
2755    
2756    sub get_function_color_cell{
2757      my ($functions, $fig) = @_;
2758    
2759      # figure out the quantity of each function
2760      my %hash;
2761      foreach my $key (keys %$functions){
2762        my $func = $functions->{$key};
2763        $hash{$func}++;
2764      }
2765    
2766      my %func_colors;
2767      my $count = 1;
2768      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2769        $func_colors{$key}=$count;
2770        $count++;
2771      }
2772    
2773      return \%func_colors;
2774    }
2775    
2776    sub get_essentially_identical{
2777        my ($fid,$dataset,$fig) = @_;
2778        #my $fig = new FIG;
2779    
2780        my %id_list;
2781        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2782    
2783        foreach my $thing (@$dataset){
2784            if($thing->class eq "IDENTICAL"){
2785                my $rows = $thing->rows;
2786                my $count_identical = 0;
2787                foreach my $row (@$rows) {
2788                    my $id = $row->[0];
2789                    if (($id ne $fid) && ($fig->function_of($id))) {
2790                        $id_list{$id} = 1;
2791                    }
2792                }
2793            }
2794        }
2795    
2796    #    foreach my $id (@maps_to) {
2797    #        if (($id ne $fid) && ($fig->function_of($id))) {
2798    #           $id_list{$id} = 1;
2799    #        }
2800    #    }
2801        return(%id_list);
2802    }
2803    
2804    
2805    sub get_evidence_column{
2806        my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2807        my ($column, $code_attributes);
2808    
2809        if (! defined $attributes) {
2810            my @attributes_array = $fig->get_attributes($ids);
2811            $attributes = \@attributes_array;
2812        }
2813    
2814        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2815        foreach my $key (@codes){
2816            push (@{$code_attributes->{$key->[0]}}, $key);
2817        }
2818    
2819        foreach my $id (@$ids){
2820            # add evidence code with tool tip
2821            my $ev_codes=" &nbsp; ";
2822    
2823            my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2824            my @ev_codes = ();
2825            foreach my $code (@codes) {
2826                my $pretty_code = $code->[2];
2827                if ($pretty_code =~ /;/) {
2828                    my ($cd, $ss) = split(";", $code->[2]);
2829                    if ($cd =~ /ilit|dlit/){
2830                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2831                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2832                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2833                    }
2834                    $ss =~ s/_/ /g;
2835                    $pretty_code = $cd;# . " in " . $ss;
2836                }
2837                push(@ev_codes, $pretty_code);
2838            }
2839    
2840            if (scalar(@ev_codes) && $ev_codes[0]) {
2841                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2842                $ev_codes = $cgi->a(
2843                                    {
2844                                        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));
2845            }
2846    
2847            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2848            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2849        }
2850        return $column;
2851    }
2852    
2853    sub get_attrb_column{
2854        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2855    
2856        my ($column, %code_attributes, %attribute_locations);
2857        my $dbmaster = DBMaster->new(-database =>'Ontology',
2858                                     -host     => $WebConfig::DBHOST,
2859                                     -user     => $WebConfig::DBUSER,
2860                                     -password => $WebConfig::DBPWD);
2861    
2862        if ($colName eq "pfam"){
2863            if (! defined $attributes) {
2864                my @attributes_array = $fig->get_attributes($ids);
2865                $attributes = \@attributes_array;
2866            }
2867    
2868            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2869            foreach my $key (@codes){
2870                my $name = $key->[1];
2871                if ($name =~ /_/){
2872                    ($name) = ($key->[1]) =~ /(.*?)_/;
2873                }
2874                push (@{$code_attributes{$key->[0]}}, $name);
2875                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2876            }
2877    
2878            foreach my $id (@$ids){
2879                # add pfam code
2880                my $pfam_codes=" &nbsp; ";
2881                my @pfam_codes = "";
2882                my %description_codes;
2883    
2884                if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2885                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2886                    @pfam_codes = ();
2887    
2888                    # get only unique values
2889                    my %saw;
2890                    foreach my $key (@ncodes) {$saw{$key}=1;}
2891                    @ncodes = keys %saw;
2892    
2893                    foreach my $code (@ncodes) {
2894                        my @parts = split("::",$code);
2895                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2896    
2897    #                   # get the locations for the domain
2898    #                   my @locs;
2899    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2900    #                       my ($loc) = ($part) =~ /\;(.*)/;
2901    #                       push (@locs,$loc);
2902    #                   }
2903    #                   my %locsaw;
2904    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2905    #                   @locs = keys %locsaw;
2906    #
2907    #                   my $locations = join (", ", @locs);
2908    #
2909                        if (defined ($description_codes{$parts[1]})){
2910                            push(@pfam_codes, "$parts[1]");
2911                        }
2912                        else {
2913                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2914                            $description_codes{$parts[1]} = $description->[0]->{term};
2915                            push(@pfam_codes, "$pfam_link");
2916                        }
2917                    }
2918    
2919                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2920                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2921              }              }
             my $in_sub_line = join ("<br>", @subsystems);  
             $column{$id} = $in_sub_line;  
         } else {  
             $column{$id} = "&nbsp;";  
2922          }          }
2923      }      }
2924      return (%column);      elsif ($colName eq 'cellular_location'){
2925            if (! defined $attributes) {
2926                my @attributes_array = $fig->get_attributes($ids);
2927                $attributes = \@attributes_array;
2928  }  }
2929    
2930  sub get_essentially_identical{          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2931      my ($fid) = @_;          foreach my $key (@codes){
2932      my $fig = new FIG;              my ($loc) = ($key->[1]) =~ /::(.*)/;
2933                my ($new_loc, @all);
2934      my %id_list;              @all = split (//, $loc);
2935      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);              my $count = 0;
2936                foreach my $i (@all){
2937      foreach my $id (@maps_to) {                  if ( ($i eq uc($i)) && ($count > 0) ){
2938          if (($id ne $fid) && ($fig->function_of($id))) {                      $new_loc .= " " . $i;
             $id_list{$id} = 1;  
2939          }          }
2940                    else{
2941                        $new_loc .= $i;
2942      }      }
2943      return(%id_list);                  $count++;
2944                }
2945                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2946  }  }
2947    
2948            foreach my $id (@$ids){
2949                my (@values, $entry);
2950                #@values = (" ");
2951                if (defined @{$code_attributes{$id}}){
2952                    my @ncodes = @{$code_attributes{$id}};
2953                    foreach my $code (@ncodes){
2954                        push (@values, $code->[0] . ", " . $code->[1]);
2955                    }
2956                }
2957                else{
2958                    @values = ("Not available");
2959                }
2960    
2961  sub get_evidence_column{              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2962      my ($ids) = @_;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2963      my $fig = new FIG;          }
2964      my $cgi = new CGI;      }
2965      my (%column, %code_attributes);      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2966                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2967            if (! defined $attributes) {
2968                my @attributes_array = $fig->get_attributes($ids);
2969                $attributes = \@attributes_array;
2970            }
2971    
2972      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2973      foreach my $key (@codes){      foreach my $key (@codes){
2974          push (@{$code_attributes{$$key[0]}}, $key);              push (@{$code_attributes{$key->[0]}}, $key->[2]);
2975      }      }
2976    
2977      foreach my $id (@$ids){      foreach my $id (@$ids){
2978          # add evidence code with tool tip              my (@values, $entry);
2979          my $ev_codes=" &nbsp; ";              #@values = (" ");
2980          my @ev_codes = "";              if (defined @{$code_attributes{$id}}){
2981                    my @ncodes = @{$code_attributes{$id}};
2982          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {                  foreach my $code (@ncodes){
2983              my @codes;                      push (@values, $code);
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
             foreach my $code (@codes) {  
                 my $pretty_code = $code->[2];  
                 if ($pretty_code =~ /;/) {  
                     my ($cd, $ss) = split(";", $code->[2]);  
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
2984                  }                  }
                 push(@ev_codes, $pretty_code);  
2985              }              }
2986                else{
2987                    @values = ("Not available");
2988          }          }
2989    
2990          if (scalar(@ev_codes) && $ev_codes[0]) {              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2991              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
             $ev_codes = $cgi->a(  
                                 {  
                                     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));  
2992          }          }
         $column{$id}=$ev_codes;  
2993      }      }
2994      return (%column);      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2995                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2996                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2997                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2998                ($colName eq 'gc_content') ) {
2999            if (! defined $attributes) {
3000                my @attributes_array = $fig->get_attributes(undef,$attrbName);
3001                $attributes = \@attributes_array;
3002  }  }
3003    
3004  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my $genomes_with_phenotype;
3005            foreach my $attribute (@$attributes){
3006  sub get_prefer {              my $genome = $attribute->[0];
3007      my ($fid, $db) = @_;              $genomes_with_phenotype->{$genome} = $attribute->[2];
3008      my $fig = new FIG;          }
     my $cgi = new CGI;  
   
     my @aliases = $fig->feature_aliases($fid);  
3009    
3010      foreach my $alias (@aliases){          foreach my $id (@$ids){
3011          my $id_db = &Observation::get_database($alias);              my $genome = $fig->genome_of($id);
3012          if ($id_db eq $db){              my @values = (' ');
3013              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              if (defined $genomes_with_phenotype->{$genome}){
3014              return ($acc_col);                  push (@values, $genomes_with_phenotype->{$genome});
3015          }          }
3016                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
3017                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
3018      }      }
     return (" ");  
3019  }  }
3020    
3021  sub color {      return $column;
     my ($evalue) = @_;  
   
     my $color;  
     if ($evalue <= 1e-170){  
         $color = 51;  
3022      }      }
3023      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
3024          $color = 52;  sub get_aclh_aliases {
3025        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3026        my $db_array;
3027    
3028        my $id_line = join (",", @$ids);
3029        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
3030    
3031    
3032      }      }
3033      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){  
3034          $color = 53;  sub get_id_aliases {
3035        my ($id, $fig) = @_;
3036        my $aliases = {};
3037    
3038        my $org = $fig->org_of($id);
3039        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3040        if ( my $form = &LWP::Simple::get($url) ) {
3041            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3042            foreach my $line (split /\n/, $block){
3043                my @values = split /\t/, $line;
3044                next if ($values[3] eq "Expert");
3045                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3046                    $aliases->{$values[4]} = $values[0];
3047      }      }
     elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
         $color = 54;  
3048      }      }
     elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
         $color = 55;  
3049      }      }
3050      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){  
3051          $color = 56;      return $aliases;
3052      }      }
3053      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
3054          $color = 57;  sub get_db_aliases {
3055        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3056        my $db_array;
3057        my $all_aliases = $fig->feature_aliases_bulk($ids);
3058        foreach my $id (@$ids){
3059    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3060            my $id_org = $fig->org_of($id);
3061    
3062            foreach my $alias (@{$$all_aliases{$id}}){
3063    #       foreach my $alias (@all_aliases){
3064                my $id_db = &Observation::get_database($alias);
3065                next if ( ($id_db ne $db) && ($db ne 'all') );
3066                next if ($aliases->{$id}->{$db});
3067                my $alias_org = $fig->org_of($alias);
3068    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3069                    #push(@funcs, [$id,$id_db,$tmp]);
3070                    $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3071    #           }
3072      }      }
3073      elsif (($evalue <= 1) && ($evalue > 1e-5)){          if (!defined( $aliases->{$id}->{$db})){
3074          $color = 58;              $aliases->{$id}->{$db} = " ";
3075      }      }
3076      elsif (($evalue <= 10) && ($evalue > 1)){          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3077          $color = 59;          push (@$db_array, $aliases->{$id}->{$db});
3078      }      }
3079      else{  
3080          $color = 60;      if ($returnType eq 'hash') { return $aliases; }
3081        elsif ($returnType eq 'array') { return $db_array; }
3082      }      }
3083    
3084    
3085    
3086    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
3087    
3088    sub color {
3089        my ($evalue) = @_;
3090        my $palette = WebColors::get_palette('vitamins');
3091        my $color;
3092        if ($evalue <= 1e-170){        $color = $palette->[0];    }
3093        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3094        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3095        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3096        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3097        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3098        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3099        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3100        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3101        else{        $color = $palette->[9];    }
3102      return ($color);      return ($color);
3103  }  }
3104    
# Line 1981  Line 3118 
3118  }  }
3119    
3120  sub display {  sub display {
3121      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3122    
3123        $taxes = $fig->taxonomy_list();
3124    
3125      my $fid = $self->fig_id;      my $fid = $self->fig_id;
3126      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
3127      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
3128      my $fig = new FIG;      my $range = $gd_window_size;
3129      my $all_regions = [];      my $all_regions = [];
3130        my $gene_associations={};
3131    
3132      #get the organism genome      #get the organism genome
3133      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
3134        $gene_associations->{$fid}->{"organism"} = $target_genome;
3135        $gene_associations->{$fid}->{"main_gene"} = $fid;
3136        $gene_associations->{$fid}->{"reverse_flag"} = 0;
3137    
3138      # get location of the gene      # get location of the gene
3139      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 2007  Line 3150 
3150      my ($region_start, $region_end);      my ($region_start, $region_end);
3151      if ($beg < $end)      if ($beg < $end)
3152      {      {
3153          $region_start = $beg - 4000;          $region_start = $beg - ($range);
3154          $region_end = $end+4000;          $region_end = $end+ ($range);
3155          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
3156      }      }
3157      else      else
3158      {      {
3159          $region_start = $end-4000;          $region_start = $end-($range);
3160          $region_end = $beg+4000;          $region_end = $beg+($range);
3161          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
3162          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
3163            $gene_associations->{$fid}->{"reverse_flag"} = 1;
3164      }      }
3165    
3166      # call genes in region      # call genes in region
3167      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);
3168        #foreach my $feat (@$target_gene_features){
3169        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
3170        #}
3171      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
3172      my (@start_array_region);      my (@start_array_region);
3173      push (@start_array_region, $offset);      push (@start_array_region, $offset);
3174    
3175      my %all_genes;      my %all_genes;
3176      my %all_genomes;      my %all_genomes;
3177      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}      foreach my $feature (@$target_gene_features){
3178            #if ($feature =~ /peg/){
3179      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3180      {          #}
         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 = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
3181                  }                  }
3182    
3183                  push (@start_array_region, $offset);      my @selected_sims;
3184    
3185                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
3186                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
3187                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
3188                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
3189            # get the similarities and store only the ones that match the lineages selected
3190            if (@selected_taxonomy > 0){
3191                foreach my $sim (@$sims_array){
3192                    next if ($sim->class ne "SIM");
3193                    next if ($sim->acc !~ /fig\|/);
3194    
3195                    #my $genome = $fig->genome_of($sim->[1]);
3196                    my $genome = $fig->genome_of($sim->acc);
3197                    #my ($genome1) = ($genome) =~ /(.*)\./;
3198                    my $lineage = $taxes->{$genome};
3199                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3200                    foreach my $taxon(@selected_taxonomy){
3201                        if ($lineage =~ /$taxon/){
3202                            #push (@selected_sims, $sim->[1]);
3203                            push (@selected_sims, $sim->acc);
3204              }              }
             $coup_count++;  
         }  
     }  
   
     elsif ($compare_or_coupling eq "close")  
     {  
         # make a hash of genomes that are phylogenetically close  
         #my $close_threshold = ".26";  
         #my @genomes = $fig->genomes('complete');  
         #my %close_genomes = ();  
         #foreach my $compared_genome (@genomes)  
         #{  
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($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 = ($2+(($3-$2)/2))-($gd_window_size/2);  
3205                      }                      }
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = $peg1;  
3206                      }                      }
   
                     push (@start_array_region, $offset);  
                     $all_genomes{$pair_genome} = 1;  
                     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;}  
3207                  }                  }
3208            else{
3209                my $simcount = 0;
3210                foreach my $sim (@$sims_array){
3211                    next if ($sim->class ne "SIM");
3212                    next if ($sim->acc !~ /fig\|/);
3213    
3214                    push (@selected_sims, $sim->acc);
3215                    $simcount++;
3216                    last if ($simcount > 4);
3217              }              }
3218          }          }
3219    
3220            my %saw;
3221            @selected_sims = grep(!$saw{$_}++, @selected_sims);
3222    
3223            # get the gene context for the sorted matches
3224            foreach my $sim_fid(@selected_sims){
3225                #get the organism genome
3226                my $sim_genome = $fig->genome_of($sim_fid);
3227                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
3228                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
3229                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
3230    
3231                # get location of the gene
3232                my $data = $fig->feature_location($sim_fid);
3233                my ($contig, $beg, $end);
3234    
3235                if ($data =~ /(.*)_(\d+)_(\d+)$/){
3236                    $contig = $1;
3237                    $beg = $2;
3238                    $end = $3;
3239      }      }
3240    
3241      # get the PCH to each of the genes              my $offset;
3242      my $pch_sets = [];              my ($region_start, $region_end);
3243      my %pch_already;              if ($beg < $end)
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){(next);};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
3244          {          {
3245              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
3246                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
3247                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
3248          }          }
3249          else          else
3250          {          {
3251              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
3252                  $peg_rank{$peg} = "20";                  $region_end = $beg+($range/2);
3253              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3254                    $reverse_flag{$sim_genome} = $sim_fid;
3255                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
3256          }          }
3257    
3258                # call genes in region
3259                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
3260                push(@$all_regions,$sim_gene_features);
3261                push (@start_array_region, $offset);
3262                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
3263                $all_genomes{$sim_genome} = 1;
3264      }      }
3265    
3266        }
3267    
3268  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3269  #    my %already;      # cluster the genes
3270  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
3271  #       if($already{$gene_key}){(next);}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3272  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3273  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs,1);
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #(next) if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = "20";  
 #           }  
 #       }  
 #    }  
3274    
3275      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3276          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3277          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3278          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3279          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3280            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3281            my $lineage = $taxes->{$region_genome};
3282            #my $lineage = $fig->taxonomy_of($region_genome);
3283            #$region_gs .= "Lineage:$lineage";
3284          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3285                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3286                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2247  Line 3288 
3288    
3289          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3290    
3291          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3292                                     'short_title' => "",                                     'short_title' => "",
3293                                     'basepair_offset' => '0'                                     'basepair_offset' => '0',
3294                                       'no_middle_line' => '1'
3295                                     };                                     };
3296    
3297          my $line_data = [];          my $line_data = [];
# Line 2266  Line 3308 
3308              my $links_list = [];              my $links_list = [];
3309              my $descriptions = [];              my $descriptions = [];
3310    
3311              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
3312    
3313              # get subsystem information              # get subsystem information
3314              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3315              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3316    
3317              my $link;              my $link;
3318              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3319                       "link" => $url_link};                       "link" => $url_link};
3320              push(@$links_list,$link);              push(@$links_list,$link);
3321    
3322              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3323              foreach my $subsystem (@subsystems){              my @subsystems;
3324                foreach my $array (@subs){
3325                    my $subsystem = $$array[0];
3326                    my $ss = $subsystem;
3327                    $ss =~ s/_/ /ig;
3328                    push (@subsystems, $ss);
3329                  my $link;                  my $link;
3330                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3331                           "link_title" => $subsystem};                           "link_title" => $ss};
3332                    push(@$links_list,$link);
3333                }
3334    
3335                if ($fid1 eq $fid){
3336                    my $link;
3337                    $link = {"link_title" => "Annotate this sequence",
3338                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3339                  push(@$links_list,$link);                  push(@$links_list,$link);
3340              }              }
3341    
# Line 2315  Line 3369 
3369                  $prev_stop = $stop;                  $prev_stop = $stop;
3370                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3371    
3372                  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})){
3373                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3374                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3375                  }                  }
3376    
3377                    my $title = $fid1;
3378                    if ($fid1 eq $fid){
3379                        $title = "My query gene: $fid1";
3380                    }
3381    
3382                  $element_hash = {                  $element_hash = {
3383                      "title" => $fid1,                      "title" => $title,
3384                      "start" => $start,                      "start" => $start,
3385                      "end" =>  $stop,                      "end" =>  $stop,
3386                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2335  Line 3394 
3394                  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;}
3395                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3396    
3397                    if ($fid1 eq $fid){
3398                        $element_hash = {
3399                            "title" => 'Query',
3400                            "start" => $start,
3401                            "end" =>  $stop,
3402                            "type"=> 'bigbox',
3403                            "color"=> $color,
3404                            "zlayer" => "1"
3405                            };
3406    
3407                        # if there is an overlap, put into second line
3408                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3409                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3410                    }
3411              }              }
3412          }          }
3413          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3414          $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);
3415        }
3416        return ($gd, \@selected_sims);
3417    }
3418    
3419    sub cluster_genes {
3420        my($fig,$all_pegs,$peg) = @_;
3421        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3422    
3423        my @color_sets = ();
3424    
3425        $conn = &get_connections_by_similarity($fig,$all_pegs);
3426    
3427        for ($i=0; ($i < @$all_pegs); $i++) {
3428            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3429            if (! $seen{$i}) {
3430                $cluster = [$i];
3431                $seen{$i} = 1;
3432                for ($j=0; ($j < @$cluster); $j++) {
3433                    $x = $conn->{$cluster->[$j]};
3434                    foreach $k (@$x) {
3435                        if (! $seen{$k}) {
3436                            push(@$cluster,$k);
3437                            $seen{$k} = 1;
3438                        }
3439                    }
3440                }
3441    
3442                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3443                    push(@color_sets,$cluster);
3444                }
3445            }
3446        }
3447        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3448        $red_set = $color_sets[$i];
3449        splice(@color_sets,$i,1);
3450        @color_sets = sort { @$b <=> @$a } @color_sets;
3451        unshift(@color_sets,$red_set);
3452    
3453        my $color_sets = {};
3454        for ($i=0; ($i < @color_sets); $i++) {
3455            foreach $x (@{$color_sets[$i]}) {
3456                $color_sets->{$all_pegs->[$x]} = $i;
3457            }
3458        }
3459        return $color_sets;
3460    }
3461    
3462    sub get_connections_by_similarity {
3463        my($fig,$all_pegs) = @_;
3464        my($i,$j,$tmp,$peg,%pos_of);
3465        my($sim,%conn,$x,$y);
3466    
3467        for ($i=0; ($i < @$all_pegs); $i++) {
3468            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3469            push(@{$pos_of{$tmp}},$i);
3470            if ($tmp ne $all_pegs->[$i]) {
3471                push(@{$pos_of{$all_pegs->[$i]}},$i);
3472      }      }
     return $gd;  
3473  }  }
3474    
3475        foreach $y (keys(%pos_of)) {
3476            $x = $pos_of{$y};
3477            for ($i=0; ($i < @$x); $i++) {
3478                for ($j=$i+1; ($j < @$x); $j++) {
3479                    push(@{$conn{$x->[$i]}},$x->[$j]);
3480                    push(@{$conn{$x->[$j]}},$x->[$i]);
3481                }
3482            }
3483        }
3484    
3485        for ($i=0; ($i < @$all_pegs); $i++) {
3486            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3487                if (defined($x = $pos_of{$sim->id2})) {
3488                    foreach $y (@$x) {
3489                        push(@{$conn{$i}},$y);
3490                    }
3491                }
3492            }
3493        }
3494        return \%conn;
3495    }
3496    
3497    sub in {
3498        my($x,$xL) = @_;
3499        my($i);
3500    
3501        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3502        return ($i < @$xL);
3503    }
3504    
3505    #############################################
3506    #############################################
3507    package Observation::Commentary;
3508    
3509    use base qw(Observation);
3510    
3511    =head3 display_protein_commentary()
3512    
3513    =cut
3514    
3515    sub display_protein_commentary {
3516        my ($self,$dataset,$mypeg,$fig) = @_;
3517    
3518        my $all_rows = [];
3519        my $content;
3520        #my $fig = new FIG;
3521        my $cgi = new CGI;
3522        my $count = 0;
3523        my $peg_array = [];
3524        my ($evidence_column, $subsystems_column,  %e_identical);
3525    
3526        if (@$dataset != 1){
3527            foreach my $thing (@$dataset){
3528                if ($thing->class eq "SIM"){
3529                    push (@$peg_array, $thing->acc);
3530                }
3531            }
3532            # get the column for the evidence codes
3533            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3534    
3535            # get the column for the subsystems
3536            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3537    
3538            # get essentially identical seqs
3539            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3540        }
3541        else{
3542            push (@$peg_array, @$dataset);
3543        }
3544    
3545        my $selected_sims = [];
3546        foreach my $id (@$peg_array){
3547            last if ($count > 10);
3548            my $row_data = [];
3549            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3550            if ($fig->org_of($id)){
3551                $org = $fig->org_of($id);
3552            }
3553            else{
3554                $org = "Data not available";
3555            }
3556            $function = $fig->function_of($id);
3557            if ($mypeg ne $id){
3558                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3559                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3560                if (defined($e_identical{$id})) { $id_cell .= "*";}
3561            }
3562            else{
3563                $function_cell = "&nbsp;&nbsp;$function";
3564                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3565                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3566            }
3567    
3568            push(@$row_data,$id_cell);
3569            push(@$row_data,$org);
3570            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3571            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3572            push(@$row_data, $fig->translation_length($id));
3573            push(@$row_data,$function_cell);
3574            push(@$all_rows,$row_data);
3575            push (@$selected_sims, $id);
3576            $count++;
3577        }
3578    
3579        if ($count >0){
3580            $content = $all_rows;
3581        }
3582        else{
3583            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3584        }
3585        return ($content,$selected_sims);
3586    }
3587    
3588    sub display_protein_history {
3589        my ($self, $id,$fig) = @_;
3590        my $all_rows = [];
3591        my $content;
3592    
3593        my $cgi = new CGI;
3594        my $count = 0;
3595        foreach my $feat ($fig->feature_annotations($id)){
3596            my $row = [];
3597            my $col1 = $feat->[2];
3598            my $col2 = $feat->[1];
3599            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3600            my $text = $feat->[3];
3601    
3602            push (@$row, $col1);
3603            push (@$row, $col2);
3604            push (@$row, $text);
3605            push (@$all_rows, $row);
3606            $count++;
3607        }
3608        if ($count > 0){
3609            $content = $all_rows;
3610        }
3611        else {
3612            $content = "There is no history for this PEG";
3613        }
3614    
3615        return($content);
3616    }
3617    

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.80

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3