[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.24, Tue Jul 10 20:11:38 2007 UTC revision 1.77, Mon May 18 20:26:44 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 strict;  use LWP::Simple;
15    #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 151  Line 167 
167  sub type {  sub type {
168    my ($self) = @_;    my ($self) = @_;
169    
170    return $self->{acc};    return $self->{type};
171  }  }
172    
173  =head3 start()  =head3 start()
# 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=();
# Line 317  Line 333 
333      }      }
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          $domain_classes{'CDD'} = 1;          my @attributes = $fig->get_attributes($fid);
337          get_identical_proteins($fid,\@matched_datasets);          #$domain_classes{'CDD'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
339          get_sims_observations($fid,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          get_pdb_observations($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets,$fig);
343            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 331  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 357  Line 375 
375    
376  }  }
377    
378    =head3 get_attributes
379        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
393    
394    sub get_sims_objects {
395        my ($self,$fid,$fig,$parameters) = @_;
396    
397        my $objects = [];
398        my @matched_datasets=();
399    
400        # call function that fetches attribute based observations
401        # returns an array of arrays of hashes
402        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
403    
404        foreach my $dataset (@matched_datasets) {
405            my $object;
406            if ($dataset->{'class'} eq "SIM"){
407                $object = Observation::Sims->new($dataset);
408            }
409            push (@$objects, $object);
410        }
411        return $objects;
412    }
413    
414    
415    =head3 display_housekeeping
416    This method returns the housekeeping data for a given peg in a table format
417    
418    =cut
419    sub display_housekeeping {
420        my ($self,$fid,$fig) = @_;
421        my $content = [];
422        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        push(@$content, $row);
448    
449        return ($content);
450    }
451    
452    =head3 get_sims_summary
453    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
454    
455    =cut
456    
457    sub get_sims_summary {
458        my ($observation, $dataset, $fig) = @_;
459        my %families;
460        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            my $genome = $fig->genome_of($id);
477            #my ($genome1) = ($genome) =~ /(.*)\./;
478            my $taxonomy = $taxes->{$genome};
479            my $parent_tax = "Root";
480            my @currLineage = ($parent_tax);
481            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;
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;
504              $level++;
505            }
506        }
507    
508        foreach my $key (keys %{$families{children}}){
509            $families{count}{$key} = @{$families{children}{$key}};
510    
511            my %saw;
512            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
513            $families{children}{$key} = \@out;
514        }
515    
516        return \%families;
517    }
518    
519  =head1 Internal Methods  =head1 Internal Methods
520    
521  These methods are not meant to be used outside of this package.  These methods are not meant to be used outside of this package.
# Line 365  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) = (@_);  
544    
545      my $fig = new FIG;  sub get_attribute_based_domain_observations{
546    
547      foreach my $attr_ref ($fig->get_attributes($fid)) {      # 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) {
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 384  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 411  Line 597 
597    
598  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
599    
600      my ($fid,$datasets_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'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
604    
605      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      my $dataset = {'type' => "loc",
606      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
607                       'fig_id' => $fid
608                       };
609    
610        foreach my $attr_ref (@$attributes_ref){
611          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
612            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
613          my @parts = split("::",$key);          my @parts = split("::",$key);
614          my $sub_class = $parts[0];          my $sub_class = $parts[0];
615          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 433  Line 624 
624                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
625              }              }
626          }          }
627    
628          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
629              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
630              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
631          }          }
632    
633            elsif($sub_class eq "Phobius"){
634                if($sub_key eq "transmembrane"){
635                    $dataset->{'phobius_tm_locations'} = $value;
636                }
637                elsif($sub_key eq "signal"){
638                    $dataset->{'phobius_signal_location'} = $value;
639                }
640            }
641    
642          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
643              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
644              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
645              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
646          }          }
# Line 455  Line 657 
657  =cut  =cut
658    
659  sub get_pdb_observations{  sub get_pdb_observations{
660      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
661    
662      my $fig = new FIG;      #my $fig = new FIG;
   
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
663    
664        foreach my $attr_ref (@$attributes_ref){
665          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
666            next if ( ($key !~ /PDB/));
667          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
668          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
669          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 513  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 ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
721        if ( (defined $parameters->{flag}) && ($parameters->{flag})){
722          $max_sims = $parameters->{max_sims};
723          $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 ($fid,$datasets_ref) = (@_);      my($id, $genome, @genomes, %sims);
747      my $fig = new FIG;  #    my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
748      my @sims= $fig->nsims($fid,100,1e-20,"all");      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);      my ($dataset);
751      foreach my $sim (@sims){  
752        if ($group_by_genome){
753          #  Collect all sims from genome with the first occurance of the genome:
754          foreach $sim ( @tmp ){
755            $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 $seen_sims={};
764        my $count=1;
765        foreach my $sim (@tmp){
766    
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 530  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 562  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" }
832      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
833      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
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 587  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    
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);
   
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))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
# Line 601  Line 865 
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 621  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 632  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 750  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 781  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    
     print STDERR "acc:$acc\n";  
1050      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
1051      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
1052      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 806  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 910  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 923  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($fid);          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 974  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 989  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 1031  Line 1293 
1293  sub display {  sub display {
1294      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1295      my $lines = [];      my $lines = [];
1296      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1297                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1298                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1299      my $color = "4";      my $color = "4";
1300    
1301      my $line_data = [];      my $line_data = [];
# Line 1043  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 $short_title = $thing->acc;
1341        $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' };
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 1094  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 1109  Line 1400 
1400    
1401  }  }
1402    
1403    sub display_table {
1404        my ($self,$dataset) = @_;
1405        my $cgi = new CGI;
1406        my $data = [];
1407        my $count = 0;
1408        my $content;
1409        my $seen = {};
1410    
1411        foreach my $thing (@$dataset) {
1412            next if ($thing->type !~ /dom/);
1413            my $single_domain = [];
1414            $count++;
1415    
1416            my $db_and_id = $thing->acc;
1417            my ($db,$id) = split("::",$db_and_id);
1418    
1419            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);
1425    
1426            my $new_id;
1427            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";
1442                    $name_value = "not available";
1443                    $description_title = "description";
1444                    $description_value = "not available";
1445                }
1446                else{
1447                    my $pfam_obj = $pfam_objs->[0];
1448                    $name_title = "name";
1449                    $name_value = $pfam_obj->term;
1450                    #$description_title = "description";
1451                    #$description_value = $pfam_obj->description;
1452                }
1453            }
1454    
1455            my $location =  $thing->start . " - " . $thing->stop;
1456    
1457            push(@$single_domain,$db);
1458            push(@$single_domain,$new_id);
1459            push(@$single_domain,$name_value);
1460            push(@$single_domain,$location);
1461            push(@$single_domain,$thing->evalue);
1462            push(@$single_domain,$description_value);
1463            push(@$data,$single_domain);
1464        }
1465    
1466        if ($count >0){
1467            $content = $data;
1468        }
1469        else
1470        {
1471            $content = "<p>This PEG does not have any similarities to domains</p>";
1472        }
1473    }
1474    
1475    
1476  #########################################  #########################################
1477  #########################################  #########################################
1478  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1490 
1490      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1491      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1492      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1493        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1494        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1495    
1496      bless($self,$class);      bless($self,$class);
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 1147  Line 1525 
1525      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1526      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1527    
1528        my $phobius_signal_location = $thing->phobius_signal_location;
1529        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1530    
1531      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1532    
1533      #color is      #color is
1534      my $color = "5";      my $color = "6";
   
     my $line_data = [];  
   
     if($cello_location){  
         my $cello_descriptions = [];  
         my $description_cello_location = {"title" => 'Best Cello Location',  
                                           "value" => $cello_location};  
1535    
         push(@$cello_descriptions,$description_cello_location);  
1536    
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
1537    
1538          push(@$cello_descriptions,$description_cello_score);  #    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    
         my $element_hash = {  
             "title" => "CELLO",  
             "start" => "1",  
             "end" =>  $length + 1,  
             "color"=> $color,  
             "type" => 'box',  
             "zlayer" => '2',  
             "description" => $cello_descriptions};  
1599    
1600          push(@$line_data,$element_hash);      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1601      }          my $line_data =[];
1602            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1603                                'short_title' => 'TM and SP',
1604                                'hover_title' => 'Localization',
1605                                'basepair_offset' => '1' };
1606    
1607      my $color = "6";          foreach my $tm_loc (@phobius_tm_locations){
     if($tmpred_score){  
         foreach my $tmpred (@tmpred_locations){  
1608              my $descriptions = [];              my $descriptions = [];
1609              my ($begin,$end) =split("-",$tmpred);              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1610              my $description_tmpred_score = {"title" => 'TMPRED score',                               "value" => $tm_loc};
1611                               "value" => $tmpred_score};              push(@$descriptions,$description_phobius_tm_locations);
1612    
1613              push(@$descriptions,$description_tmpred_score);              my ($begin,$end) =split("-",$tm_loc);
1614    
1615              my $element_hash = {              my $element_hash = {
1616              "title" => "transmembrane location",              "title" => "Phobius",
1617              "start" => $begin + 1,              "start" => $begin + 1,
1618              "end" =>  $end + 1,              "end" =>  $end + 1,
1619              "color"=> $color,              "color"=> '6',
1620              "zlayer" => '5',              "zlayer" => '4',
1621              "type" => 'smallbox',              "type" => 'bigbox',
1622              "description" => $descriptions};              "description" => $descriptions};
1623    
1624              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1625          }  
1626      }      }
1627    
1628      my $color = "1";          if($phobius_signal_location){
     if($signal_peptide_score){  
1629          my $descriptions = [];          my $descriptions = [];
1630          my $description_signal_peptide_score = {"title" => 'signal peptide score',              my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1631                                                  "value" => $signal_peptide_score};                               "value" => $phobius_signal_location};
1632                push(@$descriptions,$description_phobius_signal_location);
         push(@$descriptions,$description_signal_peptide_score);  
   
         my $description_cleavage_prob = {"title" => 'cleavage site probability',  
                                          "value" => $cleavage_prob};  
1633    
         push(@$descriptions,$description_cleavage_prob);  
1634    
1635                my ($begin,$end) =split("-",$phobius_signal_location);
1636          my $element_hash = {          my $element_hash = {
1637              "title" => "SignalP",              "title" => "phobius signal locations",
1638              "start" => $cleavage_loc_begin - 2,              "start" => $begin + 1,
1639              "end" =>  $cleavage_loc_end + 3,              "end" =>  $end + 1,
1640              "type" => 'bigbox',              "color"=> '1',
1641              "color"=> $color,              "zlayer" => '5',
1642              "zlayer" => '10',              "type" => 'box',
1643              "description" => $descriptions};              "description" => $descriptions};
   
1644          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1645      }      }
1646    
1647      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1648        }
1649    
1650    
1651    #    $color = "1";
1652    #    if($signal_peptide_score){
1653    #       my $line_data = [];
1654    #       my $descriptions = [];
1655    #
1656    #       my $line_config = { 'title' => 'Localization Evidence',
1657    #                           'short_title' => 'SignalP',
1658    #                            'hover_title' => 'Localization',
1659    #                           'basepair_offset' => '1' };
1660    #
1661    #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1662    #                                               "value" => $signal_peptide_score};
1663    #
1664    #       push(@$descriptions,$description_signal_peptide_score);
1665    #
1666    #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1667    #                                        "value" => $cleavage_prob};
1668    #
1669    #       push(@$descriptions,$description_cleavage_prob);
1670    #
1671    #       my $element_hash = {
1672    #           "title" => "SignalP",
1673    #           "start" => $cleavage_loc_begin - 2,
1674    #           "end" =>  $cleavage_loc_end + 1,
1675    #           "type" => 'bigbox',
1676    #           "color"=> $color,
1677    #           "zlayer" => '10',
1678    #           "description" => $descriptions};
1679    #
1680    #       push(@$line_data,$element_hash);
1681    #       $gd->add_line($line_data, $line_config);
1682    #    }
1683    
1684    
1685      return ($gd);      return ($gd);
1686    
# Line 1277  Line 1728 
1728    return $self->{cello_score};    return $self->{cello_score};
1729  }  }
1730    
1731    sub phobius_signal_location {
1732      my ($self) = @_;
1733      return $self->{phobius_signal_location};
1734    }
1735    
1736  #########################################  sub phobius_tm_locations {
1737  #########################################    my ($self) = @_;
1738      return $self->{phobius_tm_locations};
1739    }
1740    
1741    
1742    
1743    #########################################
1744    #########################################
1745  package Observation::Sims;  package Observation::Sims;
1746    
1747  use base qw(Observation);  use base qw(Observation);
1748    
1749  sub new {  sub new {
1750    
1751      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
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->{evalue} = $dataset->{'evalue'};      $self->{query} = $dataset->{'query'};
1756      $self->{qstart} = $dataset->{'qstart'};      $self->{evalue} = $dataset->{'evalue'};
1757      $self->{qstop} = $dataset->{'qstop'};      $self->{qstart} = $dataset->{'qstart'};
1758      $self->{hstart} = $dataset->{'hstart'};      $self->{qstop} = $dataset->{'qstop'};
1759      $self->{hstop} = $dataset->{'hstop'};      $self->{hstart} = $dataset->{'hstart'};
1760      $self->{database} = $dataset->{'database'};      $self->{hstop} = $dataset->{'hstop'};
1761      $self->{organism} = $dataset->{'organism'};      $self->{database} = $dataset->{'database'};
1762      $self->{function} = $dataset->{'function'};      $self->{organism} = $dataset->{'organism'};
1763      $self->{qlength} = $dataset->{'qlength'};      $self->{function} = $dataset->{'function'};
1764      $self->{hlength} = $dataset->{'hlength'};      $self->{qlength} = $dataset->{'qlength'};
1765        $self->{hlength} = $dataset->{'hlength'};
1766    
1767        bless($self,$class);
1768        return $self;
1769    }
1770    
1771    =head3 display()
1772    
1773    If available use the function specified here to display a graphical observation.
1774    This code will display a graphical view of the similarities using the genome drawer object
1775    
1776    =cut
1777    
1778    sub display {
1779        my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1780    
1781        # 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);
1792        my ($org_tax) = ($genome) =~ /(.*)\./;
1793        my $function = $thing->function;
1794        my $query_start = $thing->qstart;
1795        my $query_stop = $thing->qstop;
1796        my $hit_start = $thing->hstart;
1797        my $hit_stop = $thing->hstop;
1798        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;
1806    
1807        # hit sequence title
1808        my $line_config = { 'title' => "$organism [$org_tax]",
1809                            'short_title' => "$abbrev_name",
1810                            'title_link' => '$tax_link',
1811                            '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 = [];
1826        my $query_data = [];
1827    
1828        my $element_hash;
1829        my $hit_links_list = [];
1830        my $hit_descriptions = [];
1831        my $query_descriptions = [];
1832    
1833        # get sequence information
1834        # evidence link
1835        my $evidence_link;
1836        if ($peg =~ /^fig\|/){
1837          $evidence_link = "?page=Annotation&feature=".$peg;
1838        }
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        # subsystem link
1850        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1851        my @subsystems;
1852        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};
1857            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;
1867        $description_function = {"title" => "function",
1868                                 "value" => $function};
1869        push(@$hit_descriptions,$description_function);
1870    
1871        # subsystem description
1872        my $ss_string = join (",", @subsystems);
1873        $ss_string =~ s/_/ /ig;
1874        my $description_ss = {"title" => "subsystems",
1875                              "value" => $ss_string};
1876        push(@$hit_descriptions,$description_ss);
1877    
1878        # location description
1879        # hit
1880        my $description_loc;
1881        $description_loc = {"title" => "Hit Location",
1882                            "value" => $hit_start . " - " . $hit_stop};
1883        push(@$hit_descriptions, $description_loc);
1884    
1885        $description_loc = {"title" => "Sequence Length",
1886                            "value" => $ln_hit};
1887        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        # evalue score description
1901        my $evalue = $thing->evalue;
1902        while ($evalue =~ /-0/)
1903        {
1904            my ($chunk1, $chunk2) = split(/-/, $evalue);
1905            $chunk2 = substr($chunk2,1);
1906            $evalue = $chunk1 . "-" . $chunk2;
1907        }
1908    
1909        my $color = &color($evalue);
1910        my $description_eval = {"title" => "E-Value",
1911                                "value" => $evalue};
1912        push(@$hit_descriptions, $description_eval);
1913        push(@$query_descriptions, $description_eval);
1914    
1915        my $identity = $self->identity;
1916        my $description_identity = {"title" => "Identity",
1917                                    "value" => $identity};
1918        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 = {
1925            "title" => $query_id,
1926            "start" => $base_start,
1927            "end" => $base_start+$ln_query,
1928            "type"=> 'box',
1929            "color"=> $color,
1930            "zlayer" => "2",
1931            "links_list" => $query_links_list,
1932            "description" => $query_descriptions
1933            };
1934        push(@$query_data,$element_hash);
1935    
1936        $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    
2103    =head3 display_table()
2104    
2105    If available use the function specified here to display the "raw" observation.
2106    This code will display a table for the similarities protein
2107    
2108    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.
2109    
2110    =cut
2111    
2112    sub display_table {
2113        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 $scroll_list;
2117        foreach my $col (@$show_columns){
2118            push (@$scroll_list, $col->{key});
2119        }
2120    
2121        push (@ids, $query_fid);
2122        foreach my $thing (@$dataset) {
2123            next if ($thing->class ne "SIM");
2124            push (@ids, $thing->acc);
2125        }
2126    
2127        $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2128        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2129    
2130        # get the column for the subsystems
2131        $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2132    
2133        # get the column for the evidence codes
2134        $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2135    
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        # 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        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");
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 = [];
2260            $count++;
2261    
2262            # organisms cell
2263            my ($org, $org_color) = $fig->org_and_color_of($id);
2264    
2265            my $org_cell;
2266            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2267                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2268            }
2269            elsif ($next_org eq $organism){
2270                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2271                $same_genome_flag = 1;
2272            }
2273            elsif ($same_genome_flag == 1){
2274                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2275                $same_genome_flag = 0;
2276            }
2277    
2278            # checkbox cell
2279            my ($box_cell,$tax, $radio_cell);
2280            my $field_name = "tables_" . $id;
2281            my $pair_name = "visual_" . $id;
2282            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
2306            my $anchor_link = "graph_" . $replace_id;
2307    
2308            my $fig_data;
2309            if ($id =~ /^fig\|/)
2310            {
2311                $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2312            }
2313            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', $fig->genome_of($id))) {
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 ){
2421            $content = $data;
2422        }
2423        else{
2424            $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        # function cell
2556        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2557    
2558        # insert data
2559        push (@$single_domain, $fig_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2560    
2561        foreach my $col (@$scroll_list){
2562          my $highlight_color = "#ffffff";
2563    
2564          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2565          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2566          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2567          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2568          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2569          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2570          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2571          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2572          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2573          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2574          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2575          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2576          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2577          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2578          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2579          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2580          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2581          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2582          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2583          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2584          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2585          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2586          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2587          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2588          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2589          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2590          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2591          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2592          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2593          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2594          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2595          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2596          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2597        }
2598        push(@$data,$single_domain);
2599      }
2600    
2601      $content = $data;
2602      return ($content);
2603    }
2604    
2605    sub get_box_column{
2606        my ($ids) = @_;
2607        my %column;
2608        foreach my $id (@$ids){
2609            my $field_name = "tables_" . $id;
2610            my $pair_name = "visual_" . $id;
2611            my $cell_name = "cell_" . $id;
2612            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2613        }
2614        return (%column);
2615    }
2616    
2617    sub get_figfam_column{
2618        my ($ids, $fig, $cgi) = @_;
2619        my $column;
2620    
2621        my $figfam_data = &FIG::get_figfams_data();
2622        my $figfams = new FFs($figfam_data);
2623    
2624        foreach my $id (@$ids){
2625            my ($ff);
2626            if ($id =~ /\.peg\./){
2627                ($ff) =  $figfams->families_containing_peg($id);
2628            }
2629            if ($ff){
2630                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2631            }
2632            else{
2633                push (@$column, " ");
2634            }
2635        }
2636    
2637        return $column;
2638    }
2639    
2640    sub get_subsystems_column{
2641        my ($ids,$fig,$cgi,$returnType) = @_;
2642    
2643        my %in_subs  = $fig->subsystems_for_pegs($ids);
2644        my ($column, $ss);
2645        foreach my $id (@$ids){
2646            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2647            my @subsystems;
2648    
2649            if (@in_sub > 0) {
2650                foreach my $array(@in_sub){
2651                    my $ss = $array->[0];
2652                    $ss =~ s/_/ /ig;
2653                    push (@subsystems, "-" . $ss);
2654                }
2655                my $in_sub_line = join ("<br>", @subsystems);
2656                $ss->{$id} = $in_sub_line;
2657            } else {
2658                $ss->{$id} = "None added";
2659            }
2660            push (@$column, $ss->{$id});
2661        }
2662    
2663        if ($returnType eq 'hash') { return $ss; }
2664        elsif ($returnType eq 'array') { return $column; }
2665    }
2666    
2667    sub get_lineage_column{
2668        my ($ids, $fig, $cgi) = @_;
2669    
2670        my $lineages = $fig->taxonomy_list();
2671    
2672        foreach my $id (@$ids){
2673            my $genome = $fig->genome_of($id);
2674            if ($lineages->{$genome}){
2675    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2676                push (@$column, $lineages->{$genome});
2677            }
2678            else{
2679                push (@$column, " ");
2680            }
2681        }
2682        return $column;
2683    }
2684    
2685    sub match_color {
2686        my ( $b, $e, $n , $rgb) = @_;
2687        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2688        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2689        my $cov = ( $r - $l + 1 ) / $n;
2690        my $sat = 1 - 10 * $cov / 9;
2691        my $br  = 1;
2692        if ($rgb){
2693            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2694        }
2695        else{
2696            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2697        }
2698    }
2699    
2700    sub hsb2rgb {
2701        my ( $h, $s, $br ) = @_;
2702        $h = 6 * ($h - floor($h));
2703        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2704        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2705        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2706                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2707                                          :               ( 0,      1,      $h - 2 )
2708                                          )
2709                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2710                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2711                                          :               ( 1,      0,      6 - $h )
2712                                          );
2713        ( ( $r * $s + 1 - $s ) * $br,
2714          ( $g * $s + 1 - $s ) * $br,
2715          ( $b * $s + 1 - $s ) * $br
2716        )
2717    }
2718    
2719    sub html2rgb {
2720        my ($hex) = @_;
2721        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2722        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2723                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2724    
2725        my @R = split(//, $r);
2726        my @G = split(//, $g);
2727        my @B = split(//, $b);
2728    
2729        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2730        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2731        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2732    
2733        my $rgb = [$red, $green, $blue];
2734        return $rgb;
2735    
2736    }
2737    
2738    sub rgb2html {
2739        my ( $r, $g, $b ) = @_;
2740        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2741        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2742        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2743        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2744    }
2745    
2746    sub floor {
2747        my $x = $_[0];
2748        defined( $x ) || return undef;
2749        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2750    }
2751    
2752    sub get_function_color_cell{
2753      my ($functions, $fig) = @_;
2754    
2755      # figure out the quantity of each function
2756      my %hash;
2757      foreach my $key (keys %$functions){
2758        my $func = $functions->{$key};
2759        $hash{$func}++;
2760      }
2761    
2762      my %func_colors;
2763      my $count = 1;
2764      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2765        $func_colors{$key}=$count;
2766        $count++;
2767      }
2768    
2769      return \%func_colors;
2770    }
2771    
2772    sub get_essentially_identical{
2773        my ($fid,$dataset,$fig) = @_;
2774        #my $fig = new FIG;
2775    
2776        my %id_list;
2777        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2778    
2779        foreach my $thing (@$dataset){
2780            if($thing->class eq "IDENTICAL"){
2781                my $rows = $thing->rows;
2782                my $count_identical = 0;
2783                foreach my $row (@$rows) {
2784                    my $id = $row->[0];
2785                    if (($id ne $fid) && ($fig->function_of($id))) {
2786                        $id_list{$id} = 1;
2787                    }
2788                }
2789            }
2790        }
2791    
2792    #    foreach my $id (@maps_to) {
2793    #        if (($id ne $fid) && ($fig->function_of($id))) {
2794    #           $id_list{$id} = 1;
2795    #        }
2796    #    }
2797        return(%id_list);
2798    }
2799    
2800    
2801    sub get_evidence_column{
2802        my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2803        my ($column, $code_attributes);
2804    
2805        if (! defined $attributes) {
2806            my @attributes_array = $fig->get_attributes($ids);
2807            $attributes = \@attributes_array;
2808        }
2809    
2810        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2811        foreach my $key (@codes){
2812            push (@{$code_attributes->{$key->[0]}}, $key);
2813        }
2814    
2815        foreach my $id (@$ids){
2816            # add evidence code with tool tip
2817            my $ev_codes=" &nbsp; ";
2818    
2819            my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2820            my @ev_codes = ();
2821            foreach my $code (@codes) {
2822                my $pretty_code = $code->[2];
2823                if ($pretty_code =~ /;/) {
2824                    my ($cd, $ss) = split(";", $code->[2]);
2825                    if ($cd =~ /ilit|dlit/){
2826                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2827                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2828                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2829                    }
2830                    $ss =~ s/_/ /g;
2831                    $pretty_code = $cd;# . " in " . $ss;
2832                }
2833                push(@ev_codes, $pretty_code);
2834            }
2835    
2836            if (scalar(@ev_codes) && $ev_codes[0]) {
2837                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2838                $ev_codes = $cgi->a(
2839                                    {
2840                                        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));
2841            }
2842    
2843            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2844            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2845        }
2846        return $column;
2847    }
2848    
2849    sub get_attrb_column{
2850        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2851    
2852        my ($column, %code_attributes, %attribute_locations);
2853        my $dbmaster = DBMaster->new(-database =>'Ontology',
2854                                     -host     => $WebConfig::DBHOST,
2855                                     -user     => $WebConfig::DBUSER,
2856                                     -password => $WebConfig::DBPWD);
2857    
2858        if ($colName eq "pfam"){
2859            if (! defined $attributes) {
2860                my @attributes_array = $fig->get_attributes($ids);
2861                $attributes = \@attributes_array;
2862            }
2863    
2864            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2865            foreach my $key (@codes){
2866                my $name = $key->[1];
2867                if ($name =~ /_/){
2868                    ($name) = ($key->[1]) =~ /(.*?)_/;
2869                }
2870                push (@{$code_attributes{$key->[0]}}, $name);
2871                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2872            }
2873    
2874            foreach my $id (@$ids){
2875                # add pfam code
2876                my $pfam_codes=" &nbsp; ";
2877                my @pfam_codes = "";
2878                my %description_codes;
2879    
2880                if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2881                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2882                    @pfam_codes = ();
2883    
2884                    # get only unique values
2885                    my %saw;
2886                    foreach my $key (@ncodes) {$saw{$key}=1;}
2887                    @ncodes = keys %saw;
2888    
2889                    foreach my $code (@ncodes) {
2890                        my @parts = split("::",$code);
2891                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2892    
2893    #                   # get the locations for the domain
2894    #                   my @locs;
2895    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2896    #                       my ($loc) = ($part) =~ /\;(.*)/;
2897    #                       push (@locs,$loc);
2898    #                   }
2899    #                   my %locsaw;
2900    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2901    #                   @locs = keys %locsaw;
2902    #
2903    #                   my $locations = join (", ", @locs);
2904    #
2905                        if (defined ($description_codes{$parts[1]})){
2906                            push(@pfam_codes, "$parts[1]");
2907                        }
2908                        else {
2909                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2910                            $description_codes{$parts[1]} = $description->[0]->{term};
2911                            push(@pfam_codes, "$pfam_link");
2912                        }
2913                    }
2914    
2915                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2916                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2917                }
2918            }
2919        }
2920        elsif ($colName eq 'cellular_location'){
2921            if (! defined $attributes) {
2922                my @attributes_array = $fig->get_attributes($ids);
2923                $attributes = \@attributes_array;
2924            }
2925    
2926            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2927            foreach my $key (@codes){
2928                my ($loc) = ($key->[1]) =~ /::(.*)/;
2929                my ($new_loc, @all);
2930                @all = split (//, $loc);
2931                my $count = 0;
2932                foreach my $i (@all){
2933                    if ( ($i eq uc($i)) && ($count > 0) ){
2934                        $new_loc .= " " . $i;
2935                    }
2936                    else{
2937                        $new_loc .= $i;
2938                    }
2939                    $count++;
2940                }
2941                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2942            }
2943    
2944            foreach my $id (@$ids){
2945                my (@values, $entry);
2946                #@values = (" ");
2947                if (defined @{$code_attributes{$id}}){
2948                    my @ncodes = @{$code_attributes{$id}};
2949                    foreach my $code (@ncodes){
2950                        push (@values, $code->[0] . ", " . $code->[1]);
2951                    }
2952                }
2953                else{
2954                    @values = ("Not available");
2955                }
2956    
2957      bless($self,$class);              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2958      return $self;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2959            }
2960        }
2961        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2962                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2963            if (! defined $attributes) {
2964                my @attributes_array = $fig->get_attributes($ids);
2965                $attributes = \@attributes_array;
2966  }  }
2967    
2968  =head3 display_table()          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2969            foreach my $key (@codes){
2970                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2971            }
2972    
2973  If available use the function specified here to display the "raw" observation.          foreach my $id (@$ids){
2974  This code will display a table for the similarities protein              my (@values, $entry);
2975                #@values = (" ");
2976                if (defined @{$code_attributes{$id}}){
2977                    my @ncodes = @{$code_attributes{$id}};
2978                    foreach my $code (@ncodes){
2979                        push (@values, $code);
2980                    }
2981                }
2982                else{
2983                    @values = ("Not available");
2984                }
2985    
2986  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.              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2987                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2988            }
2989        }
2990        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2991                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2992                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2993                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2994                ($colName eq 'gc_content') ) {
2995            if (! defined $attributes) {
2996                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2997                $attributes = \@attributes_array;
2998            }
2999    
3000  =cut          my $genomes_with_phenotype;
3001            foreach my $attribute (@$attributes){
3002                my $genome = $attribute->[0];
3003                $genomes_with_phenotype->{$genome} = $attribute->[2];
3004            }
3005    
3006  sub display_table {          foreach my $id (@$ids){
3007      my ($self,$dataset) = @_;              my $genome = $fig->genome_of($id);
3008                my @values = (' ');
3009                if (defined $genomes_with_phenotype->{$genome}){
3010                    push (@values, $genomes_with_phenotype->{$genome});
3011                }
3012                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
3013                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
3014            }
3015        }
3016    
3017      my $data = [];      return $column;
3018      my $count = 0;  }
     my $content;  
     my $fig = new FIG;  
     my $cgi = new CGI;  
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
         next if ($thing->class ne "SIM");  
         $count++;  
