[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.22, Fri Jun 29 16:22:37 2007 UTC revision 1.74, Thu Feb 5 18:44:35 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 26  Line 30 
30    
31  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).
32    
 Example:  
   
   
 use FIG;  
 use Observation;  
   
 my $fig = new FIG;  
 my $fid = "fig|83333.1.peg.3";  
   
 my $observations = Observation::get_objects($fid);  
 foreach my $observation (@$observations) {  
     print "ID: " . $fid . "\n";  
     print "Start: " . $observation->start() . "\n";  
     ...  
 }  
   
 B<return an array of objects>  
   
   
 print "$Observation->acc\n" prints the Accession number if present for the Observation  
   
33  =cut  =cut
34    
35  =head1 BACKGROUND  =head1 BACKGROUND
# Line 70  Line 53 
53    
54  The public methods this package provides are listed below:  The public methods this package provides are listed below:
55    
56    
57    =head3 context()
58    
59    Returns close or diverse for purposes of displaying genomic context
60    
61    =cut
62    
63    sub context {
64      my ($self) = @_;
65    
66      return $self->{context};
67    }
68    
69    =head3 rows()
70    
71    each row in a displayed table
72    
73    =cut
74    
75    sub rows {
76      my ($self) = @_;
77    
78      return $self->{rows};
79    }
80    
81  =head3 acc()  =head3 acc()
82    
83  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.
# Line 78  Line 86 
86    
87  sub acc {  sub acc {
88    my ($self) = @_;    my ($self) = @_;
   
89    return $self->{acc};    return $self->{acc};
90  }  }
91    
92  =head3 description()  =head3 query()
   
 The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  
93    
94  B<Please note:>  The query id
 Either remoteid or description is required.  
95    
96  =cut  =cut
97    
98  sub description {  sub query {
99    my ($self) = @_;    my ($self) = @_;
100        return $self->{query};
   return $self->{description};  
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 163  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 262  Line 266 
266      return $self->{hlength};      return $self->{hlength};
267  }  }
268    
   
   
269  =head3 evalue()  =head3 evalue()
270    
271  E-value or P-Value if present.  E-value or P-Value if present.
# Line 280  Line 282 
282    
283  Score if present.  Score if present.
284    
 B<Please note: >  
 Either score or eval are required.  
   
285  =cut  =cut
286    
287  sub score {  sub score {
# Line 290  Line 289 
289    return $self->{score};    return $self->{score};
290  }  }
291    
   
292  =head3 display()  =head3 display()
293    
294  will be different for each type  will be different for each type
# Line 303  Line 301 
301    
302  }  }
303    
304    =head3 display_table()
305    
306  =head3 rank()  will be different for each type
   
 Returns an integer from 1 - 10 indicating the importance of this observations.  
   
 Currently always returns 1.  
   
 =cut  
   
 sub rank {  
   my ($self) = @_;  
   
 #  return $self->{rank};  
   
   return 1;  
 }  
   
 =head3 supports_annotation()  
   
 Does a this observation support the annotation of its feature?  
   
 Returns  
   
 =over 3  
   
 =item 10, if feature annotation is identical to $self->description  
   
 =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()  
   
 =item undef  
   
 =back  
   
 =cut  
   
 sub supports_annotation {  
   my ($self) = @_;  
   
   # no code here so far  
   
   return $self->{supports_annotation};  
 }  
   
 =head3 url()  
   
 URL describing the subject. In case of a BLAST hit against a sequence, this URL will lead to a page displaying the sequence record for the sequence. In case of an HMM hit, the URL will be to the URL description.  
307    
308  =cut  =cut
309    
310  sub url {  sub display_table {
   my ($self) = @_;  
311    
312    my $url = get_url($self->type, $self->acc);    die "Abstract Table Method Called\n";
313    
   return $url;  
314  }  }
315    
316  =head3 get_objects()  =head3 get_objects()
317    
318  This is the B<REAL WORKHORSE> method of this Package.  This is the B<REAL WORKHORSE> method of this Package.
319    
 It will probably have to:  
   
 - get all sims for the feature  
 - get all bbhs for the feature  
 - copy information from sim to bbh (bbh have no match location etc)  
 - get pchs (difficult)  
 - get attributes (there is code for this that in get_attribute_based_observations  
 - get_attributes_based_observations returns an array of arrays of hashes like this"  
   
   my $dataset  
      [  
        [ { name => 'acc', value => '1234' },  
         { name => 'from', value => '4' },  
         { name => 'to', value => '400' },  
         ....  
        ],  
        [ { name => 'acc', value => '456' },  
         { name => 'from', value => '1' },  
         { name => 'to', value => '100' },  
         ....  
        ],  
        ...  
      ];  
    return $datasets;  
  }  
   
 It will invoke the required calls to the SEED API to retrieve the information required.  
   
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$classes) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
# Line 403  Line 328 
328      # call function that fetches attribute based observations      # call function that fetches attribute based observations
329      # returns an array of arrays of hashes      # returns an array of arrays of hashes
330    
331      if(scalar(@$classes) < 1){      if($scope){
332          get_attribute_based_observations($fid,\@matched_datasets);          get_cluster_observations($fid,\@matched_datasets,$scope);
         get_sims_observations($fid,\@matched_datasets);  
         get_identical_proteins($fid,\@matched_datasets);  
         get_functional_coupling($fid,\@matched_datasets);  
333      }      }
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          my $identical_flag=0;          my @attributes = $fig->get_attributes($fid);
337          my $pch_flag=0;          #$domain_classes{'CDD'} = 1;
338          my $location_flag = 0;          $domain_classes{'PFAM'} = 1;
339          my $sims_flag=0;          get_identical_proteins($fid,\@matched_datasets,$fig);
340          my $cluster_flag = 0;          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          my $pdb_flag = 0;          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          foreach my $class (@$classes){          get_functional_coupling($fid,\@matched_datasets,$fig);
343              if($class =~ /(IPR|CDD|PFAM)/){          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344                  $domain_classes{$class} = 1;          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
             }  
             elsif ($class eq "IDENTICAL")  
             {  
                 $identical_flag = 1;  
             }  
             elsif ($class eq "PCH")  
             {  
                 $pch_flag = 1;  
             }  
             elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)  
             {  
                 $location_flag = 1;  
             }  
             elsif ($class eq "SIM")  
             {  
                 $sims_flag = 1;  
             }  
             elsif ($class eq "CLUSTER")  
             {  
                 $cluster_flag = 1;  
             }  
             elsif ($class eq "PDB")  
             {  
                 $pdb_flag = 1;  
             }  
   
         }  
   
         if ($identical_flag ==1)  
         {  
             get_identical_proteins($fid,\@matched_datasets);  
         }  
         if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {  
             get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);  
         }  
         if ($pch_flag == 1)  
         {  
             get_functional_coupling($fid,\@matched_datasets);  
         }  
         if ($sims_flag == 1)  
         {  
             get_sims_observations($fid,\@matched_datasets);  
         }  
   
         if ($location_flag == 1)  
         {  
             get_attribute_based_location_observations($fid,\@matched_datasets);  
         }  
         if ($cluster_flag == 1)  
         {  
             get_cluster_observations($fid,\@matched_datasets);  
         }  
         if ($pdb_flag == 1)  
         {  
             get_pdb_observations($fid,\@matched_datasets);  
         }  
   
   
345      }      }
346    
347      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 485  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 511  Line 375 
375    
376  }  }
377    
378  =head1 Internal Methods  =head3 get_attributes
379        provides layer of abstraction between tools and underlying access method to Attribute Server
380    =cut
381    
382  These methods are not meant to be used outside of this package.  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  B<Please do not use them outside of this package!>  =head3 get_sims_objects()
389    
390    This is the B<REAL WORKHORSE> method of this Package.
391    
392  =cut  =cut
393    
394    sub get_sims_objects {
395        my ($self,$fid,$fig,$parameters) = @_;
396    
397        my $objects = [];
398        my @matched_datasets=();
399    
400  =head3 get_url (internal)      # 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  get_url() return a valid URL or undef for any observation.      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    
 URLs are constructed by looking at the Accession acc()  and  name()  
414    
415  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 display_housekeeping
416    This method returns the housekeeping data for a given peg in a table format
417    
418  =cut  =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  sub get_url {      push(@$content, $row);
448    
449   my ($self) = @_;      return ($content);
450   my $url='';  }
451    
452  # a hash with a URL for each observation; identified by name()  =head3 get_sims_summary
453  #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\  This method uses as input the similarities of a peg and creates a tree view of their taxonomy
 #                       'IPR'    => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\  
 #                          'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'PIR'    => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'FIGFAM' => '',\  
 #                          'sim'=> "http://www.theseed.org/linkin.cgi?id=",\  
 #                          'bbh'=> "http://www.theseed.org/linkin.cgi?id="  
 #};  
454    
455  # if (defined $URL{$self->name}) {  =cut
456  #     $url = $URL{$self->name}.$self->acc;  
457  #     return $url;  sub get_sims_summary {
458  # }      my ($observation, $dataset, $fig) = @_;
459  # else      my %families;
460       return undef;      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  =head3 get_display_method (internal)            $parent_tax = $tax;
504              $level++;
505            }
506        }
507    
508  get_display_method() return a valid URL or undef for any observation.      foreach my $key (keys %{$families{children}}){
509            $families{count}{$key} = @{$families{children}{$key}};
510    
511  URLs are constructed by looking at the Accession acc()  and  name()          my %saw;
512  and Info from both attributes is combined with a table of base URLs stored in this function.          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
513            $families{children}{$key} = \@out;
514        }
515    
516  =cut      return \%families;
517    }
518    
519  sub get_display_method {  =head1 Internal Methods
520    
521   my ($self) = @_;  These methods are not meant to be used outside of this package.
522    
523  # a hash with a URL for each observation; identified by name()  B<Please do not use them outside of this package!>
 #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\  
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
524    
525  #if (defined $URL{$self->name}) {  =cut
526  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;  
527  #     return $url;  sub get_taxcolor{
528  # }      my ($evalue) = @_;
529  # else      my $color;
530       return undef;      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    
544    
545  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
546    
547      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
548      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
550      my $fig = new FIG;      foreach my $attr_ref (@$attributes_ref) {
   
     foreach my $attr_ref ($fig->get_attributes($fid)) {  
551          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $class = $parts[0];          my $class = $parts[0];
554            my $name = $parts[1];
555            next if ($seen->{$name});
556            $seen->{$name}++;
557            #next if (($class eq "PFAM") && ($name !~ /interpro/));
558    
559          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
560              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 599  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;                      my $part2 = 1000 - $1;
568                      my $part1 = $2/100;                      my $part1 = $2/100;
569                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
570                  }                  }
571                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
572                        $evalue=$raw_evalue;
573                    }
574                  else{                  else{
575                      $evalue = "0.0";                      $evalue = "0.0";
576                  }                  }
# Line 613  Line 580 
580                                 'type' => "dom" ,                                 'type' => "dom" ,
581                                 'evalue' => $evalue,                                 'evalue' => $evalue,
582                                 'start' => $from,                                 'start' => $from,
583                                 'stop' => $to                                 'stop' => $to,
584                                   'fig_id' => $fid,
585                                   'score' => $raw_evalue
586                                 };                                 };
587    
588                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 624  Line 593 
593    
594  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
595    
596      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
597      my $fig = new FIG;      #my $fig = new FIG;
598    
599      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
600    
601      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};      my $dataset = {'type' => "loc",
602      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
603                       'fig_id' => $fid
604                       };
605    
606        foreach my $attr_ref (@$attributes_ref){
607          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
608            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
609          my @parts = split("::",$key);          my @parts = split("::",$key);
610          my $sub_class = $parts[0];          my $sub_class = $parts[0];
611          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 646  Line 620 
620                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
621              }              }
622          }          }
623    
624          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
625              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
626              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
627          }          }
         elsif($sub_class eq "TMPRED"){  
             my @value_parts = split(";",$value);  
             $dataset->{'tmpred_score'} = $value_parts[0];  
             $dataset->{'tmpred_locations'} = $value_parts[1];  
         }  
     }  
   
     push (@{$datasets_ref} ,$dataset);  
