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

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.60

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3