3019    
3020          my $id = $thing->acc;  sub get_aclh_aliases {
3021        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3022        my $db_array;
3023    
3024          # add the subsystem information      my $id_line = join (",", @$ids);
3025          my @in_sub  = $fig->peg_to_subsystems($id);      my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
         my $in_sub;  
3026    
         if (@in_sub > 0) {  
             $in_sub = @in_sub;  
3027    
             # RAE: add a javascript popup with all the subsystems  
             my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;  
             $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);  
         } else {  
             $in_sub = "&nbsp;";  
3028          }          }
3029    
3030          # add evidence code with tool tip  sub get_id_aliases {
3031          my $ev_codes=" &nbsp; ";      my ($id, $fig) = @_;
3032          my @ev_codes = "";      my $aliases = {};
3033          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {  
3034              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);      my $org = $fig->org_of($id);
3035              @ev_codes = ();      my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3036              foreach my $code (@codes) {      if ( my $form = &LWP::Simple::get($url) ) {
3037                  my $pretty_code = $code->[2];          my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3038                  if ($pretty_code =~ /;/) {          foreach my $line (split /\n/, $block){
3039                      my ($cd, $ss) = split(";", $code->[2]);              my @values = split /\t/, $line;
3040                      $ss =~ s/_/ /g;              next if ($values[3] eq "Expert");
3041                      $pretty_code = $cd;# . " in " . $ss;              if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3042                    $aliases->{$values[4]} = $values[0];
3043                  }                  }
                 push(@ev_codes, $pretty_code);  
3044              }              }
3045          }          }
3046    
3047          if (scalar(@ev_codes) && $ev_codes[0]) {      return $aliases;
             my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);  
             $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));  