628    
629            elsif($sub_class eq "Phobius"){
630                if($sub_key eq "transmembrane"){
631                    $dataset->{'phobius_tm_locations'} = $value;
632                }
633                elsif($sub_key eq "signal"){
634                    $dataset->{'phobius_signal_location'} = $value;
635  }  }
   
   
 =head3 get_attribute_based_evidence (internal)  
   
 This method retrieves evidence from the attribute server  
   
 =cut  
   
 sub get_attribute_based_observations{  
   
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$datasets_ref) = (@_);  
   
     my $_myfig = new FIG;  
   
     foreach my $attr_ref ($_myfig->get_attributes($fid)) {  
   
         # convert the ref into a string for easier handling  
         my ($string) = "@$attr_ref";  
   
 #       print "S:$string\n";  
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
   
         # THIS SHOULD BE DONE ANOTHER WAY FM->TD  
         # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc  
         # as fas as possible this should be configured so that the type of observation and the regexp are  
         # stored somewhere for easy expansion  
         #  
   
         if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  
   
             # some keys are composite CDD::1233244 or PFAM:PF1233  
   
             if ( $key =~ /::/ ) {  
                 my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);  
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
636              }              }
637    
638              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );          elsif($sub_class eq "TMPRED"){
639                my @value_parts = split(/\;/,$value);
640              my $evalue= 255;              $dataset->{'tmpred_score'} = $value_parts[0];
641              if (defined $raw_evalue) { # some of the tool do not give us an evalue              $dataset->{'tmpred_locations'} = $value_parts[1];
   
                 my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);  
                 my ($new_k, $new_exp);  
   
                 #  
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
   
 #                   $new_exp = (1000+$expo);  
         #           $new_k = $k / 100;  
   
642                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
643              }              }
644    
             # unroll it all into an array of hashes  
             # this needs to be done differently for different types of observations  
             my $dataset = [ { name => 'class', value => $key },  
                             { name => 'acc' , value => $acc},  
                             { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  
                             { name => 'evalue', value => $evalue },  
                             { name => 'start', value => $from},  
                             { name => 'stop' , value => $to}  
                             ];  
   
645              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
646          }  
     }  
647  }  }
648    
649  =head3 get_pdb_observations() (internal)  =head3 get_pdb_observations() (internal)
# Line 741  Line 653 
653  =cut  =cut
654    
655  sub get_pdb_observations{  sub get_pdb_observations{
656      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
657    
658      print STDERR "get pdb obs called\n";      #my $fig = new FIG;
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
659    
660        foreach my $attr_ref (@$attributes_ref){
661          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
662            next if ( ($key !~ /PDB/));
663          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
664          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
665          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 767  Line 678 
678                         'acc' => $key2,                         'acc' => $key2,
679                         'evalue' => $evalue,                         'evalue' => $evalue,
680                         'start' => $start,                         'start' => $start,
681                         'stop' => $stop                         'stop' => $stop,
682                           'fig_id' => $fid
683                         };                         };
684    
685          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
686      }      }
   
687  }  }
688    
   
   
   
689  =head3 get_cluster_observations() (internal)  =head3 get_cluster_observations() (internal)
690    
691  This methods sets the type and class for cluster observations  This methods sets the type and class for cluster observations
# Line 785  Line 693 
693  =cut  =cut
694    
695  sub get_cluster_observations{  sub get_cluster_observations{
696      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$scope) = (@_);
697    
698      my $dataset = {'class' => 'CLUSTER',      my $dataset = {'class' => 'CLUSTER',
699                     'type' => 'fc'                     'type' => 'fc',
700                       'context' => $scope,
701                       'fig_id' => $fid
702                     };                     };
703      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
704  }  }
# Line 801  Line 711 
711  =cut  =cut
712    
713  sub get_sims_observations{  sub get_sims_observations{
714        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
715    
716        my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
717        if ( (defined $parameters->{flag}) && ($parameters->{flag})){
718          $max_sims = $parameters->{max_sims};
719          $max_expand = $parameters->{max_expand};
720          $max_eval = $parameters->{max_eval};
721          $db_filter = $parameters->{db_filter};
722          $sim_filters->{ sort_by } = $parameters->{sim_order};
723          #$sim_order = $parameters->{sim_order};
724          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
725        }
726        elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
727          $max_sims = 50;
728          $max_expand = 5;
729          $max_eval = 1e-5;
730          $db_filter = "all";
731          $sim_filters->{ sort_by } = 'id';
732        }
733        else{
734          $max_sims = 50;
735          $max_expand = 5;
736          $max_eval = 1e-5;
737          $db_filter = "figx";
738          $sim_filters->{ sort_by } = 'id';
739          #$sim_order = "id";
740        }
741    
742      my ($fid,$datasets_ref) = (@_);      my($id, $genome, @genomes, %sims);
743      my $fig = new FIG;      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
744  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
     my @sims= $fig->nsims($fid,100,1e-20,"all");  
745      my ($dataset);      my ($dataset);
746      foreach my $sim (@sims){  
747        if ($group_by_genome){
748          #  Collect all sims from genome with the first occurance of the genome:
749          foreach $sim ( @tmp ){
750            $id = $sim->id2;
751            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
752            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
753            push @{ $sims{ $genome } }, $sim;
754          }
755          @tmp = map { @{ $sims{$_} } } @genomes;
756        }
757    
758        my $seen_sims={};
759        foreach my $sim (@tmp){
760          my $hit = $sim->[1];          my $hit = $sim->[1];
761            next if ($seen_sims->{$hit});
762            $seen_sims->{$hit}++;
763          my $percent = $sim->[2];          my $percent = $sim->[2];
764          my $evalue = $sim->[10];          my $evalue = $sim->[10];
765          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 819  Line 770 
770          my $hlength = $sim->[13];          my $hlength = $sim->[13];
771          my $db = get_database($hit);          my $db = get_database($hit);
772          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
773          my $organism = $fig->org_of($hit);          my $organism;
774            if ($fig->org_of($hit)){
775                $organism = $fig->org_of($hit);
776            }
777            else{
778                $organism = "Data not available";
779            }
780    
781          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
782                        'query' => $sim->[0],
783                      'acc' => $hit,                      'acc' => $hit,
784                      'identity' => $percent,                      'identity' => $percent,
785                      'type' => 'seq',                      'type' => 'seq',
# Line 834  Line 792 
792                      'organism' => $organism,                      'organism' => $organism,
793                      'function' => $func,                      'function' => $func,
794                      'qlength' => $qlength,                      'qlength' => $qlength,
795                      'hlength' => $hlength                      'hlength' => $hlength,
796                        'fig_id' => $fid
797                      };                      };
798    
799          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
# Line 850  Line 809 
809      my ($id) = (@_);      my ($id) = (@_);
810    
811      my ($db);      my ($db);
812      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
813      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
814        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
815      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
816        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
817      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
818      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
819      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
820      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
821      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
822      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
823      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
824      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
825        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
826        elsif ($id =~ /^img\|/)           { $db = "IMG" }
827        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
828        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
829    
830      return ($db);      return ($db);
831    
832  }  }
833    
834    
835  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
836    
837  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 874  Line 840 
840    
841  sub get_identical_proteins{  sub get_identical_proteins{
842    
843      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
844      my $fig = new FIG;      #my $fig = new FIG;
845      my @funcs = ();      my $funcs_ref;
846    
847      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);
   
848      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
849          my ($tmp, $who);          my ($tmp, $who);
850          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
851              $who = &get_database($id);              $who = &get_database($id);
852              push(@funcs, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
853          }          }
854      }      }
855    
     my ($dataset);  
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
856          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
857                         'type' => 'seq',                         'type' => 'seq',
858                         'database' => $who,                     'fig_id' => $fid,
859                         'function' => $assignment                     'rows' => $funcs_ref
860                         };                         };
861    
862          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
863      }  
864    
865  }  }
866    
# Line 916  Line 872 
872    
873  sub get_functional_coupling{  sub get_functional_coupling{
874    
875      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
876      my $fig = new FIG;      #my $fig = new FIG;
877      my @funcs = ();      my @funcs = ();
878    
879      # initialize some variables      # initialize some variables
# Line 927  Line 883 
883      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
884    
885      # get the fc data      # get the fc data
886      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);
887    
888      # retrieve data      # retrieve data
889      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
890                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
891                    } @fc_data;                    } @fc_data;
892    
     my ($dataset);  
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
893          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
894                         'type' => 'fc',                         'type' => 'fc',
895                         'function' => $description                     'fig_id' => $fid,
896                       'rows' => \@rows
897                         };                         };
898    
899          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
     }  
 }  
   
 =head3 get_sims_and_bbhs() (internal)  
   
 This methods retrieves sims and also BBHs and fills the internal data structures.  
   
 =cut  
   
 #     sub get_sims_and_bbhs{  
   
 #       # blast m8 output format  
 #       # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit  
   
 #       my $Sims=();  
 #       @sims_src = $fig->sims($fid,80,500,"fig",0);  
 #       print "found $#sims_src SIMs\n";  
 #       foreach $sims (@sims_src) {  
 #           my ($sims_string) = "@$sims";  
 # #       print "$sims_string\n";  
 #           my ($rfid,$start,$stop,$eval) = ( $sims_string =~ /\S+\s+(\S+)\s+\S+\s\S+\s+(\S+)\s+(\S+)\s+  
 #                                             \S+\s+\S+\s+\S+\s+\S+\s+(\S+)+.*/);  
 # #       print "ID: $rfid, E:$eval, Start:$start stop:$stop\n";  
 #           $Sims{$rfid}{'eval'}=$eval;  
 #           $Sims{$rfid}{'start'}=$start;  
 #           $Sims{$rfid}{'stop'}=$stop;  
 #           print "$rfid $Sims{$rfid}{'eval'}\n";  
 #       }  
   
 #       # BBHs  
 #       my $BBHs=();  
   
 #       @bbhs_src = $fig->bbhs($fid,1.0e-10);  
 #       print "found $#bbhs_src BBHs\n";  
 #       foreach $bbh (@bbhs_src) {  
 #           #print "@$bbh\n";  
 #           my ($bbh_string) = "@$bbh";  
 #           my ($rfid,$eval,$score) = ( $bbh_string =~ /(\S+)\s(\S+)\s(\S+)/);  
 #           #print "ID: $rfid, E:$eval, S:$score\n";  
 #           $BBHs{$rfid}{'eval'}=$eval;  
 #           $BBHs{$rfid}{'score'}=$score;  
 # #print "$rfid $BBHs{$rfid}{'eval'}\n";  
 #       }  
   
 #     }  
   
