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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3