3048          }          }
3049    
3050          # add the aliases  sub get_db_aliases {
3051          my $aliases = undef;      my ($ids,$fig,$db,$cgi,$returnType) = @_;
3052          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      my $db_array;
3053          $aliases = &HTML::set_prot_links( $cgi, $aliases );      my $all_aliases = $fig->feature_aliases_bulk($ids);
3054          $aliases ||= "&nbsp;";      foreach my $id (@$ids){
3055    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3056          my $iden    = $thing->identity;          my $id_org = $fig->org_of($id);
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
3057    
3058            foreach my $alias (@{$$all_aliases{$id}}){
3059          push(@$single_domain,$thing->database);  #       foreach my $alias (@all_aliases){
3060          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));              my $id_db = &Observation::get_database($alias);
3061          push(@$single_domain,$thing->evalue);              next if ( ($id_db ne $db) && ($db ne 'all') );
3062          push(@$single_domain,"$iden\%");              next if ($aliases->{$id}->{$db});
3063          push(@$single_domain,$reg1);              my $alias_org = $fig->org_of($alias);
3064          push(@$single_domain,$reg2);  #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3065          push(@$single_domain,$in_sub);                  #push(@funcs, [$id,$id_db,$tmp]);
3066          push(@$single_domain,$ev_codes);                  $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3067          push(@$single_domain,$thing->organism);  #           }
         push(@$single_domain,$thing->function);  
         push(@$single_domain,$aliases);  
         push(@$data,$single_domain);  