900    
901    }
902    
903  =head3 new (internal)  =head3 new (internal)
904    
# Line 1004  Line 909 
909  sub new {  sub new {
910    my ($class,$dataset) = @_;    my ($class,$dataset) = @_;
911    
   
   #$self = { acc => '',  
 #           description => '',  
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
   
912    my $self = { class => $dataset->{'class'},    my $self = { class => $dataset->{'class'},
913                 type => $dataset->{'type'}                 type => $dataset->{'type'},
914                   fig_id => $dataset->{'fig_id'},
915                   score => $dataset->{'score'},
916             };             };
917    
918    bless($self,$class);    bless($self,$class);
# Line 1043  Line 932 
932      return $self->{identity};      return $self->{identity};
933  }  }
934    
935    =head3 fig_id (internal)
936    
937    =cut
938    
939    sub fig_id {
940      my ($self) = @_;
941      return $self->{fig_id};
942    }
943    
944  =head3 feature_id (internal)  =head3 feature_id (internal)
945    
946    
# Line 1127  Line 1025 
1025  =cut  =cut
1026    
1027  sub display{  sub display{
1028      my ($self,$gd,$fid) = @_;      my ($self,$gd,$fig) = @_;
   
     my $dbmaster = DBMaster->new(-database =>'Ontology');  
1029    
1030      print STDERR "PDB::display called\n";      my $fid = $self->fig_id;
1031        my $dbmaster = DBMaster->new(-database =>'Ontology',
1032                                     -host     => $WebConfig::DBHOST,
1033                                     -user     => $WebConfig::DBUSER,
1034                                     -password => $WebConfig::DBPWD);
1035    
1036      my $acc = $self->acc;      my $acc = $self->acc;
1037    
     print STDERR "acc:$acc\n";  
1038      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
1039      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
1040      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 1153  Line 1052 
1052      my $lines = [];      my $lines = [];
1053      my $line_data = [];      my $line_data = [];
1054      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1055                            'hover_title' => 'PDB',
1056                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1057                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1058    
1059      my $fig = new FIG;      #my $fig = new FIG;
1060      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1061      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1062    
# Line 1238  Line 1138 
1138    
1139      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1140      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1141      $self->{id} = $dataset->{'id'};      $self->{rows} = $dataset->{'rows'};
     $self->{organism} = $dataset->{'organism'};  
     $self->{function} = $dataset->{'function'};  
     $self->{database} = $dataset->{'database'};  
1142    
1143      bless($self,$class);      bless($self,$class);
1144      return $self;      return $self;
1145  }  }
1146    
1147  =head3 display()  =head3 display_table()
1148    
1149  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1150  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1258  Line 1155 
1155    
1156  =cut  =cut
1157    
 sub display{  
     my ($self, $cgi, $dataset) = @_;  
1158    
1159    sub display_table{
1160        my ($self,$fig) = @_;
1161    
1162        #my $fig = new FIG;
1163        my $fid = $self->fig_id;
1164        my $rows = $self->rows;
1165        my $cgi = new CGI;
1166      my $all_domains = [];      my $all_domains = [];
1167      my $count_identical = 0;      my $count_identical = 0;
1168      my $content;      my $content;
1169      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1170          next if ($thing->class ne "IDENTICAL");          my $id = $row->[0];
1171            my $who = $row->[1];
1172            my $assignment = $row->[2];
1173            my $organism = "Data not available";
1174            if ($fig->org_of($id)){
1175                $organism = $fig->org_of($id);
1176            }
1177          my $single_domain = [];          my $single_domain = [];
1178          push(@$single_domain,$thing->database);          push(@$single_domain,$who);
1179          my $id = $thing->id;          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1180          $count_identical++;          push(@$single_domain,$organism);
1181          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,$assignment);
         push(@$single_domain,$thing->organism);  
         #push(@$single_domain,$thing->type);  
         push(@$single_domain,$thing->function);  
1182          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1183            $count_identical++;
1184      }      }
1185    
1186      if ($count_identical >0){      if ($count_identical >0){
# Line 1288  Line 1194 
1194    
1195  1;  1;
1196    
   
1197  #########################################  #########################################
1198  #########################################  #########################################
1199  package Observation::FC;  package Observation::FC;
# Line 1300  Line 1205 
1205    
1206      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1207      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1208      $self->{score} = $dataset->{'score'};      $self->{rows} = $dataset->{'rows'};
     $self->{id} = $dataset->{'id'};  
     $self->{function} = $dataset->{'function'};  
1209    
1210      bless($self,$class);      bless($self,$class);
1211      return $self;      return $self;
1212  }  }
1213    
1214  =head3 display()  =head3 display_table()
1215    
1216  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1217  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1319  Line 1222 
1222    
1223  =cut  =cut
1224    
1225  sub display {  sub display_table {
     my ($self,$cgi,$dataset, $fid) = @_;  
1226    
1227        my ($self,$dataset,$fig) = @_;
1228        my $fid = $self->fig_id;
1229        my $rows = $self->rows;
1230        my $cgi = new CGI;
1231      my $functional_data = [];      my $functional_data = [];
1232      my $count = 0;      my $count = 0;
1233      my $content;      my $content;
1234    
1235      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1236          my $single_domain = [];          my $single_domain = [];
         next if ($thing->class ne "PCH");  
1237          $count++;          $count++;
1238    
1239          # construct the score link          # construct the score link
1240          my $score = $thing->score;          my $score = $row->[0];
1241          my $toid = $thing->id;          my $toid = $row->[1];
1242          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";
1243          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1244    
1245          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1246          push(@$single_domain,$thing->id);          push(@$single_domain,$row->[1]);
1247          push(@$single_domain,$thing->function);          push(@$single_domain,$row->[2]);
1248          push(@$functional_data,$single_domain);          push(@$functional_data,$single_domain);
1249      }      }
1250    
# Line 1376  Line 1281 
1281  sub display {  sub display {
1282      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1283      my $lines = [];      my $lines = [];
1284      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1285                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1286                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1287      my $color = "4";      my $color = "4";
1288    
1289      my $line_data = [];      my $line_data = [];
# Line 1388  Line 1293 
1293      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1294      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1295    
1296      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1297                                    -host     => $WebConfig::DBHOST,
1298                                    -user     => $WebConfig::DBUSER,
1299                                    -password => $WebConfig::DBPWD);
1300    
1301      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1302      if($db eq "CDD"){  
1303          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1304          if(!scalar(@$cdd_objs)){          my $new_id;
1305            if ($id =~ /_/){
1306                ($new_id) = ($id) =~ /(.*?)_/;
1307            }
1308            else{
1309                $new_id = $id;
1310            }
1311    
1312            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1313            if(!scalar(@$pfam_objs)){
1314              $name_title = "name";              $name_title = "name";
1315              $name_value = "not available";              $name_value = "not available";
1316              $description_title = "description";              $description_title = "description";
1317              $description_value = "not available";              $description_value = "not available";
1318          }          }
1319          else{          else{
1320              my $cdd_obj = $cdd_objs->[0];              my $pfam_obj = $pfam_objs->[0];
1321              $name_title = "name";              $name_title = "name";
1322              $name_value = $cdd_obj->term;              $name_value = $pfam_obj->term;
1323              $description_title = "description";              #$description_title = "description";
1324              $description_value = $cdd_obj->description;              #$description_value = $pfam_obj->description;
1325          }          }
1326      }      }
1327    
1328        my $short_title = $thing->acc;
1329        $short_title =~ s/::/ - /ig;
1330        my $new_short_title=$short_title;
1331        if ($short_title =~ /interpro/){
1332            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1333        }
1334        my $line_config = { 'title' => $name_value,
1335                            'hover_title', => 'Domain',
1336                            'short_title' => $new_short_title,
1337                            'basepair_offset' => '1' };
1338    
1339      my $name;      my $name;
1340      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1341               "value" => $name_value};      $name = {"title" => $db,
1342                 "value" => $new_id};
1343      push(@$descriptions,$name);      push(@$descriptions,$name);
1344    
1345      my $description;  #    my $description;
1346      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1347                               "value" => $description_value};  #                   "value" => $description_value};
1348      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1349    
1350      my $score;      my $score;
1351      $score = {"title" => "score",      $score = {"title" => "score",
1352                "value" => $thing->evalue};                "value" => $thing->evalue};
1353      push(@$descriptions,$score);      push(@$descriptions,$score);
1354    
1355        my $location;
1356        $location = {"title" => "location",
1357                     "value" => $thing->start . " - " . $thing->stop};
1358        push(@$descriptions,$location);
1359    
1360      my $link_id;      my $link_id;
1361      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1362          $link_id = $1;          $link_id = $1;
1363      }      }
1364    
1365      my $link;      my $link;
1366      my $link_url;      my $link_url;
1367      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"}
1368      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"}
1369      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1370    
1371      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1439  Line 1373 
1373      push(@$links_list,$link);      push(@$links_list,$link);
1374    
1375      my $element_hash = {      my $element_hash = {
1376          "title" => $thing->type,          "title" => $name_value,
1377          "start" => $thing->start,          "start" => $thing->start,
1378          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1379          "color"=> $color,          "color"=> $color,
# Line 1454  Line 1388 
1388    
1389  }  }
1390    
1391    sub display_table {
1392        my ($self,$dataset) = @_;
1393        my $cgi = new CGI;
1394        my $data = [];
1395        my $count = 0;
1396        my $content;
1397        my $seen = {};
1398    
1399        foreach my $thing (@$dataset) {
1400            next if ($thing->type !~ /dom/);
1401            my $single_domain = [];
1402            $count++;
1403    
1404            my $db_and_id = $thing->acc;
1405            my ($db,$id) = split("::",$db_and_id);
1406    
1407            my $dbmaster = DBMaster->new(-database =>'Ontology',
1408                                    -host     => $WebConfig::DBHOST,
1409                                    -user     => $WebConfig::DBUSER,
1410                                    -password => $WebConfig::DBPWD);
1411    
1412            my ($name_title,$name_value,$description_title,$description_value);
1413    
1414            my $new_id;
1415            if($db =~ /PFAM/){
1416                if ($id =~ /_/){
1417                    ($new_id) = ($id) =~ /(.*?)_/;
1418                }
1419                else{
1420                    $new_id = $id;
1421                }
1422    
1423                next if ($seen->{$new_id});
1424                $seen->{$new_id}=1;
1425    
1426                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1427    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1428                if(!scalar(@$pfam_objs)){
1429                    $name_title = "name";
1430                    $name_value = "not available";
1431                    $description_title = "description";
1432                    $description_value = "not available";
1433                }
1434                else{
1435                    my $pfam_obj = $pfam_objs->[0];
1436                    $name_title = "name";
1437                    $name_value = $pfam_obj->term;
1438                    #$description_title = "description";
1439                    #$description_value = $pfam_obj->description;
1440                }
1441            }
1442    
1443            my $location =  $thing->start . " - " . $thing->stop;
1444    
1445            push(@$single_domain,$db);
1446            push(@$single_domain,$new_id);
1447            push(@$single_domain,$name_value);
1448            push(@$single_domain,$location);
1449            push(@$single_domain,$thing->evalue);
1450            push(@$single_domain,$description_value);
1451            push(@$data,$single_domain);
1452        }
1453    
1454        if ($count >0){
1455            $content = $data;
1456        }
1457        else
1458        {
1459            $content = "<p>This PEG does not have any similarities to domains</p>";
1460        }
1461    }
1462    
1463    
1464  #########################################  #########################################
1465  #########################################  #########################################
1466  package Observation::Location;  package Observation::Location;
# Line 1471  Line 1478 
1478      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1479      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1480      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1481        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1482        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1483    
1484      bless($self,$class);      bless($self,$class);
1485      return $self;      return $self;
1486  }  }
1487    
1488    sub display_cello {
1489        my ($thing) = @_;
1490        my $html;
1491        my $cello_location = $thing->cello_location;
1492        my $cello_score = $thing->cello_score;
1493        if($cello_location){
1494            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1495            #$html .= "<p>CELLO score: $cello_score </p>";
1496        }
1497        return ($html);
1498    }
1499    
1500  sub display {  sub display {
1501      my ($thing,$gd,$fid) = @_;      my ($thing,$gd,$fig) = @_;
1502    
1503      my $fig= new FIG;      my $fid = $thing->fig_id;
1504        #my $fig= new FIG;
1505      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1506    
1507      my $cleavage_prob;      my $cleavage_prob;
# Line 1491  Line 1513 
1513      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1514      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1515    
1516        my $phobius_signal_location = $thing->phobius_signal_location;
1517        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1518    
1519      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1520    
1521      #color is      #color is
1522      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};  
1523    
         push(@$cello_descriptions,$description_cello_location);  
1524    
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
1525    
1526          push(@$cello_descriptions,$description_cello_score);  #    if($cello_location){
1527    #       my $cello_descriptions = [];
1528    #       my $line_data =[];
1529    #
1530    #       my $line_config = { 'title' => 'Localization Evidence',
1531    #                           'short_title' => 'CELLO',
1532    #                            'hover_title' => 'Localization',
1533    #                           'basepair_offset' => '1' };
1534    #
1535    #       my $description_cello_location = {"title" => 'Best Cello Location',
1536    #                                         "value" => $cello_location};
1537    #
1538    #       push(@$cello_descriptions,$description_cello_location);
1539    #
1540    #       my $description_cello_score = {"title" => 'Cello Score',
1541    #                                      "value" => $cello_score};
1542    #
1543    #       push(@$cello_descriptions,$description_cello_score);
1544    #
1545    #       my $element_hash = {
1546    #           "title" => "CELLO",
1547    #           "color"=> $color,
1548    #           "start" => "1",
1549    #           "end" =>  $length + 1,
1550    #           "zlayer" => '1',
1551    #           "description" => $cello_descriptions};
1552    #
1553    #       push(@$line_data,$element_hash);
1554    #       $gd->add_line($line_data, $line_config);
1555    #    }
1556    #
1557    #    $color = "2";
1558    #    if($tmpred_score){
1559    #       my $line_data =[];
1560    #       my $line_config = { 'title' => 'Localization Evidence',
1561    #                           'short_title' => 'Transmembrane',
1562    #                           'basepair_offset' => '1' };
1563    #
1564    #       foreach my $tmpred (@tmpred_locations){
1565    #           my $descriptions = [];
1566    #           my ($begin,$end) =split("-",$tmpred);
1567    #           my $description_tmpred_score = {"title" => 'TMPRED score',
1568    #                            "value" => $tmpred_score};
1569    #
1570    #           push(@$descriptions,$description_tmpred_score);
1571    #
1572    #           my $element_hash = {
1573    #           "title" => "transmembrane location",
1574    #           "start" => $begin + 1,
1575    #           "end" =>  $end + 1,
1576    #           "color"=> $color,
1577    #           "zlayer" => '5',
1578    #           "type" => 'box',
1579    #           "description" => $descriptions};
1580    #
1581    #           push(@$line_data,$element_hash);
1582    #
1583    #       }
1584    #       $gd->add_line($line_data, $line_config);
1585    #    }
1586    
         my $element_hash = {  
             "title" => "CELLO",  
             "start" => "1",  
             "end" =>  $length + 1,  
             "color"=> $color,  
             "type" => 'box',  
             "zlayer" => '2',  
             "description" => $cello_descriptions};  
1587    
1588          push(@$line_data,$element_hash);      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1589      }          my $line_data =[];
1590            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1591                                'short_title' => 'TM and SP',
1592                                'hover_title' => 'Localization',
1593                                'basepair_offset' => '1' };
1594    
1595      my $color = "6";          foreach my $tm_loc (@phobius_tm_locations){
     #if(0){  
     if($tmpred_score){  
         foreach my $tmpred (@tmpred_locations){  
1596              my $descriptions = [];              my $descriptions = [];
1597              my ($begin,$end) =split("-",$tmpred);              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1598              my $description_tmpred_score = {"title" => 'TMPRED score',                               "value" => $tm_loc};
1599                               "value" => $tmpred_score};              push(@$descriptions,$description_phobius_tm_locations);
1600    
1601              push(@$descriptions,$description_tmpred_score);              my ($begin,$end) =split("-",$tm_loc);
1602    
1603              my $element_hash = {              my $element_hash = {
1604              "title" => "transmembrane location",              "title" => "Phobius",
1605              "start" => $begin + 1,              "start" => $begin + 1,
1606              "end" =>  $end + 1,              "end" =>  $end + 1,
1607              "color"=> $color,              "color"=> '6',
1608              "zlayer" => '5',              "zlayer" => '4',
1609              "type" => 'smallbox',              "type" => 'bigbox',
1610              "description" => $descriptions};              "description" => $descriptions};
1611    
1612              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1613          }  
1614      }      }
1615    
1616      my $color = "1";          if($phobius_signal_location){
     if($signal_peptide_score){  
1617          my $descriptions = [];          my $descriptions = [];
1618          my $description_signal_peptide_score = {"title" => 'signal peptide score',              my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1619                                                  "value" => $signal_peptide_score};                               "value" => $phobius_signal_location};
1620                push(@$descriptions,$description_phobius_signal_location);
         push(@$descriptions,$description_signal_peptide_score);  
   
         my $description_cleavage_prob = {"title" => 'cleavage site probability',  
                                          "value" => $cleavage_prob};  
1621    
         push(@$descriptions,$description_cleavage_prob);  
1622    
1623                my ($begin,$end) =split("-",$phobius_signal_location);
1624          my $element_hash = {          my $element_hash = {
1625              "title" => "SignalP",              "title" => "phobius signal locations",
1626              "start" => $cleavage_loc_begin - 2,              "start" => $begin + 1,
1627              "end" =>  $cleavage_loc_end + 3,              "end" =>  $end + 1,
1628              "type" => 'bigbox',              "color"=> '1',
1629              "color"=> $color,              "zlayer" => '5',
1630              "zlayer" => '10',              "type" => 'box',
1631              "description" => $descriptions};              "description" => $descriptions};
   
1632          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1633      }      }
1634    
1635      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1636        }
1637    
1638    
1639    #    $color = "1";
1640    #    if($signal_peptide_score){
1641    #       my $line_data = [];
1642    #       my $descriptions = [];
1643    #
1644    #       my $line_config = { 'title' => 'Localization Evidence',
1645    #                           'short_title' => 'SignalP',
1646    #                            'hover_title' => 'Localization',
1647    #                           'basepair_offset' => '1' };
1648    #
1649    #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1650    #                                               "value" => $signal_peptide_score};
1651    #
1652    #       push(@$descriptions,$description_signal_peptide_score);
1653    #
1654    #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1655    #                                        "value" => $cleavage_prob};
1656    #
1657    #       push(@$descriptions,$description_cleavage_prob);
1658    #
1659    #       my $element_hash = {
1660    #           "title" => "SignalP",
1661    #           "start" => $cleavage_loc_begin - 2,
1662    #           "end" =>  $cleavage_loc_end + 1,
1663    #           "type" => 'bigbox',
1664    #           "color"=> $color,
1665    #           "zlayer" => '10',
1666    #           "description" => $descriptions};
1667    #
1668    #       push(@$line_data,$element_hash);
1669    #       $gd->add_line($line_data, $line_config);
1670    #    }
1671    
1672    
1673      return ($gd);      return ($gd);
1674    
# Line 1622  Line 1716 
1716    return $self->{cello_score};    return $self->{cello_score};
1717  }  }
1718    
1719    sub phobius_signal_location {
1720      my ($self) = @_;
1721      return $self->{phobius_signal_location};
1722    }
1723    
1724    sub phobius_tm_locations {
1725      my ($self) = @_;
1726      return $self->{phobius_tm_locations};
1727    }
1728    
1729    
1730    
1731  #########################################  #########################################
1732  #########################################  #########################################
# Line 1635  Line 1740 
1740      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1741      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1742      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1743        $self->{query} = $dataset->{'query'};
1744      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1745      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1746      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1652  Line 1758 
1758    
1759  =head3 display()  =head3 display()
1760    
1761  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display a graphical observation.
1762  This code will display a table for the similarities protein  This code will display a graphical view of the similarities using the genome drawer object
   
 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.  
