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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3