3068      }      }
3069            if (!defined( $aliases->{$id}->{$db})){
3070      if ($count >0){              $aliases->{$id}->{$db} = " ";
         $content = $data;  
3071      }      }
3072      else          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3073      {          push (@$db_array, $aliases->{$id}->{$db});
         $content = "<p>This PEG does not have any similarities</p>";  
3074      }      }
3075      return ($content);  
3076        if ($returnType eq 'hash') { return $aliases; }
3077        elsif ($returnType eq 'array') { return $db_array; }
3078  }  }
3079    
3080    
3081    
3082  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
3083    
3084    sub color {
3085        my ($evalue) = @_;
3086        my $palette = WebColors::get_palette('vitamins');
3087        my $color;
3088        if ($evalue <= 1e-170){        $color = $palette->[0];    }
3089        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3090        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3091        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3092        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3093        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3094        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3095        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3096        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3097        else{        $color = $palette->[9];    }
3098        return ($color);
3099    }
3100    
3101    
3102  ############################  ############################
# Line 1429  Line 3114 
3114  }  }
3115    
3116  sub display {  sub display {
3117      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3118    
3119        $taxes = $fig->taxonomy_list();
3120    
3121      my $fid = $self->fig_id;      my $fid = $self->fig_id;
3122      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
3123      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
3124      my $fig = new FIG;      my $range = $gd_window_size;
3125      my $all_regions = [];      my $all_regions = [];
3126        my $gene_associations={};
3127    
3128      #get the organism genome      #get the organism genome
3129      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
3130        $gene_associations->{$fid}->{"organism"} = $target_genome;
3131        $gene_associations->{$fid}->{"main_gene"} = $fid;
3132        $gene_associations->{$fid}->{"reverse_flag"} = 0;
3133    
3134      # get location of the gene      # get location of the gene
3135      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 3146 
3146      my ($region_start, $region_end);      my ($region_start, $region_end);
3147      if ($beg < $end)      if ($beg < $end)
3148      {      {
3149          $region_start = $beg - 4000;          $region_start = $beg - ($range);
3150          $region_end = $end+4000;          $region_end = $end+ ($range);
3151          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
3152      }      }
3153      else      else
3154      {      {
3155          $region_start = $end-4000;          $region_start = $end-($range);
3156          $region_end = $beg+4000;          $region_end = $beg+($range);
3157          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
3158          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
3159            $gene_associations->{$fid}->{"reverse_flag"} = 1;
3160      }      }
3161    
3162      # call genes in region      # call genes in region
3163      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);
3164        #foreach my $feat (@$target_gene_features){
3165        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
3166        #}
3167      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
3168      my (@start_array_region);      my (@start_array_region);
3169      push (@start_array_region, $offset);      push (@start_array_region, $offset);
3170    
3171      my %all_genes;      my %all_genes;
3172      my %all_genomes;      my %all_genomes;
3173      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
3174            #if ($feature =~ /peg/){
3175      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3176      {          #}
         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} = 1;  
3177                  }                  }
3178    
3179                  push (@start_array_region, $offset);      my @selected_sims;
3180    
3181                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
3182                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
3183                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
3184                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
3185              }          # get the similarities and store only the ones that match the lineages selected
3186              $coup_count++;          if (@selected_taxonomy > 0){
3187                foreach my $sim (@$sims_array){
3188                    next if ($sim->class ne "SIM");
3189                    next if ($sim->acc !~ /fig\|/);
3190    
3191                    #my $genome = $fig->genome_of($sim->[1]);
3192                    my $genome = $fig->genome_of($sim->acc);
3193                    #my ($genome1) = ($genome) =~ /(.*)\./;
3194                    my $lineage = $taxes->{$genome};
3195                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3196                    foreach my $taxon(@selected_taxonomy){
3197                        if ($lineage =~ /$taxon/){
3198                            #push (@selected_sims, $sim->[1]);
3199                            push (@selected_sims, $sim->acc);
3200          }          }
3201      }      }
   
     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);  