1763    
1764  =cut  =cut
1765    
1766  sub display {  sub display {
1767      my ($self,$cgi,$dataset) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1768    
1769      my $data = [];      # declare variables
1770      my $count = 0;      my $window_size = $gd->window_size;
1771      my $content;      my $peg = $thing->acc;
1772      my $fig = new FIG;      my $query_id = $thing->query;
1773        my $organism = $thing->organism;
1774        my $abbrev_name = $fig->abbrev($organism);
1775        if (!$organism){
1776          $organism = $peg;
1777          $abbrev_name = $peg;
1778        }
1779        my $genome = $fig->genome_of($peg);
1780        my ($org_tax) = ($genome) =~ /(.*)\./;
1781        my $function = $thing->function;
1782        my $query_start = $thing->qstart;
1783        my $query_stop = $thing->qstop;
1784        my $hit_start = $thing->hstart;
1785        my $hit_stop = $thing->hstop;
1786        my $ln_query = $thing->qlength;
1787        my $ln_hit = $thing->hlength;
1788    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1789    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1790        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1791        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1792    
1793        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1794    
1795        # hit sequence title
1796        my $line_config = { 'title' => "$organism [$org_tax]",
1797                            'short_title' => "$abbrev_name",
1798                            'title_link' => '$tax_link',
1799                            'basepair_offset' => '0',
1800                            'no_middle_line' => '1'
1801                            };
1802    
1803      foreach my $thing (@$dataset) {      # query sequence title
1804          my $single_domain = [];      my $replace_id = $peg;
1805          next if ($thing->class ne "SIM");      $replace_id =~ s/\|/_/ig;
1806          $count++;      my $anchor_name = "anchor_". $replace_id;
1807        my $query_config = { 'title' => "Query",
1808                             'short_title' => "Query",
1809                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1810                             'basepair_offset' => '0',
1811                             'no_middle_line' => '1'
1812                             };
1813        my $line_data = [];
1814        my $query_data = [];
1815    
1816          my $id = $thing->acc;      my $element_hash;
1817        my $hit_links_list = [];
1818        my $hit_descriptions = [];
1819        my $query_descriptions = [];
1820    
1821        # get sequence information
1822        # evidence link
1823        my $evidence_link;
1824        if ($peg =~ /^fig\|/){
1825          $evidence_link = "?page=Annotation&feature=".$peg;
1826        }
1827        else{
1828          my $db = &Observation::get_database($peg);
1829          my ($link_id) = ($peg) =~ /\|(.*)/;
1830          $evidence_link = &HTML::alias_url($link_id, $db);
1831          #print STDERR "LINK: $db    $evidence_link";
1832        }
1833        my $link = {"link_title" => $peg,
1834                    "link" => $evidence_link};
1835        push(@$hit_links_list,$link) if ($evidence_link);
1836    
1837        # subsystem link
1838        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1839        my @subsystems;
1840        foreach my $array (@$subs){
1841            my $subsystem = $$array[0];
1842            push(@subsystems,$subsystem);
1843            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1844                        "link_title" => $subsystem};
1845            push(@$hit_links_list,$link);
1846        }
1847    
1848          # add the subsystem information      # blast alignment
1849          my @in_sub  = $fig->peg_to_subsystems($id);      $link = {"link_title" => "view blast alignment",
1850          my $in_sub;               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1851        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1852    
1853          if (@in_sub > 0) {      # description data
1854              $in_sub = @in_sub;      my $description_function;
1855        $description_function = {"title" => "function",
1856                                 "value" => $function};
1857        push(@$hit_descriptions,$description_function);
1858    
1859              # RAE: add a javascript popup with all the subsystems      # subsystem description
1860              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;      my $ss_string = join (",", @subsystems);
1861              $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);      $ss_string =~ s/_/ /ig;
1862          } else {      my $description_ss = {"title" => "subsystems",
1863              $in_sub = "&nbsp;";                            "value" => $ss_string};
1864          }      push(@$hit_descriptions,$description_ss);
1865    
1866          # add evidence code with tool tip      # location description
1867          my $ev_codes=" &nbsp; ";      # hit
1868          my @ev_codes = "";      my $description_loc;
1869          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {      $description_loc = {"title" => "Hit Location",
1870              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);                          "value" => $hit_start . " - " . $hit_stop};
1871              @ev_codes = ();      push(@$hit_descriptions, $description_loc);
             foreach my $code (@codes) {  
                 my $pretty_code = $code->[2];  
                 if ($pretty_code =~ /;/) {  
                     my ($cd, $ss) = split(";", $code->[2]);  
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
                 }  
                 push(@ev_codes, $pretty_code);  
             }  
         }  
1872    
1873          if (scalar(@ev_codes) && $ev_codes[0]) {      $description_loc = {"title" => "Sequence Length",
1874              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);                          "value" => $ln_hit};
1875              $ev_codes = $cgi->a(      push(@$hit_descriptions, $description_loc);
                                 {  
                                     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));  
         }  
1876    
1877          # add the aliases      # query
1878          my $aliases = undef;      $description_loc = {"title" => "Hit Location",
1879          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );                          "value" => $query_start . " - " . $query_stop};
1880          $aliases = &HTML::set_prot_links( $cgi, $aliases );      push(@$query_descriptions, $description_loc);
         $aliases ||= "&nbsp;";  
   
         my $iden    = $thing->identity;  
         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>)";  
1881    
1882        $description_loc = {"title" => "Sequence Length",
1883                            "value" => $ln_query};
1884        push(@$query_descriptions, $description_loc);
1885    
         push(@$single_domain,$thing->database);  
         push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));  
         push(@$single_domain,$thing->evalue);  
         push(@$single_domain,"$iden\%");  
         push(@$single_domain,$reg1);  
         push(@$single_domain,$reg2);  
         push(@$single_domain,$in_sub);  
         push(@$single_domain,$ev_codes);  
         push(@$single_domain,$thing->organism);  
         push(@$single_domain,$thing->function);  
         push(@$single_domain,$aliases);  
         push(@$data,$single_domain);  
     }  
