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

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.76

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3