3202                      }                      }
                     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} = 1;  
3203                      }                      }
3204            else{
3205                my $simcount = 0;
3206                foreach my $sim (@$sims_array){
3207                    next if ($sim->class ne "SIM");
3208                    next if ($sim->acc !~ /fig\|/);
3209    
3210                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
3211                      $all_genomes{$pair_genome} = 1;                  $simcount++;
3212                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                  last if ($simcount > 4);
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
                 }  
3213              }              }
3214          }          }
3215    
3216            my %saw;
3217            @selected_sims = grep(!$saw{$_}++, @selected_sims);
3218    
3219            # get the gene context for the sorted matches
3220            foreach my $sim_fid(@selected_sims){
3221                #get the organism genome
3222                my $sim_genome = $fig->genome_of($sim_fid);
3223                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
3224                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
3225                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
3226    
3227                # get location of the gene
3228                my $data = $fig->feature_location($sim_fid);
3229                my ($contig, $beg, $end);
3230    
3231                if ($data =~ /(.*)_(\d+)_(\d+)$/){
3232                    $contig = $1;
3233                    $beg = $2;
3234                    $end = $3;
3235      }      }
3236    
3237      # get the PCH to each of the genes              my $offset;
3238      my $pch_sets = [];              my ($region_start, $region_end);
3239      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)  
3240          {          {
3241              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
3242                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
3243                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
3244          }          }
3245          else          else
3246          {          {
3247              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
3248                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
3249              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3250                    $reverse_flag{$sim_genome} = $sim_fid;
3251                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
3252          }          }
3253    
3254                # call genes in region
3255                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
3256                push(@$all_regions,$sim_gene_features);
3257                push (@start_array_region, $offset);
3258                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
3259                $all_genomes{$sim_genome} = 1;
3260      }      }
3261    
3262        }
3263    
3264  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3265  #    my %already;      # cluster the genes
3266  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
3267  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3268  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3269  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #       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} = 100;  
 #           }  
 #       }  
 #    }  