1886    
1887      if ($count >0){  
1888          $content = $data;      # evalue score description
1889      }      my $evalue = $thing->evalue;
1890      else      while ($evalue =~ /-0/)
1891      {      {
1892          $content = "<p>This PEG does not have any similarities</p>";          my ($chunk1, $chunk2) = split(/-/, $evalue);
1893      }          $chunk2 = substr($chunk2,1);
1894      return ($content);          $evalue = $chunk1 . "-" . $chunk2;
1895  }  }
1896    
1897  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }      my $color = &color($evalue);
1898        my $description_eval = {"title" => "E-Value",
1899                                "value" => $evalue};
1900        push(@$hit_descriptions, $description_eval);
1901        push(@$query_descriptions, $description_eval);
1902    
1903        my $identity = $self->identity;
1904        my $description_identity = {"title" => "Identity",
1905                                    "value" => $identity};
1906        push(@$hit_descriptions, $description_identity);
1907        push(@$query_descriptions, $description_identity);
1908    
1909    
1910  ############################      my $number = $base_start + ($query_start-$hit_start);
1911  package Observation::Cluster;      #print STDERR "START: $number";
1912        $element_hash = {
1913            "title" => $query_id,
1914            "start" => $base_start,
1915            "end" => $base_start+$ln_query,
1916            "type"=> 'box',
1917            "color"=> $color,
1918            "zlayer" => "2",
1919            "links_list" => $query_links_list,
1920            "description" => $query_descriptions
1921            };
1922        push(@$query_data,$element_hash);
1923    
1924  use base qw(Observation);      $element_hash = {
1925            "title" => $query_id . ': HIT AREA',
1926            "start" => $base_start + $query_start,
1927            "end" =>  $base_start + $query_stop,
1928            "type"=> 'smallbox',
1929            "color"=> $query_color,
1930            "zlayer" => "3",
1931            "links_list" => $query_links_list,
1932            "description" => $query_descriptions
1933            };
1934        push(@$query_data,$element_hash);
1935    
1936  sub new {      $gd->add_line($query_data, $query_config);
1937    
     my ($class,$dataset) = @_;  
     my $self = $class->SUPER::new($dataset);  
1938    
1939      bless($self,$class);      $element_hash = {
1940      return $self;                  "title" => $peg,
1941  }                  "start" => $base_start + ($query_start-$hit_start),
1942                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1943                    "type"=> 'box',
1944                    "color"=> $color,
1945                    "zlayer" => "2",
1946                    "links_list" => $hit_links_list,
1947                    "description" => $hit_descriptions
1948                    };
1949        push(@$line_data,$element_hash);
1950    
1951  sub display {      $element_hash = {
1952      my ($self,$gd, $fid, $gd_window_size) = @_;          "title" => $peg . ': HIT AREA',
1953            "start" => $base_start + $query_start,
1954            "end" =>  $base_start + $query_stop,
1955            "type"=> 'smallbox',
1956            "color"=> $hit_color,
1957            "zlayer" => "3",
1958            "links_list" => $hit_links_list,
1959            "description" => $hit_descriptions
1960            };
1961        push(@$line_data,$element_hash);
1962    
1963      my $fig = new FIG;      $gd->add_line($line_data, $line_config);
     my $all_regions = [];  
1964    
1965      #get the organism genome      my $breaker = [];
1966      my $target_genome = $fig->genome_of($fid);      my $breaker_hash = {};
1967        my $breaker_config = { 'no_middle_line' => "1" };
1968    
1969      # get location of the gene      push (@$breaker, $breaker_hash);
1970      my $data = $fig->feature_location($fid);      $gd->add_line($breaker, $breaker_config);
     my ($contig, $beg, $end);  
     my %reverse_flag;  
1971    
1972      if ($data =~ /(.*)_(\d+)_(\d+)$/){      return ($gd);
         $contig = $1;  
         $beg = $2;  
         $end = $3;  
1973      }      }
1974    
1975      my $offset;  =head3 display_domain_composition()
1976      my ($region_start, $region_end);  
1977      if ($beg < $end)  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
1978    
1979    =cut
1980    
1981    sub display_domain_composition {
1982        my ($self,$gd,$fig) = @_;
1983    
1984        #$fig = new FIG;
1985        my $peg = $self->acc;
1986    
1987        my $line_data = [];
1988        my $links_list = [];
1989        my $descriptions = [];
1990    
1991        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1992        #my @domain_query_results = ();
1993        foreach $dqr (@domain_query_results){
1994            my $key = @$dqr[1];
1995            my @parts = split("::",$key);
1996            my $db = $parts[0];
1997            my $id = $parts[1];
1998            my $val = @$dqr[2];
1999            my $from;
2000            my $to;
2001            my $evalue;
2002    
2003            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
2004                my $raw_evalue = $1;
2005                $from = $2;
2006                $to = $3;
2007                if($raw_evalue =~/(\d+)\.(\d+)/){
2008                    my $part2 = 1000 - $1;
2009                    my $part1 = $2/100;
2010                    $evalue = $part1."e-".$part2;
2011                }
2012                else{
2013                    $evalue = "0.0";
2014                }
2015            }
2016    
2017            my $dbmaster = DBMaster->new(-database =>'Ontology',
2018                                    -host     => $WebConfig::DBHOST,
2019                                    -user     => $WebConfig::DBUSER,
2020                                    -password => $WebConfig::DBPWD);
2021            my ($name_value,$description_value);
2022    
2023            if($db eq "CDD"){
2024                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
2025                if(!scalar(@$cdd_objs)){
2026                    $name_title = "name";
2027                    $name_value = "not available";
2028                    $description_title = "description";
2029                    $description_value = "not available";
2030                }
2031                else{
2032                    my $cdd_obj = $cdd_objs->[0];
2033                    $name_value = $cdd_obj->term;
2034                    $description_value = $cdd_obj->description;
2035                }
2036            }
2037    
2038            my $domain_name;
2039            $domain_name = {"title" => "name",
2040                            "value" => $name_value};
2041            push(@$descriptions,$domain_name);
2042    
2043            my $description;
2044            $description = {"title" => "description",
2045                            "value" => $description_value};
2046            push(@$descriptions,$description);
2047    
2048            my $score;
2049            $score = {"title" => "score",
2050                      "value" => $evalue};
2051            push(@$descriptions,$score);
2052    
2053            my $link_id = $id;
2054            my $link;
2055            my $link_url;
2056            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"}
2057            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2058            else{$link_url = "NO_URL"}
2059    
2060            $link = {"link_title" => $name_value,
2061                     "link" => $link_url};
2062            push(@$links_list,$link);
2063    
2064            my $domain_element_hash = {
2065                "title" => $peg,
2066                "start" => $from,
2067                "end" =>  $to,
2068                "type"=> 'box',
2069                "zlayer" => '4',
2070                "links_list" => $links_list,
2071                "description" => $descriptions
2072                };
2073    
2074            push(@$line_data,$domain_element_hash);
2075    
2076            #just one CDD domain for now, later will add option for multiple domains from selected DB
2077            last;
2078        }
2079    
2080        my $line_config = { 'title' => $peg,
2081                            'hover_title' => 'Domain',
2082                            'short_title' => $peg,
2083                            'basepair_offset' => '1' };
2084    
2085        $gd->add_line($line_data, $line_config);
2086    
2087        return ($gd);
2088    
2089    }
2090    
2091    =head3 display_table()
2092    
2093    If available use the function specified here to display the "raw" observation.
2094    This code will display a table for the similarities protein
2095    
2096    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.
2097    
2098    =cut
2099    
2100    sub display_table {
2101        my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2102        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2103    
2104        my $scroll_list;
2105        foreach my $col (@$show_columns){
2106            push (@$scroll_list, $col->{key});
2107        }
2108    
2109        push (@ids, $query_fid);
2110        foreach my $thing (@$dataset) {
2111            next if ($thing->class ne "SIM");
2112            push (@ids, $thing->acc);
2113        }
2114    
2115        $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2116        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2117    
2118        # get the column for the subsystems
2119        $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2120    
2121        # get the column for the evidence codes
2122        $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2123    
2124        # get the column for pfam_domain
2125        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2126    
2127        # get the column for molecular weight
2128        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2129    
2130        # get the column for organism's habitat
2131        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2132    
2133        # get the column for organism's temperature optimum
2134        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2135    
2136        # get the column for organism's temperature range
2137        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2138    
2139        # get the column for organism's oxygen requirement
2140        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2141    
2142        # get the column for organism's pathogenicity
2143        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2144    
2145        # get the column for organism's pathogenicity host
2146        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2147    
2148        # get the column for organism's salinity
2149        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2150    
2151        # get the column for organism's motility
2152        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2153    
2154        # get the column for organism's gram stain
2155        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2156    
2157        # get the column for organism's endospores
2158        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2159    
2160        # get the column for organism's shape
2161        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2162    
2163        # get the column for organism's disease
2164        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2165    
2166        # get the column for organism's disease
2167        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2168    
2169        # get the column for transmembrane domains
2170        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2171    
2172        # get the column for similar to human
2173        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);
2174    
2175        # get the column for signal peptide
2176        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2177    
2178        # get the column for transmembrane domains
2179        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2180    
2181        # get the column for conserved neighborhood
2182        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2183    
2184        # get the column for cellular location
2185        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2186    
2187        # get the aliases
2188        my $alias_col;
2189        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2190             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2191             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2192             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2193             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2194            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2195        }
2196    
2197        # get the colors for the function cell
2198        my $functions = $fig->function_of_bulk(\@ids,1);
2199        $functional_color = &get_function_color_cell($functions, $fig);
2200        my $query_function = $fig->function_of($query_fid);
2201    
2202        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2203    
2204        my $figfam_data = &FIG::get_figfams_data();
2205        my $figfams = new FFs($figfam_data);
2206        my $same_genome_flag = 0;
2207    
2208        my $func_color_offset=0;
2209        unshift(@$dataset, $query_fid);
2210        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2211    #    foreach my $thing ( @$dataset){
2212            my $thing = $dataset->[$thing_count];
2213            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2214            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2215            if ($thing eq $query_fid){
2216                $id = $thing;
2217                $taxid   = $fig->genome_of($id);
2218                $organism = $fig->genus_species($taxid);
2219                $current_function = $fig->function_of($id);
2220            }
2221            else{
2222                next if ($thing->class ne "SIM");
2223    
2224                $id      = $thing->acc;
2225                $evalue  = $thing->evalue;
2226                $taxid   = $fig->genome_of($id);
2227                $iden    = $thing->identity;
2228                $organism= $thing->organism;
2229                $ln1     = $thing->qlength;
2230                $ln2     = $thing->hlength;
2231                $b1      = $thing->qstart;
2232                $e1      = $thing->qstop;
2233                $b2      = $thing->hstart;
2234                $e2      = $thing->hstop;
2235                $d1      = abs($e1 - $b1) + 1;
2236                $d2      = abs($e2 - $b2) + 1;
2237                $color1  = match_color( $b1, $e1, $ln1 );
2238                $color2  = match_color( $b2, $e2, $ln2 );
2239                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2240                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2241                $current_function = $thing->function;
2242                $next_org = $next_thing->organism if (defined $next_thing);
2243            }
2244    
2245            my $single_domain = [];
2246            $count++;
2247    
2248            # organisms cell
2249            my ($org, $org_color) = $fig->org_and_color_of($id);
2250    
2251            my $org_cell;
2252            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2253                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2254            }
2255            elsif ($next_org eq $organism){
2256                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2257                $same_genome_flag = 1;
2258            }
2259            elsif ($same_genome_flag == 1){
2260                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2261                $same_genome_flag = 0;
2262            }
2263    
2264            # checkbox cell
2265            my ($box_cell,$tax, $radio_cell);
2266            my $field_name = "tables_" . $id;
2267            my $pair_name = "visual_" . $id;
2268            my $cell_name = "cell_". $id;
2269            my $replace_id = $id;
2270            $replace_id =~ s/\|/_/ig;
2271            my $white = '#ffffff';
2272            $white = '#999966' if ($id eq $query_fid);
2273            $org_color = '#999966' if ($id eq $query_fid);
2274            my $anchor_name = "anchor_". $replace_id;
2275            my $checked = "";
2276            #$checked = "checked" if ($id eq $query_fid);
2277            if ($id =~ /^fig\|/){
2278              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>~;
2279              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2280              $tax = $fig->genome_of($id);
2281            }
2282            else{
2283              my $box = qq(<a name="$anchor_name"></a>);
2284              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2285            }
2286    
2287            # create the radio cell for any sequence, not just fig ids
2288            my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2289            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2290    
2291            # get the linked fig id
2292            my $anchor_link = "graph_" . $replace_id;
2293            my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2294            $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>);
2295            my $fig_col = {'data'=> $fig_data,
2296                           'highlight'=>$white};
2297    
2298            $replace_id = $peg;
2299            $replace_id =~ s/\|/_/ig;
2300            $anchor_name = "anchor_". $replace_id;
2301            my $query_config = { 'title' => "Query",
2302                                 'short_title' => "Query",
2303                                 'title_link' => "changeSimsLocation('$replace_id')",
2304                                 'basepair_offset' => '0'
2305                                 };
2306    
2307            # function cell
2308            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2309                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2310                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2311    
2312            my $function_color;
2313            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2314                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2315            }
2316            else{
2317                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2318            }
2319            my $function_cell;
2320            if ($current_function){
2321              if ($current_function eq $query_function){
2322                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2323                $func_color_offset=1;
2324              }
2325              else{
2326                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2327              }
2328            }
2329            else{
2330              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2331            }
2332    
2333            if ($id eq $query_fid){
2334                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2335                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2336                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white},
2337                      {'data'=>$subsystems_column->{$id},'highlight'=>$white},
2338                      {'data'=>$evidence_column->{$id},'highlight'=>$white});  # permanent columns
2339            }
2340            else{
2341                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2342                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell,
2343                      {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"},
2344                      {'data'=>$evidence_column->{$id},'highlight'=>"#ffffff"});  # permanent columns
2345    
2346            }
2347    
2348            if ( ( $application->session->user) ){
2349                my $user = $application->session->user;
2350                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2351                    push (@$single_domain,$radio_cell);
2352                }
2353            }
2354    
2355            my ($ff) = $figfams->families_containing_peg($id);
2356    
2357            foreach my $col (@$scroll_list){
2358                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2359                else { $highlight_color = "#ffffff"; }
2360    
2361                if ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2362                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2363                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2364                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2365                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2366                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2367                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2368                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2369                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2370                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2371                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2372                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2373                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2374                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2375                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2393            }
2394            push(@$data,$single_domain);
2395        }
2396        if ($count >0 ){
2397            $content = $data;
2398        }
2399        else{
2400            $content = "<p>This PEG does not have any similarities</p>";
2401        }
2402        shift(@$dataset);
2403        return ($content);
2404    }
2405    
2406    
2407    =head3 display_figfam_table()
2408    
2409    If available use the function specified here to display the "raw" observation.
2410    This code will display a table for the similarities protein
2411    
2412    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.
2413    
2414    =cut
2415    
2416    sub display_figfam_table {
2417      my ($self,$ids, $show_columns, $fig, $application, $cgi) = @_;
2418      my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2419    
2420      my $scroll_list;
2421      foreach my $col (@$show_columns){
2422        push (@$scroll_list, $col->{key});
2423      }
2424    
2425      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2426      my @attributes = $fig->get_attributes($ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2427    
2428      # get the column for the subsystems
2429      $subsystems_column = &get_subsystems_column($ids,$fig,$cgi,'hash');
2430    
2431      # get the column for the evidence codes
2432      $evidence_column = &get_evidence_column($ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2433    
2434      # get the column for pfam_domain
2435      $pfam_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2436    
2437      # get the column for molecular weight
2438      $mw_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2439    
2440      # get the column for organism's habitat
2441      my $habitat_column = &get_attrb_column($ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2442    
2443      # get the column for organism's temperature optimum
2444      my $temperature_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2445    
2446      # get the column for organism's temperature range
2447      my $temperature_range_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2448    
2449      # get the column for organism's oxygen requirement
2450      my $oxygen_req_column = &get_attrb_column($ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2451    
2452      # get the column for organism's pathogenicity
2453      my $pathogenic_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2454    
2455      # get the column for organism's pathogenicity host
2456      my $pathogenic_in_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2457    
2458      # get the column for organism's salinity
2459      my $salinity_column = &get_attrb_column($ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2460    
2461      # get the column for organism's motility
2462      my $motility_column = &get_attrb_column($ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2463    
2464      # get the column for organism's gram stain
2465      my $gram_stain_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2466    
2467      # get the column for organism's endospores
2468      my $endospores_column = &get_attrb_column($ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2469    
2470      # get the column for organism's shape
2471      my $shape_column = &get_attrb_column($ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2472    
2473      # get the column for organism's disease
2474      my $disease_column = &get_attrb_column($ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2475    
2476      # get the column for organism's disease
2477      my $gc_content_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2478    
2479      # get the column for transmembrane domains
2480      my $transmembrane_column = &get_attrb_column($ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2481    
2482      # get the column for similar to human
2483      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);
2484    
2485      # get the column for signal peptide
2486      my $signal_peptide_column = &get_attrb_column($ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2487    
2488      # get the column for transmembrane domains
2489      my $isoelectric_column = &get_attrb_column($ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2490    
2491      # get the column for conserved neighborhood
2492      my $cons_neigh_column = &get_attrb_column($ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2493    
2494      # get the column for cellular location
2495      my $cell_location_column = &get_attrb_column($ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2496    
2497      # get the aliases
2498      my $alias_col;
2499      if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2500           (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2501           (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2502           (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2503           (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2504        $alias_col = &get_db_aliases($ids,$fig,'all',$cgi,'hash');
2505      }
2506    
2507      foreach my $id ( @$ids){
2508        my $current_function = $fig->function_of($id);
2509        my $organism = $fig->org_of($id);
2510        my $single_domain = [];
2511    
2512        # organisms cell
2513        my ($org, $org_color) = $fig->org_and_color_of($id);
2514        my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2515    
2516        # get the linked fig id
2517        my $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2518        my $fig_col = {'data'=> $fig_data,
2519                       'highlight'=>"#ffffff"};
2520    
2521        # function cell
2522        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2523    
2524        # insert data
2525        push (@$single_domain, $fig_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2526    
2527        foreach my $col (@$scroll_list){
2528          my $highlight_color = "#ffffff";
2529    
2530          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2531          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2532          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2533          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2534          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2535          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2536          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2537          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2538          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2539          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2540          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2541          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2542          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2543          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2544          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2545          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2546          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2547          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2548          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2549          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2550          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2551          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2552          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2553          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2554          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2555          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2556          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2557          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2558          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2559          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2560          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2561          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2562          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2563        }
2564        push(@$data,$single_domain);
2565      }
2566    
2567      $content = $data;
2568      return ($content);
2569    }
2570    
2571    sub get_box_column{
2572        my ($ids) = @_;
2573        my %column;
2574        foreach my $id (@$ids){
2575            my $field_name = "tables_" . $id;
2576            my $pair_name = "visual_" . $id;
2577            my $cell_name = "cell_" . $id;
2578            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2579        }
2580        return (%column);
2581    }
2582    
2583    sub get_figfam_column{
2584        my ($ids, $fig, $cgi) = @_;
2585        my $column;
2586    
2587        my $figfam_data = &FIG::get_figfams_data();
2588        my $figfams = new FFs($figfam_data);
2589    
2590        foreach my $id (@$ids){
2591            my ($ff);
2592            if ($id =~ /\.peg\./){
2593                ($ff) =  $figfams->families_containing_peg($id);
2594            }
2595            if ($ff){
2596                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2597            }
2598            else{
2599                push (@$column, " ");
2600            }
2601        }
2602    
2603        return $column;
2604    }
2605    
2606    sub get_subsystems_column{
2607        my ($ids,$fig,$cgi,$returnType) = @_;
2608    
2609        my %in_subs  = $fig->subsystems_for_pegs($ids);
2610        my ($column, $ss);
2611        foreach my $id (@$ids){
2612            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2613            my @subsystems;
2614    
2615            if (@in_sub > 0) {
2616                foreach my $array(@in_sub){
2617                    my $ss = $array->[0];
2618                    $ss =~ s/_/ /ig;
2619                    push (@subsystems, "-" . $ss);
2620                }
2621                my $in_sub_line = join ("<br>", @subsystems);
2622                $ss->{$id} = $in_sub_line;
2623            } else {
2624                $ss->{$id} = "None added";
2625            }
2626            push (@$column, $ss->{$id});
2627        }
2628    
2629        if ($returnType eq 'hash') { return $ss; }
2630        elsif ($returnType eq 'array') { return $column; }
2631    }
2632    
2633    sub get_lineage_column{
2634        my ($ids, $fig, $cgi) = @_;
2635    
2636        my $lineages = $fig->taxonomy_list();
2637    
2638        foreach my $id (@$ids){
2639            my $genome = $fig->genome_of($id);
2640            if ($lineages->{$genome}){
2641    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2642                push (@$column, $lineages->{$genome});
2643            }
2644            else{
2645                push (@$column, " ");
2646            }
2647        }
2648        return $column;
2649    }
2650    
2651    sub match_color {
2652        my ( $b, $e, $n , $rgb) = @_;
2653        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2654        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2655        my $cov = ( $r - $l + 1 ) / $n;
2656        my $sat = 1 - 10 * $cov / 9;
2657        my $br  = 1;
2658        if ($rgb){
2659            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2660        }
2661        else{
2662            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2663        }
2664    }
2665    
2666    sub hsb2rgb {
2667        my ( $h, $s, $br ) = @_;
2668        $h = 6 * ($h - floor($h));
2669        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2670        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2671        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2672                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2673                                          :               ( 0,      1,      $h - 2 )
2674                                          )
2675                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2676                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2677                                          :               ( 1,      0,      6 - $h )
2678                                          );
2679        ( ( $r * $s + 1 - $s ) * $br,
2680          ( $g * $s + 1 - $s ) * $br,
2681          ( $b * $s + 1 - $s ) * $br
2682        )
2683    }
2684    
2685    sub html2rgb {
2686        my ($hex) = @_;
2687        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2688        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2689                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2690    
2691        my @R = split(//, $r);
2692        my @G = split(//, $g);
2693        my @B = split(//, $b);
2694    
2695        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2696        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2697        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2698    
2699        my $rgb = [$red, $green, $blue];
2700        return $rgb;
2701    
2702    }
2703    
2704    sub rgb2html {
2705        my ( $r, $g, $b ) = @_;
2706        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2707        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2708        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2709        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2710    }
2711    
2712    sub floor {
2713        my $x = $_[0];
2714        defined( $x ) || return undef;
2715        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2716    }
2717    
2718    sub get_function_color_cell{
2719      my ($functions, $fig) = @_;
2720    
2721      # figure out the quantity of each function
2722      my %hash;
2723      foreach my $key (keys %$functions){
2724        my $func = $functions->{$key};
2725        $hash{$func}++;
2726      }
2727    
2728      my %func_colors;
2729      my $count = 1;
2730      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2731        $func_colors{$key}=$count;
2732        $count++;
2733      }
2734    
2735      return \%func_colors;
2736    }
2737    
2738    sub get_essentially_identical{
2739        my ($fid,$dataset,$fig) = @_;
2740        #my $fig = new FIG;
2741    
2742        my %id_list;
2743        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2744    
2745        foreach my $thing (@$dataset){
2746            if($thing->class eq "IDENTICAL"){
2747                my $rows = $thing->rows;
2748                my $count_identical = 0;
2749                foreach my $row (@$rows) {
2750                    my $id = $row->[0];
2751                    if (($id ne $fid) && ($fig->function_of($id))) {
2752                        $id_list{$id} = 1;
2753                    }
2754                }
2755            }
2756        }
2757    
2758    #    foreach my $id (@maps_to) {
2759    #        if (($id ne $fid) && ($fig->function_of($id))) {
2760    #           $id_list{$id} = 1;
2761    #        }
2762    #    }
2763        return(%id_list);
2764    }
2765    
2766    
2767    sub get_evidence_column{
2768        my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2769        my ($column, $code_attributes);
2770    
2771        if (! defined $attributes) {
2772            my @attributes_array = $fig->get_attributes($ids);
2773            $attributes = \@attributes_array;
2774        }
2775    
2776        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2777        foreach my $key (@codes){
2778            push (@{$code_attributes->{$key->[0]}}, $key);
2779        }
2780    
2781        foreach my $id (@$ids){
2782            # add evidence code with tool tip
2783            my $ev_codes=" &nbsp; ";
2784    
2785            my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2786            my @ev_codes = ();
2787            foreach my $code (@codes) {
2788                my $pretty_code = $code->[2];
2789                if ($pretty_code =~ /;/) {
2790                    my ($cd, $ss) = split(";", $code->[2]);
2791                    if ($cd =~ /ilit|dlit/){
2792                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2793                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2794                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2795                    }
2796                    $ss =~ s/_/ /g;
2797                    $pretty_code = $cd;# . " in " . $ss;
2798                }
2799                push(@ev_codes, $pretty_code);
2800            }
2801    
2802            if (scalar(@ev_codes) && $ev_codes[0]) {
2803                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2804                $ev_codes = $cgi->a(
2805      {      {
2806          $region_start = $beg - 4000;                                      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));
2807          $region_end = $end+4000;          }
2808          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
2809            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2810            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2811        }
2812        return $column;
2813    }
2814    
2815    sub get_attrb_column{
2816        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2817    
2818        my ($column, %code_attributes, %attribute_locations);
2819        my $dbmaster = DBMaster->new(-database =>'Ontology',
2820                                     -host     => $WebConfig::DBHOST,
2821                                     -user     => $WebConfig::DBUSER,
2822                                     -password => $WebConfig::DBPWD);
2823    
2824        if ($colName eq "pfam"){
2825            if (! defined $attributes) {
2826                my @attributes_array = $fig->get_attributes($ids);
2827                $attributes = \@attributes_array;
2828            }
2829    
2830            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2831            foreach my $key (@codes){
2832                my $name = $key->[1];
2833                if ($name =~ /_/){
2834                    ($name) = ($key->[1]) =~ /(.*?)_/;
2835                }
2836                push (@{$code_attributes{$key->[0]}}, $name);
2837                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2838            }
2839    
2840            foreach my $id (@$ids){
2841                # add pfam code
2842                my $pfam_codes=" &nbsp; ";
2843                my @pfam_codes = "";
2844                my %description_codes;
2845    
2846                if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2847                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2848                    @pfam_codes = ();
2849    
2850                    # get only unique values
2851                    my %saw;
2852                    foreach my $key (@ncodes) {$saw{$key}=1;}
2853                    @ncodes = keys %saw;
2854    
2855                    foreach my $code (@ncodes) {
2856                        my @parts = split("::",$code);
2857                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2858    
2859    #                   # get the locations for the domain
2860    #                   my @locs;
2861    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2862    #                       my ($loc) = ($part) =~ /\;(.*)/;
2863    #                       push (@locs,$loc);
2864    #                   }
2865    #                   my %locsaw;
2866    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2867    #                   @locs = keys %locsaw;
2868    #
2869    #                   my $locations = join (", ", @locs);
2870    #
2871                        if (defined ($description_codes{$parts[1]})){
2872                            push(@pfam_codes, "$parts[1]");
2873                        }
2874                        else {
2875                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2876                            $description_codes{$parts[1]} = $description->[0]->{term};
2877                            push(@pfam_codes, "$pfam_link");
2878                        }
2879                    }
2880    
2881                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2882                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2883                }
2884            }
2885        }
2886        elsif ($colName eq 'cellular_location'){
2887            if (! defined $attributes) {
2888                my @attributes_array = $fig->get_attributes($ids);
2889                $attributes = \@attributes_array;
2890            }
2891    
2892            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2893            foreach my $key (@codes){
2894                my ($loc) = ($key->[1]) =~ /::(.*)/;
2895                my ($new_loc, @all);
2896                @all = split (//, $loc);
2897                my $count = 0;
2898                foreach my $i (@all){
2899                    if ( ($i eq uc($i)) && ($count > 0) ){
2900                        $new_loc .= " " . $i;
2901                    }
2902                    else{
2903                        $new_loc .= $i;
2904      }      }
2905      else                  $count++;
2906      {              }
2907          $region_start = $end-4000;              push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
         $region_end = $beg+4000;  
         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
         $reverse_flag{$target_genome} = 1;  
2908      }      }
2909    
2910      # call genes in region          foreach my $id (@$ids){
2911      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);              my (@values, $entry);
2912      push(@$all_regions,$target_gene_features);              #@values = (" ");
2913      my (@start_array_region);              if (defined @{$code_attributes{$id}}){
2914      push (@start_array_region, $offset);                  my @ncodes = @{$code_attributes{$id}};
2915                    foreach my $code (@ncodes){
2916                        push (@values, $code->[0] . ", " . $code->[1]);
2917                    }
2918                }
2919                else{
2920                    @values = ("Not available");
2921                }
2922    
2923      my %all_genes;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2924      my %all_genomes;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2925      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}          }
2926      my $compare_regions_flag = 1; # set it for compare regions view (0 -> no view, 1-> yes view)      }
2927      my $functional_coupling_flag = 0; # set functional coupling for view (0 -> no view, 1-> yes view)      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2928                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2929            if (! defined $attributes) {
2930                my @attributes_array = $fig->get_attributes($ids);
2931                $attributes = \@attributes_array;
2932            }
2933    
2934      if ($functional_coupling_flag == 1)          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2935      {          foreach my $key (@codes){
2936          my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);              push (@{$code_attributes{$key->[0]}}, $key->[2]);
2937            }
2938    
2939          my $coup_count = 0;          foreach my $id (@$ids){
2940                my (@values, $entry);
2941                #@values = (" ");
2942                if (defined @{$code_attributes{$id}}){
2943                    my @ncodes = @{$code_attributes{$id}};
2944                    foreach my $code (@ncodes){
2945                        push (@values, $code);
2946                    }
2947                }
2948                else{
2949                    @values = ("Not available");
2950                }
2951    
2952          foreach my $pair (@{$coup[0]->[2]}) {              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2953              #   last if ($coup_count > 10);              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
             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);  
2954                  }                  }
2955                  else      }
2956                  {      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2957                      $pair_region_start = $pair_end-4000;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2958                      $pair_region_stop = $pair_beg+4000;              ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2959                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);              ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2960                      $reverse_flag{$pair_genome} = 1;              ($colName eq 'gc_content') ) {
2961            if (! defined $attributes) {
2962                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2963                $attributes = \@attributes_array;
2964                  }                  }
2965    
2966                  push (@start_array_region, $offset);          my $genomes_with_phenotype;
2967            foreach my $attribute (@$attributes){
2968                my $genome = $attribute->[0];
2969                $genomes_with_phenotype->{$genome} = $attribute->[2];
2970            }
2971    
2972                  $all_genomes{$pair_genome} = 1;          foreach my $id (@$ids){
2973                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);              my $genome = $fig->genome_of($id);
2974                  push(@$all_regions,$pair_features);              my @values = (' ');
2975                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}              if (defined $genomes_with_phenotype->{$genome}){
2976                    push (@values, $genomes_with_phenotype->{$genome});
2977              }              }
2978              $coup_count++;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2979                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2980          }          }
2981      }      }
2982    
2983      if ($compare_regions_flag)      return $column;
2984      {  }
2985          # make a hash of genomes that are phylogenetically close  
2986          #my $close_threshold = ".26";  sub get_aclh_aliases {
2987          #my @genomes = $fig->genomes('complete');      my ($ids,$fig,$db,$cgi,$returnType) = @_;
2988          #my %close_genomes = ();      my $db_array;
2989          #foreach my $compared_genome (@genomes)  
2990          #{      my $id_line = join (",", @$ids);
2991          #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);      my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
2992          #    #$close_genomes{$compared_genome} = $dist;  
2993          #    if ($dist <= $close_threshold)  
2994          #    {  }
2995          #       $all_genomes{$compared_genome} = 1;  
2996          #    }  sub get_id_aliases {
2997        my ($id, $fig) = @_;
2998        my $aliases = {};
2999    
3000        my $org = $fig->org_of($id);
3001        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3002        if ( my $form = &LWP::Simple::get($url) ) {
3003            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3004            foreach my $line (split /\n/, $block){
3005                my @values = split /\t/, $line;
3006                next if ($values[3] eq "Expert");
3007                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3008                    $aliases->{$values[4]} = $values[0];
3009                }
3010            }
3011        }
3012    
3013        return $aliases;
3014    }
3015    
3016    sub get_db_aliases {
3017        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3018        my $db_array;
3019        my $all_aliases = $fig->feature_aliases_bulk($ids);
3020        foreach my $id (@$ids){
3021    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3022            my $id_org = $fig->org_of($id);
3023    
3024            foreach my $alias (@{$$all_aliases{$id}}){
3025    #       foreach my $alias (@all_aliases){
3026                my $id_db = &Observation::get_database($alias);
3027                next if ( ($id_db ne $db) && ($db ne 'all') );
3028                next if ($aliases->{$id}->{$db});
3029                my $alias_org = $fig->org_of($alias);
3030    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3031                    #push(@funcs, [$id,$id_db,$tmp]);
3032                    $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3033          #}          #}
3034          $all_genomes{"216592.1"} = 1;          }
3035          $all_genomes{"79967.1"} = 1;          if (!defined( $aliases->{$id}->{$db})){
3036          $all_genomes{"199310.1"} = 1;              $aliases->{$id}->{$db} = " ";
3037          $all_genomes{"216593.1"} = 1;          }
3038          $all_genomes{"155864.1"} = 1;          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3039          $all_genomes{"83334.1"} = 1;          push (@$db_array, $aliases->{$id}->{$db});
3040          $all_genomes{"316407.3"} = 1;      }
3041    
3042          foreach my $comp_genome (keys %all_genomes){      if ($returnType eq 'hash') { return $aliases; }
3043              my $return = $fig->bbh_list($comp_genome,[$fid]);      elsif ($returnType eq 'array') { return $db_array; }
3044              my $feature_list = $return->{$fid};  }
3045              foreach my $peg1 (@$feature_list){  
3046                  my $location = $fig->feature_location($peg1);  
3047                  my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
3048                  $pair_genome = $fig->genome_of($peg1);  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
3049    
3050                  if($location =~/(.*)_(\d+)_(\d+)$/){  sub color {
3051                      $pair_contig = $1;      my ($evalue) = @_;
3052                      $pair_beg = $2;      my $palette = WebColors::get_palette('vitamins');
3053                      $pair_end = $3;      my $color;
3054                      if ($pair_beg < $pair_end)      if ($evalue <= 1e-170){        $color = $palette->[0];    }
3055        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3056        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3057        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3058        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3059        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3060        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3061        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3062        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3063        else{        $color = $palette->[9];    }
3064        return ($color);
3065    }
3066    
3067    
3068    ############################
3069    package Observation::Cluster;
3070    
3071    use base qw(Observation);
3072    
3073    sub new {
3074    
3075        my ($class,$dataset) = @_;
3076        my $self = $class->SUPER::new($dataset);
3077        $self->{context} = $dataset->{'context'};
3078        bless($self,$class);
3079        return $self;
3080    }
3081    
3082    sub display {
3083        my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3084    
3085        $taxes = $fig->taxonomy_list();
3086    
3087        my $fid = $self->fig_id;
3088        my $compare_or_coupling = $self->context;
3089        my $gd_window_size = $gd->window_size;
3090        my $range = $gd_window_size;
3091        my $all_regions = [];
3092        my $gene_associations={};
3093    
3094        #get the organism genome
3095        my $target_genome = $fig->genome_of($fid);
3096        $gene_associations->{$fid}->{"organism"} = $target_genome;
3097        $gene_associations->{$fid}->{"main_gene"} = $fid;
3098        $gene_associations->{$fid}->{"reverse_flag"} = 0;
3099    
3100        # get location of the gene
3101        my $data = $fig->feature_location($fid);
3102        my ($contig, $beg, $end);
3103        my %reverse_flag;
3104    
3105        if ($data =~ /(.*)_(\d+)_(\d+)$/){
3106            $contig = $1;
3107            $beg = $2;
3108            $end = $3;
3109        }
3110    
3111        my $offset;
3112        my ($region_start, $region_end);
3113        if ($beg < $end)
3114                      {                      {
3115                          $pair_region_start = $pair_beg - 4000;          $region_start = $beg - ($range);
3116                          $pair_region_stop = $pair_end + 4000;          $region_end = $end+ ($range);
3117                          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);                          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
3118                      }                      }
3119                      else                      else
3120                      {                      {
3121                          $pair_region_start = $pair_end-4000;          $region_start = $end-($range);
3122                          $pair_region_stop = $pair_beg+4000;          $region_end = $beg+($range);
3123                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
3124                          $reverse_flag{$pair_genome} = 1;          $reverse_flag{$target_genome} = $fid;
3125            $gene_associations->{$fid}->{"reverse_flag"} = 1;
3126                      }                      }
3127    
3128        # call genes in region
3129        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
3130        #foreach my $feat (@$target_gene_features){
3131        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
3132        #}
3133        push(@$all_regions,$target_gene_features);
3134        my (@start_array_region);
3135                      push (@start_array_region, $offset);                      push (@start_array_region, $offset);
3136                      $all_genomes{$pair_genome} = 1;  
3137                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);      my %all_genes;
3138                      push(@$all_regions,$pair_features);      my %all_genomes;
3139                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}      foreach my $feature (@$target_gene_features){
3140            #if ($feature =~ /peg/){
3141                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3142            #}
3143                  }                  }
3144    
3145        my @selected_sims;
3146    
3147        if ($compare_or_coupling eq "sims"){
3148            # get the selected boxes
3149            my @selected_taxonomy = @$selected_taxonomies;
3150    
3151            # get the similarities and store only the ones that match the lineages selected
3152            if (@selected_taxonomy > 0){
3153                foreach my $sim (@$sims_array){
3154                    next if ($sim->class ne "SIM");
3155                    next if ($sim->acc !~ /fig\|/);
3156    
3157                    #my $genome = $fig->genome_of($sim->[1]);
3158                    my $genome = $fig->genome_of($sim->acc);
3159                    #my ($genome1) = ($genome) =~ /(.*)\./;
3160                    my $lineage = $taxes->{$genome};
3161                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3162                    foreach my $taxon(@selected_taxonomy){
3163                        if ($lineage =~ /$taxon/){
3164                            #push (@selected_sims, $sim->[1]);
3165                            push (@selected_sims, $sim->acc);
3166              }              }
3167          }          }
3168      }      }
3169            }
3170            else{
3171                my $simcount = 0;
3172                foreach my $sim (@$sims_array){
3173                    next if ($sim->class ne "SIM");
3174                    next if ($sim->acc !~ /fig\|/);
3175    
3176      # get the PCH to each of the genes                  push (@selected_sims, $sim->acc);
3177      my $pch_sets = [];                  $simcount++;
3178      my %pch_already;                  last if ($simcount > 4);
     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)  
         {  
             foreach my $peg (@$good_set){  
                 if ((!$peg_rank{$peg})){  
                     $peg_rank{$peg} = $counter;  
                     $flag_set = 1;  
3179                  }                  }
3180              }              }
3181              $counter++ if ($flag_set == 1);  
3182            my %saw;
3183            @selected_sims = grep(!$saw{$_}++, @selected_sims);
3184    
3185            # get the gene context for the sorted matches
3186            foreach my $sim_fid(@selected_sims){
3187                #get the organism genome
3188                my $sim_genome = $fig->genome_of($sim_fid);
3189                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
3190                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
3191                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
3192    
3193                # get location of the gene
3194                my $data = $fig->feature_location($sim_fid);
3195                my ($contig, $beg, $end);
3196    
3197                if ($data =~ /(.*)_(\d+)_(\d+)$/){
3198                    $contig = $1;
3199                    $beg = $2;
3200                    $end = $3;
3201          }          }
3202          else  
3203                my $offset;
3204                my ($region_start, $region_end);
3205                if ($beg < $end)
3206          {          {
3207              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
3208                  $peg_rank{$peg} = 100;                  $region_end = $end+($range/2);
3209                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
3210              }              }
3211                else
3212                {
3213                    $region_start = $end-($range/2);
3214                    $region_end = $beg+($range/2);
3215                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3216                    $reverse_flag{$sim_genome} = $sim_fid;
3217                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
3218          }          }
3219    
3220                # call genes in region
3221                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
3222                push(@$all_regions,$sim_gene_features);
3223                push (@start_array_region, $offset);
3224                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
3225                $all_genomes{$sim_genome} = 1;
3226      }      }
3227    
3228        }
3229    
3230  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3231  #    my %already;      # cluster the genes
3232  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
3233  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3234  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3235  #      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;  
 #           }  
 #       }  
 #    }  
3236    
3237      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3238          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3239          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3240          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3241          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3242            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3243            my $lineage = $taxes->{$region_genome};
3244            #my $lineage = $fig->taxonomy_of($region_genome);
3245            #$region_gs .= "Lineage:$lineage";
3246          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3247                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3248                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2039  Line 3250 
3250    
3251          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3252    
3253            my $second_line_config = { 'title' => "$lineage",
3254                                       'short_title' => "",
3255                                       'basepair_offset' => '0',
3256                                       'no_middle_line' => '1'
3257                                       };
3258    
3259          my $line_data = [];          my $line_data = [];
3260            my $second_line_data = [];
3261    
3262            # initialize variables to check for overlap in genes
3263            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
3264            my $major_line_flag = 0;
3265            my $prev_second_flag = 0;
3266    
3267          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
3268                $second_line_flag = 0;
3269              my $element_hash;              my $element_hash;
3270              my $links_list = [];              my $links_list = [];
3271              my $descriptions = [];              my $descriptions = [];
3272    
3273              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
3274    
3275              # get subsystem information              # get subsystem information
3276              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3277              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3278    
3279              my $link;              my $link;
3280              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3281                       "link" => $url_link};                       "link" => $url_link};
3282              push(@$links_list,$link);              push(@$links_list,$link);
3283    
3284              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3285              foreach my $subsystem (@subsystems){              my @subsystems;
3286                foreach my $array (@subs){
3287                    my $subsystem = $$array[0];
3288                    my $ss = $subsystem;
3289                    $ss =~ s/_/ /ig;
3290                    push (@subsystems, $ss);
3291                  my $link;                  my $link;
3292                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3293                           "link_title" => $subsystem};                           "link_title" => $ss};
3294                    push(@$links_list,$link);
3295                }
3296    
3297                if ($fid1 eq $fid){
3298                    my $link;
3299                    $link = {"link_title" => "Annotate this sequence",
3300                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3301                  push(@$links_list,$link);                  push(@$links_list,$link);
3302              }              }
3303    
# Line 2082  Line 3319 
3319                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
3320                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
3321    
3322                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
3323                         ( ($start < $prev_start) || ($start < $prev_stop) ||
3324                           ($stop < $prev_start) || ($stop < $prev_stop) )){
3325                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
3326                            $second_line_flag = 1;
3327                            $major_line_flag = 1;
3328                        }
3329                    }
3330                    $prev_start = $start;
3331                    $prev_stop = $stop;
3332                    $prev_fig = $fid1;
3333    
3334                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3335                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3336                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3337                  }                  }
3338    
3339                    my $title = $fid1;
3340                    if ($fid1 eq $fid){
3341                        $title = "My query gene: $fid1";
3342                    }
3343    
3344                  $element_hash = {                  $element_hash = {
3345                      "title" => $fid1,                      "title" => $title,
3346                      "start" => $start,                      "start" => $start,
3347                      "end" =>  $stop,                      "end" =>  $stop,
3348                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2097  Line 3351 
3351                      "links_list" => $links_list,                      "links_list" => $links_list,
3352                      "description" => $descriptions                      "description" => $descriptions
3353                  };                  };
3354                  push(@$line_data,$element_hash);  
3355                    # if there is an overlap, put into second line
3356                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3357                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3358    
3359                    if ($fid1 eq $fid){
3360                        $element_hash = {
3361                            "title" => 'Query',
3362                            "start" => $start,
3363                            "end" =>  $stop,
3364                            "type"=> 'bigbox',
3365                            "color"=> $color,
3366                            "zlayer" => "1"
3367                            };
3368    
3369                        # if there is an overlap, put into second line
3370                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3371                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3372                    }
3373              }              }
3374          }          }
3375          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3376            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3377      }      }
3378      return $gd;      return ($gd, \@selected_sims);
3379    }
3380    
3381    sub cluster_genes {
3382        my($fig,$all_pegs,$peg) = @_;
3383        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3384    
3385        my @color_sets = ();
3386    
3387        $conn = &get_connections_by_similarity($fig,$all_pegs);
3388    
3389        for ($i=0; ($i < @$all_pegs); $i++) {
3390            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3391            if (! $seen{$i}) {
3392                $cluster = [$i];
3393                $seen{$i} = 1;
3394                for ($j=0; ($j < @$cluster); $j++) {
3395                    $x = $conn->{$cluster->[$j]};
3396                    foreach $k (@$x) {
3397                        if (! $seen{$k}) {
3398                            push(@$cluster,$k);
3399                            $seen{$k} = 1;
3400                        }
3401                    }
3402                }
3403    
3404                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3405                    push(@color_sets,$cluster);
3406                }
3407            }
3408        }
3409        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3410        $red_set = $color_sets[$i];
3411        splice(@color_sets,$i,1);
3412        @color_sets = sort { @$b <=> @$a } @color_sets;
3413        unshift(@color_sets,$red_set);
3414    
3415        my $color_sets = {};
3416        for ($i=0; ($i < @color_sets); $i++) {
3417            foreach $x (@{$color_sets[$i]}) {
3418                $color_sets->{$all_pegs->[$x]} = $i;
3419            }
3420        }
3421        return $color_sets;
3422  }  }
3423    
3424    sub get_connections_by_similarity {
3425        my($fig,$all_pegs) = @_;
3426        my($i,$j,$tmp,$peg,%pos_of);
3427        my($sim,%conn,$x,$y);
3428    
3429        for ($i=0; ($i < @$all_pegs); $i++) {
3430            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3431            push(@{$pos_of{$tmp}},$i);
3432            if ($tmp ne $all_pegs->[$i]) {
3433                push(@{$pos_of{$all_pegs->[$i]}},$i);
3434            }
3435        }
3436    
3437        foreach $y (keys(%pos_of)) {
3438            $x = $pos_of{$y};
3439            for ($i=0; ($i < @$x); $i++) {
3440                for ($j=$i+1; ($j < @$x); $j++) {
3441                    push(@{$conn{$x->[$i]}},$x->[$j]);
3442                    push(@{$conn{$x->[$j]}},$x->[$i]);
3443                }
3444            }
3445        }
3446    
3447        for ($i=0; ($i < @$all_pegs); $i++) {
3448            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3449                if (defined($x = $pos_of{$sim->id2})) {
3450                    foreach $y (@$x) {
3451                        push(@{$conn{$i}},$y);
3452                    }
3453                }
3454            }
3455        }
3456        return \%conn;
3457    }
3458    
3459    sub in {
3460        my($x,$xL) = @_;
3461        my($i);
3462    
3463        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3464        return ($i < @$xL);
3465    }
3466    
3467    #############################################
3468    #############################################
3469    package Observation::Commentary;
3470    
3471    use base qw(Observation);
3472    
3473    =head3 display_protein_commentary()
3474    
3475    =cut
3476    
3477    sub display_protein_commentary {
3478        my ($self,$dataset,$mypeg,$fig) = @_;
3479    
3480        my $all_rows = [];
3481        my $content;
3482        #my $fig = new FIG;
3483        my $cgi = new CGI;
3484        my $count = 0;
3485        my $peg_array = [];
3486        my ($evidence_column, $subsystems_column,  %e_identical);
3487    
3488        if (@$dataset != 1){
3489            foreach my $thing (@$dataset){
3490                if ($thing->class eq "SIM"){
3491                    push (@$peg_array, $thing->acc);
3492                }
3493            }
3494            # get the column for the evidence codes
3495            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3496    
3497            # get the column for the subsystems
3498            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3499    
3500            # get essentially identical seqs
3501            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3502        }
3503        else{
3504            push (@$peg_array, @$dataset);
3505        }
3506    
3507        my $selected_sims = [];
3508        foreach my $id (@$peg_array){
3509            last if ($count > 10);
3510            my $row_data = [];
3511            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3512            if ($fig->org_of($id)){
3513                $org = $fig->org_of($id);
3514            }
3515            else{
3516                $org = "Data not available";
3517            }
3518            $function = $fig->function_of($id);
3519            if ($mypeg ne $id){
3520                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3521                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3522                if (defined($e_identical{$id})) { $id_cell .= "*";}
3523            }
3524            else{
3525                $function_cell = "&nbsp;&nbsp;$function";
3526                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3527                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3528            }
3529    
3530            push(@$row_data,$id_cell);
3531            push(@$row_data,$org);
3532            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3533            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3534            push(@$row_data, $fig->translation_length($id));
3535            push(@$row_data,$function_cell);
3536            push(@$all_rows,$row_data);
3537            push (@$selected_sims, $id);
3538            $count++;
3539        }
3540    
3541        if ($count >0){
3542            $content = $all_rows;
3543        }
3544        else{
3545            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3546        }
3547        return ($content,$selected_sims);
3548    }
3549    
3550    sub display_protein_history {
3551        my ($self, $id,$fig) = @_;
3552        my $all_rows = [];
3553        my $content;
3554    
3555        my $cgi = new CGI;
3556        my $count = 0;
3557        foreach my $feat ($fig->feature_annotations($id)){
3558            my $row = [];
3559            my $col1 = $feat->[2];
3560            my $col2 = $feat->[1];
3561            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3562            my $text = $feat->[3];
3563    
3564            push (@$row, $col1);
3565            push (@$row, $col2);
3566            push (@$row, $text);
3567            push (@$all_rows, $row);
3568            $count++;
3569        }
3570        if ($count > 0){
3571            $content = $all_rows;
3572        }
3573        else {
3574            $content = "There is no history for this PEG";
3575        }
3576    
3577        return($content);
3578    }
3579    

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.74

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3