3270    
3271      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3272          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3273          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3274          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3275          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3276            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3277            my $lineage = $taxes->{$region_genome};
3278            #my $lineage = $fig->taxonomy_of($region_genome);
3279            #$region_gs .= "Lineage:$lineage";
3280          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3281                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3282                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 3284 
3284    
3285          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3286    
3287            my $second_line_config = { 'title' => "$lineage",
3288                                       'short_title' => "",
3289                                       'basepair_offset' => '0',
3290                                       'no_middle_line' => '1'
3291                                       };
3292    
3293          my $line_data = [];          my $line_data = [];
3294            my $second_line_data = [];
3295    
3296            # initialize variables to check for overlap in genes
3297            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
3298            my $major_line_flag = 0;
3299            my $prev_second_flag = 0;
3300    
3301          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
3302                $second_line_flag = 0;
3303              my $element_hash;              my $element_hash;
3304              my $links_list = [];              my $links_list = [];
3305              my $descriptions = [];              my $descriptions = [];
3306    
3307              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
3308    
3309              # get subsystem information              # get subsystem information
3310              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3311              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3312    
3313              my $link;              my $link;
3314              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3315                       "link" => $url_link};                       "link" => $url_link};
3316              push(@$links_list,$link);              push(@$links_list,$link);
3317    
3318              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3319              foreach my $subsystem (@subsystems){              my @subsystems;
3320                foreach my $array (@subs){
3321                    my $subsystem = $$array[0];
3322                    my $ss = $subsystem;
3323                    $ss =~ s/_/ /ig;
3324                    push (@subsystems, $ss);
3325                  my $link;                  my $link;
3326                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3327                           "link_title" => $subsystem};                           "link_title" => $ss};
3328                    push(@$links_list,$link);
3329                }
3330    
3331                if ($fid1 eq $fid){
3332                    my $link;
3333                    $link = {"link_title" => "Annotate this sequence",
3334                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3335                  push(@$links_list,$link);                  push(@$links_list,$link);
3336              }              }
3337    
# Line 1738  Line 3353 
3353                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
3354                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
3355    
3356                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
3357                         ( ($start < $prev_start) || ($start < $prev_stop) ||
3358                           ($stop < $prev_start) || ($stop < $prev_stop) )){
3359                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
3360                            $second_line_flag = 1;
3361                            $major_line_flag = 1;
3362                        }
3363                    }
3364                    $prev_start = $start;
3365                    $prev_stop = $stop;
3366                    $prev_fig = $fid1;
3367    
3368                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3369                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3370                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3371                  }                  }
3372    
3373                    my $title = $fid1;
3374                    if ($fid1 eq $fid){
3375                        $title = "My query gene: $fid1";
3376                    }
3377    
3378                  $element_hash = {                  $element_hash = {
3379                      "title" => $fid1,                      "title" => $title,
3380                      "start" => $start,                      "start" => $start,
3381                      "end" =>  $stop,                      "end" =>  $stop,
3382                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 3385 
3385                      "links_list" => $links_list,                      "links_list" => $links_list,
3386                      "description" => $descriptions                      "description" => $descriptions
3387                  };                  };
3388                  push(@$line_data,$element_hash);  
3389                    # if there is an overlap, put into second line
3390                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3391                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3392    
3393                    if ($fid1 eq $fid){
3394                        $element_hash = {
3395                            "title" => 'Query',
3396                            "start" => $start,
3397                            "end" =>  $stop,
3398                            "type"=> 'bigbox',
3399                            "color"=> $color,
3400                            "zlayer" => "1"
3401                            };
3402    
3403                        # if there is an overlap, put into second line
3404                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3405                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3406                    }
3407              }              }
3408          }          }
3409          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3410            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3411      }      }
3412      return $gd;      return ($gd, \@selected_sims);
3413    }
3414    
3415    sub cluster_genes {
3416        my($fig,$all_pegs,$peg) = @_;
3417        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3418    
3419        my @color_sets = ();
3420    
3421        $conn = &get_connections_by_similarity($fig,$all_pegs);
3422    
3423        for ($i=0; ($i < @$all_pegs); $i++) {
3424            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3425            if (! $seen{$i}) {
3426                $cluster = [$i];
3427                $seen{$i} = 1;
3428                for ($j=0; ($j < @$cluster); $j++) {
3429                    $x = $conn->{$cluster->[$j]};
3430                    foreach $k (@$x) {
3431                        if (! $seen{$k}) {
3432                            push(@$cluster,$k);
3433                            $seen{$k} = 1;
3434                        }
3435                    }
3436                }
3437    
3438                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3439                    push(@color_sets,$cluster);
3440                }
3441            }
3442        }
3443        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3444        $red_set = $color_sets[$i];
3445        splice(@color_sets,$i,1);
3446        @color_sets = sort { @$b <=> @$a } @color_sets;
3447        unshift(@color_sets,$red_set);
3448    
3449        my $color_sets = {};
3450        for ($i=0; ($i < @color_sets); $i++) {
3451            foreach $x (@{$color_sets[$i]}) {
3452                $color_sets->{$all_pegs->[$x]} = $i;
3453            }
3454        }
3455        return $color_sets;
3456    }
3457    
3458    sub get_connections_by_similarity {
3459        my($fig,$all_pegs) = @_;
3460        my($i,$j,$tmp,$peg,%pos_of);
3461        my($sim,%conn,$x,$y);
3462    
3463        for ($i=0; ($i < @$all_pegs); $i++) {
3464            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3465            push(@{$pos_of{$tmp}},$i);
3466            if ($tmp ne $all_pegs->[$i]) {
3467                push(@{$pos_of{$all_pegs->[$i]}},$i);
3468            }
3469        }
3470    
3471        foreach $y (keys(%pos_of)) {
3472            $x = $pos_of{$y};
3473            for ($i=0; ($i < @$x); $i++) {
3474                for ($j=$i+1; ($j < @$x); $j++) {
3475                    push(@{$conn{$x->[$i]}},$x->[$j]);
3476                    push(@{$conn{$x->[$j]}},$x->[$i]);
3477                }
3478            }
3479        }
3480    
3481        for ($i=0; ($i < @$all_pegs); $i++) {
3482            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3483                if (defined($x = $pos_of{$sim->id2})) {
3484                    foreach $y (@$x) {
3485                        push(@{$conn{$i}},$y);
3486                    }
3487                }
3488            }
3489        }
3490        return \%conn;
3491    }
3492    
3493    sub in {
3494        my($x,$xL) = @_;
3495        my($i);
3496    
3497        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3498        return ($i < @$xL);
3499    }
3500    
3501    #############################################
3502    #############################################
3503    package Observation::Commentary;
3504    
3505    use base qw(Observation);
3506    
3507    =head3 display_protein_commentary()
3508    
3509    =cut
3510    
3511    sub display_protein_commentary {
3512        my ($self,$dataset,$mypeg,$fig) = @_;
3513    
3514        my $all_rows = [];
3515        my $content;
3516        #my $fig = new FIG;
3517        my $cgi = new CGI;
3518        my $count = 0;
3519        my $peg_array = [];
3520        my ($evidence_column, $subsystems_column,  %e_identical);
3521    
3522        if (@$dataset != 1){
3523            foreach my $thing (@$dataset){
3524                if ($thing->class eq "SIM"){
3525                    push (@$peg_array, $thing->acc);
3526                }
3527            }
3528            # get the column for the evidence codes
3529            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3530    
3531            # get the column for the subsystems
3532            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3533    
3534            # get essentially identical seqs
3535            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3536        }
3537        else{
3538            push (@$peg_array, @$dataset);
3539        }
3540    
3541        my $selected_sims = [];
3542        foreach my $id (@$peg_array){
3543            last if ($count > 10);
3544            my $row_data = [];
3545            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3546            if ($fig->org_of($id)){
3547                $org = $fig->org_of($id);
3548            }
3549            else{
3550                $org = "Data not available";
3551            }
3552            $function = $fig->function_of($id);
3553            if ($mypeg ne $id){
3554                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3555                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3556                if (defined($e_identical{$id})) { $id_cell .= "*";}
3557            }
3558            else{
3559                $function_cell = "&nbsp;&nbsp;$function";
3560                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3561                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3562            }
3563    
3564            push(@$row_data,$id_cell);
3565            push(@$row_data,$org);
3566            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3567            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3568            push(@$row_data, $fig->translation_length($id));
3569            push(@$row_data,$function_cell);
3570            push(@$all_rows,$row_data);
3571            push (@$selected_sims, $id);
3572            $count++;
3573        }
3574    
3575        if ($count >0){
3576            $content = $all_rows;
3577        }
3578        else{
3579            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3580        }
3581        return ($content,$selected_sims);
3582    }
3583    
3584    sub display_protein_history {
3585        my ($self, $id,$fig) = @_;
3586        my $all_rows = [];
3587        my $content;
3588    
3589        my $cgi = new CGI;
3590        my $count = 0;
3591        foreach my $feat ($fig->feature_annotations($id)){
3592            my $row = [];
3593            my $col1 = $feat->[2];
3594            my $col2 = $feat->[1];
3595            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3596            my $text = $feat->[3];
3597    
3598            push (@$row, $col1);
3599            push (@$row, $col2);
3600            push (@$row, $text);
3601            push (@$all_rows, $row);
3602            $count++;
3603        }
3604        if ($count > 0){
3605            $content = $all_rows;
3606        }
3607        else {
3608            $content = "There is no history for this PEG";
3609  }  }
3610    
3611        return($content);
3612    }
3613    

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.77

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3