[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.55, Sat Feb 23 06:48:43 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);
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 display_housekeeping
378    This method returns the housekeeping data for a given peg in a table format
 These methods are not meant to be used outside of this package.  
   
 B<Please do not use them outside of this package!>  
379    
380  =cut  =cut
381    sub display_housekeeping {
382        my ($self,$fid,$fig) = @_;
383        my $content = [];
384        my $row = [];
385    
386        my $org_name = $fig->org_of($fid);
387        my $org_id = $fig->genome_of($fid);
388        my $function = $fig->function_of($fid);
389        #my $taxonomy = $fig->taxonomy_of($org_id);
390        my $length = $fig->translation_length($fid);
391    
392        push (@$row, $org_name);
393        push (@$row, $fid);
394        push (@$row, $length);
395        push (@$row, $function);
396    
397        # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404        #$content .= qq(</table><p>\n);
405    
406        push(@$content, $row);
407    
408  =head3 get_url (internal)      return ($content);
409    }
 get_url() return a valid URL or undef for any observation.  
   
 URLs are constructed by looking at the Accession acc()  and  name()  
410    
411  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 get_sims_summary
412    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
413    
414  =cut  =cut
415    
416  sub get_url {  sub get_sims_summary {
417        my ($observation, $dataset, $fig) = @_;
418        my %families;
419        my $taxes = $fig->taxonomy_list();
420    
421   my ($self) = @_;      foreach my $thing (@$dataset) {
422   my $url='';          my ($id, $evalue);
423            if ($thing =~ /fig\|/){
424  # a hash with a URL for each observation; identified by name()              $id = $thing;
425  #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\              $evalue = -1;
426  #                       'IPR'    => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\          }
427  #                          'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\          else{
428  #                       'PIR'    => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\              next if ($thing->class ne "SIM");
429  #                       'FIGFAM' => '',\              $id      = $thing->acc;
430  #                          'sim'=> "http://www.theseed.org/linkin.cgi?id=",\              $evalue  = $thing->evalue;
431  #                          'bbh'=> "http://www.theseed.org/linkin.cgi?id="          }
432  #};          next if ($id !~ /fig\|/);
433            next if ($fig->is_deleted_fid($id));
434    
435            my $genome = $fig->genome_of($id);
436            #my ($genome1) = ($genome) =~ /(.*)\./;
437            my $taxonomy = $taxes->{$genome};
438            my $parent_tax = "Root";
439            my @currLineage = ($parent_tax);
440            push (@{$families{figs}{$parent_tax}}, $id);
441            my $level = 2;
442            foreach my $tax (split(/\; /, $taxonomy)){
443                push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
444                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
445                $families{level}{$tax} = $level;
446                push (@currLineage, $tax);
447                $families{parent}{$tax} = $parent_tax;
448                $families{lineage}{$tax} = join(";", @currLineage);
449                if (defined ($families{evalue}{$tax})){
450                    if ($evalue < $families{evalue}{$tax}){
451                        $families{evalue}{$tax} = $evalue;
452                        $families{color}{$tax} = &get_taxcolor($evalue);
453                    }
454                }
455                else{
456                    $families{evalue}{$tax} = $evalue;
457                    $families{color}{$tax} = &get_taxcolor($evalue);
458                }
459    
460  # if (defined $URL{$self->name}) {              $parent_tax = $tax;
461  #     $url = $URL{$self->name}.$self->acc;              $level++;
462  #     return $url;          }
 # }  
 # else  
      return undef;  
463  }  }
464    
465  =head3 get_display_method (internal)      foreach my $key (keys %{$families{children}}){
466            $families{count}{$key} = @{$families{children}{$key}};
467    
468  get_display_method() return a valid URL or undef for any observation.          my %saw;
469            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
470            $families{children}{$key} = \@out;
471        }
472    
473  URLs are constructed by looking at the Accession acc()  and  name()      return \%families;
474  and Info from both attributes is combined with a table of base URLs stored in this function.  }
475    
476  =cut  =head1 Internal Methods
477    
478  sub get_display_method {  These methods are not meant to be used outside of this package.
479    
480   my ($self) = @_;  B<Please do not use them outside of this package!>
481    
482  # a hash with a URL for each observation; identified by name()  =cut
 #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\  
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
483    
484  #if (defined $URL{$self->name}) {  sub get_taxcolor{
485  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;      my ($evalue) = @_;
486  #     return $url;      my $color;
487  # }      if ($evalue == -1){            $color = "black";      }
488  # else      elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
489       return undef;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
490        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
491        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
492        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
493        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
494        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
495        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
496        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
497        else{        $color = "#6666FF";    }
498        return ($color);
499  }  }
500    
501    
502  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
503    
504      # 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)
505      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
506    
507      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
508          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
509          my @parts = split("::",$key);          my @parts = split("::",$key);
510          my $class = $parts[0];          my $class = $parts[0];
511            my $name = $parts[1];
512            next if (($class eq "PFAM") && ($name !~ /interpro/));
513    
514          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
515              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 447  Line 518 
518                  my $from = $2;                  my $from = $2;
519                  my $to = $3;                  my $to = $3;
520                  my $evalue;                  my $evalue;
521                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
522                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
523                      my $part1 = $2/100;                      my $part1 = $2/100;
524                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
525                  }                  }
526                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
527                        $evalue=$raw_evalue;
528                    }
529                  else{                  else{
530                      $evalue = "0.0";                      $evalue = "0.0";
531                  }                  }
# Line 461  Line 535 
535                                 'type' => "dom" ,                                 'type' => "dom" ,
536                                 'evalue' => $evalue,                                 'evalue' => $evalue,
537                                 'start' => $from,                                 'start' => $from,
538                                 'stop' => $to                                 'stop' => $to,
539                                   'fig_id' => $fid,
540                                   'score' => $raw_evalue
541                                 };                                 };
542    
543                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 470  Line 546 
546      }      }
547  }  }
548    
549  =head3 get_attribute_based_evidence (internal)  sub get_attribute_based_location_observations{
550    
551  This method retrieves evidence from the attribute server      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
552        #my $fig = new FIG;
553    
554  =cut      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
555    
556        my $dataset = {'type' => "loc",
557                       'class' => 'SIGNALP_CELLO_TMPRED',
558                       'fig_id' => $fid
559                       };
560    
561  sub get_attribute_based_observations{      foreach my $attr_ref (@$attributes_ref){
562            my $key = @$attr_ref[1];
563            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
564            my @parts = split("::",$key);
565            my $sub_class = $parts[0];
566            my $sub_key = $parts[1];
567            my $value = @$attr_ref[2];
568            if($sub_class eq "SignalP"){
569                if($sub_key eq "cleavage_site"){
570                    my @value_parts = split(";",$value);
571                    $dataset->{'cleavage_prob'} = $value_parts[0];
572                    $dataset->{'cleavage_loc'} = $value_parts[1];
573                }
574                elsif($sub_key eq "signal_peptide"){
575                    $dataset->{'signal_peptide_score'} = $value;
576                }
577            }
578    
579      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)          elsif($sub_class eq "CELLO"){
580      my ($fid,$datasets_ref) = (@_);              $dataset->{'cello_location'} = $sub_key;
581                $dataset->{'cello_score'} = $value;
582            }
583    
584      my $_myfig = new FIG;          elsif($sub_class eq "Phobius"){
585                if($sub_key eq "transmembrane"){
586                    $dataset->{'phobius_tm_locations'} = $value;
587                }
588                elsif($sub_key eq "signal"){
589                    $dataset->{'phobius_signal_location'} = $value;
590                }
591            }
592    
593      foreach my $attr_ref ($_myfig->get_attributes($fid)) {          elsif($sub_class eq "TMPRED"){
594                my @value_parts = split(/\;/,$value);
595                $dataset->{'tmpred_score'} = $value_parts[0];
596                $dataset->{'tmpred_locations'} = $value_parts[1];
597            }
598        }
599    
600          # convert the ref into a string for easier handling      push (@{$datasets_ref} ,$dataset);
         my ($string) = "@$attr_ref";  
601    
602  #       print "S:$string\n";  }
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
603    
604          # 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  
         #  
605    
606          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  This methods sets the type and class for pdb observations
607    
608              # some keys are composite CDD::1233244 or PFAM:PF1233  =cut
609    
610              if ( $key =~ /::/ ) {  sub get_pdb_observations{
611                  my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
             }  
612    
613              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );      #my $fig = new FIG;
614    
615              my $evalue= 255;      foreach my $attr_ref (@$attributes_ref){
616              if (defined $raw_evalue) { # some of the tool do not give us an evalue          my $key = @$attr_ref[1];
617            next if ( ($key !~ /PDB/));
618            my($key1,$key2) =split("::",$key);
619            my $value = @$attr_ref[2];
620            my ($evalue,$location) = split(";",$value);
621    
622                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);          if($evalue =~/(\d+)\.(\d+)/){
623                  my ($new_k, $new_exp);              my $part2 = 1000 - $1;
624                my $part1 = $2/100;
625                $evalue = $part1."e-".$part2;
626            }
627    
628                  #          my($start,$stop) =split("-",$location);
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
629    
630  #                   $new_exp = (1000+$expo);          my $url = @$attr_ref[3];
631          #           $new_k = $k / 100;          my $dataset = {'class' => 'PDB',
632                           'type' => 'seq' ,
633                           'acc' => $key2,
634                           'evalue' => $evalue,
635                           'start' => $start,
636                           'stop' => $stop,
637                           'fig_id' => $fid
638                           };
639    
640            push (@{$datasets_ref} ,$dataset);
641                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
642              }              }
643    
644              # unroll it all into an array of hashes  =head3 get_cluster_observations() (internal)
645              # this needs to be done differently for different types of observations  
646              my $dataset = [ { name => 'class', value => $key },  This methods sets the type and class for cluster observations
647                              { name => 'acc' , value => $acc},  
648                              { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  =cut
649                              { name => 'evalue', value => $evalue },  
650                              { name => 'start', value => $from},  sub get_cluster_observations{
651                              { name => 'stop' , value => $to}      my ($fid,$datasets_ref,$scope) = (@_);
                             ];  
652    
653        my $dataset = {'class' => 'CLUSTER',
654                       'type' => 'fc',
655                       'context' => $scope,
656                       'fig_id' => $fid
657                       };
658              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
659          }          }
660      }  
 }  
661    
662  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
663    
# Line 550  Line 667 
667    
668  sub get_sims_observations{  sub get_sims_observations{
669    
670      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
671      my $fig = new FIG;      #my $fig = new FIG;
672      my @sims= $fig->nsims($fid,100,1e-20,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
673      my ($dataset);      my ($dataset);
674    
675      foreach my $sim (@sims){      foreach my $sim (@sims){
676            next if ($fig->is_deleted_fid($sim->[1]));
677          my $hit = $sim->[1];          my $hit = $sim->[1];
678            my $percent = $sim->[2];
679          my $evalue = $sim->[10];          my $evalue = $sim->[10];
680          my $from = $sim->[8];          my $qfrom = $sim->[6];
681          my $to = $sim->[9];          my $qto = $sim->[7];
682          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
683                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
684                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
685                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
686                          { name => 'start', value => $from},          my $db = get_database($hit);
687                          { name => 'stop' , value => $to}          my $func = $fig->function_of($hit);
688                          ];          my $organism = $fig->org_of($hit);
689    
690            $dataset = {'class' => 'SIM',
691                        'query' => $sim->[0],
692                        'acc' => $hit,
693                        'identity' => $percent,
694                        'type' => 'seq',
695                        'evalue' => $evalue,
696                        'qstart' => $qfrom,
697                        'qstop' => $qto,
698                        'hstart' => $hfrom,
699                        'hstop' => $hto,
700                        'database' => $db,
701                        'organism' => $organism,
702                        'function' => $func,
703                        'qlength' => $qlength,
704                        'hlength' => $hlength,
705                        'fig_id' => $fid
706                        };
707    
708      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
709      }      }
710  }  }
711    
712    =head3 get_database (internal)
713    This method gets the database association from the sequence id
714    
715    =cut
716    
717    sub get_database{
718        my ($id) = (@_);
719    
720        my ($db);
721        if ($id =~ /^fig\|/)              { $db = "FIG" }
722        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
723        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
724        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
725        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
726        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
727        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
728        elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
729        elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
730        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
731        elsif ($id =~ /^img\|/)           { $db = "JGI" }
732    
733        return ($db);
734    
735    }
736    
737    
738  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
739    
740  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 578  Line 743 
743    
744  sub get_identical_proteins{  sub get_identical_proteins{
745    
746      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
747      my $fig = new FIG;      #my $fig = new FIG;
748      my @funcs = ();      my $funcs_ref;
749    
750      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);
   
751      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
752          my ($tmp, $who);          my ($tmp, $who);
753          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
754              if ($id =~ /^fig\|/)           { $who = "FIG" }              $who = &get_database($id);
755              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]);  
756          }          }
757      }      }
758    
759      my ($dataset);      my $dataset = {'class' => 'IDENTICAL',
760      foreach my $row (@funcs){                     'type' => 'seq',
761          my $id = $row->[0];                     'fig_id' => $fid,
762          my $organism = $fig->org_of($fid);                     'rows' => $funcs_ref
763          my $who = $row->[1];                     };
764          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}  
                      ];  
765          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
766      }  
767    
768  }  }
769    
# Line 627  Line 775 
775    
776  sub get_functional_coupling{  sub get_functional_coupling{
777    
778      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
779      my $fig = new FIG;      #my $fig = new FIG;
780      my @funcs = ();      my @funcs = ();
781    
782      # initialize some variables      # initialize some variables
# Line 645  Line 793 
793                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
794                    } @fc_data;                    } @fc_data;
795    
796      my ($dataset);      my $dataset = {'class' => 'PCH',
797      foreach my $row (@rows){                     'type' => 'fc',
798          my $id = $row->[1];                     'fig_id' => $fid,
799          my $score = $row->[0];                     'rows' => \@rows
800          my $description = $row->[2];                     };
801          $dataset = [ { name => 'class', value => "FC" },  
                      { name => 'score' , value => $score},  
                      { name => 'id', value => "$id"} ,  
                      { name => 'description' , value => $description}  
                      ];  
802          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
803      }  
804  }  }
805    
806  =head3 get_sims_and_bbhs() (internal)  =head3 new (internal)
807    
808  This methods retrieves sims and also BBHs and fills the internal data structures.  Instantiate a new object.
809    
810  =cut  =cut
811    
812  #     sub get_sims_and_bbhs{  sub new {
813      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";  
 #       }  
814    
815  #     }    my $self = { class => $dataset->{'class'},
816                   type => $dataset->{'type'},
817                   fig_id => $dataset->{'fig_id'},
818                   score => $dataset->{'score'},
819               };
820    
821      bless($self,$class);
822    
823      return $self;
824    }
825    
826  =head3 new (internal)  =head3 identity (internal)
827    
828  Instantiate a new object.  Returns the % identity of the similar sequence
829    
830  =cut  =cut
831    
832  sub new {  sub identity {
833    my ($class,$dataset) = @_;      my ($self) = @_;
   
834    
835    #$self = { acc => '',      return $self->{identity};
836  #           description => '',  }
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
837    
838    my $self = { class => $dataset->{'class'},  =head3 fig_id (internal)
                type => $dataset->{'type'}  
             };  
839    
840    bless($self,$class);  =cut
841    
842    return $self;  sub fig_id {
843      my ($self) = @_;
844      return $self->{fig_id};
845  }  }
846    
847  =head3 feature_id (internal)  =head3 feature_id (internal)
# Line 775  Line 879 
879      return $self->{organism};      return $self->{organism};
880  }  }
881    
882    =head3 function (internal)
883    
884    Returns the function of the identical sequence
885    
886    =cut
887    
888    sub function {
889        my ($self) = @_;
890    
891        return $self->{function};
892    }
893    
894  =head3 database (internal)  =head3 database (internal)
895    
896  Returns the database of the identical sequence  Returns the database of the identical sequence
# Line 787  Line 903 
903      return $self->{database};      return $self->{database};
904  }  }
905    
906  #package Observation::Identical;  ############################################################
907  #1;  ############################################################
908  #  package Observation::PDB;
909  #our @ISA = qw(Observation);  # inherits all the methods from Observation  
910    use base qw(Observation);
911    
912  =head3 display_identical()  sub new {
913    
914  If available use the function specified here to display the "raw" observation.      my ($class,$dataset) = @_;
915  This code will display a table for the identical protein      my $self = $class->SUPER::new($dataset);
916        $self->{acc} = $dataset->{'acc'};
917        $self->{evalue} = $dataset->{'evalue'};
918        $self->{start} = $dataset->{'start'};
919        $self->{stop} = $dataset->{'stop'};
920        bless($self,$class);
921        return $self;
922    }
923    
924    =head3 display()
925    
926  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.  displays data stored in best_PDB attribute and in Ontology server for given PDB id
927    
928  =cut  =cut
929    
930  sub display_identical {  sub display{
931      my ($self, $fid, $cgi) = @_;      my ($self,$gd,$fig) = @_;
932    
933      my $content;      my $fid = $self->fig_id;
934      my $array=Observation->get_objects($fid);      my $dbmaster = DBMaster->new(-database =>'Ontology',
935                                    -host     => $WebConfig::DBHOST,
936                                    -user     => $WebConfig::DBUSER,
937                                    -password => $WebConfig::DBPWD);
938    
939        my $acc = $self->acc;
940    
941        my ($pdb_description,$pdb_source,$pdb_ligand);
942        my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
943        if(!scalar(@$pdb_objs)){
944            $pdb_description = "not available";
945            $pdb_source = "not available";
946            $pdb_ligand = "not available";
947        }
948        else{
949            my $pdb_obj = $pdb_objs->[0];
950            $pdb_description = $pdb_obj->description;
951            $pdb_source = $pdb_obj->source;
952            $pdb_ligand = $pdb_obj->ligand;
953        }
954    
955      my $all_domains = [];      my $lines = [];
956        my $line_data = [];
957        my $line_config = { 'title' => "PDB hit for $fid",
958                            'hover_title' => 'PDB',
959                            'short_title' => "best PDB",
960                            'basepair_offset' => '1' };
961    
962        #my $fig = new FIG;
963        my $seq = $fig->get_translation($fid);
964        my $fid_stop = length($seq);
965    
966        my $fid_element_hash = {
967            "title" => $fid,
968            "start" => '1',
969            "end" =>  $fid_stop,
970            "color"=> '1',
971            "zlayer" => '1'
972            };
973    
974        push(@$line_data,$fid_element_hash);
975    
976        my $links_list = [];
977        my $descriptions = [];
978    
979        my $name;
980        $name = {"title" => 'id',
981                 "value" => $acc};
982        push(@$descriptions,$name);
983    
984        my $description;
985        $description = {"title" => 'pdb description',
986                        "value" => $pdb_description};
987        push(@$descriptions,$description);
988    
989        my $score;
990        $score = {"title" => "score",
991                  "value" => $self->evalue};
992        push(@$descriptions,$score);
993    
994        my $start_stop;
995        my $start_stop_value = $self->start."_".$self->stop;
996        $start_stop = {"title" => "start-stop",
997                       "value" => $start_stop_value};
998        push(@$descriptions,$start_stop);
999    
1000        my $source;
1001        $source = {"title" => "source",
1002                  "value" => $pdb_source};
1003        push(@$descriptions,$source);
1004    
1005        my $ligand;
1006        $ligand = {"title" => "pdb ligand",
1007                   "value" => $pdb_ligand};
1008        push(@$descriptions,$ligand);
1009    
1010        my $link;
1011        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
1012    
1013        $link = {"link_title" => $acc,
1014                 "link" => $link_url};
1015        push(@$links_list,$link);
1016    
1017        my $pdb_element_hash = {
1018            "title" => "PDB homology",
1019            "start" => $self->start,
1020            "end" =>  $self->stop,
1021            "color"=> '6',
1022            "zlayer" => '3',
1023            "links_list" => $links_list,
1024            "description" => $descriptions};
1025    
1026        push(@$line_data,$pdb_element_hash);
1027        $gd->add_line($line_data, $line_config);
1028    
1029        return $gd;
1030    }
1031    
1032    1;
1033    
1034    ############################################################
1035    ############################################################
1036    package Observation::Identical;
1037    
1038    use base qw(Observation);
1039    
1040    sub new {
1041    
1042        my ($class,$dataset) = @_;
1043        my $self = $class->SUPER::new($dataset);
1044        $self->{rows} = $dataset->{'rows'};
1045    
1046        bless($self,$class);
1047        return $self;
1048    }
1049    
1050    =head3 display_table()
1051    
1052    If available use the function specified here to display the "raw" observation.
1053    This code will display a table for the identical protein
1054    
1055    
1056    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
1057    dence.
1058    
1059    =cut
1060    
1061    
1062    sub display_table{
1063        my ($self,$fig) = @_;
1064    
1065        #my $fig = new FIG;
1066        my $fid = $self->fig_id;
1067        my $rows = $self->rows;
1068        my $cgi = new CGI;
1069        my $all_domains = [];
1070      my $count_identical = 0;      my $count_identical = 0;
1071      foreach my $thing (@$array) {      my $content;
1072          next if ($thing->class ne "IDENTICAL");      foreach my $row (@$rows) {
1073            my $id = $row->[0];
1074            my $who = $row->[1];
1075            my $assignment = $row->[2];
1076            my $organism = $fig->org_of($id);
1077          my $single_domain = [];          my $single_domain = [];
1078          push(@$single_domain,$thing->class);          push(@$single_domain,$who);
         my $id = $thing->id;  
         $count_identical++;  
1079          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1080          push(@$single_domain,$thing->organism);          push(@$single_domain,$organism);
1081          push(@$single_domain,$thing->database);          push(@$single_domain,$assignment);
         push(@$single_domain,$thing->description);  
1082          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1083            $count_identical++;
1084      }      }
1085    
1086      if ($count_identical >0){      if ($count_identical >0){
1087          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();  
1088      }      }
1089      else{      else{
1090          $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 1092 
1092      return ($content);      return ($content);
1093  }  }
1094    
1095    1;
1096    
1097    #########################################
1098    #########################################
1099    package Observation::FC;
1100    1;
1101    
1102    use base qw(Observation);
1103    
1104    sub new {
1105    
1106        my ($class,$dataset) = @_;
1107        my $self = $class->SUPER::new($dataset);
1108        $self->{rows} = $dataset->{'rows'};
1109    
1110        bless($self,$class);
1111        return $self;
1112    }
1113    
1114    =head3 display_table()
1115    
1116    If available use the function specified here to display the "raw" observation.
1117    This code will display a table for the identical protein
1118    
1119    
1120    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
1121    dence.
1122    
1123    =cut
1124    
1125    sub display_table {
1126    
1127        my ($self,$dataset,$fig) = @_;
1128        my $fid = $self->fig_id;
1129        my $rows = $self->rows;
1130        my $cgi = new CGI;
1131        my $functional_data = [];
1132        my $count = 0;
1133        my $content;
1134    
1135        foreach my $row (@$rows) {
1136            my $single_domain = [];
1137            $count++;
1138    
1139            # construct the score link
1140            my $score = $row->[0];
1141            my $toid = $row->[1];
1142            my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1143            my $sc_link = "<a href='$link'>$score</a>";
1144    
1145            push(@$single_domain,$sc_link);
1146            push(@$single_domain,$row->[1]);
1147            push(@$single_domain,$row->[2]);
1148            push(@$functional_data,$single_domain);
1149        }
1150    
1151        if ($count >0){
1152            $content = $functional_data;
1153        }
1154        else
1155        {
1156            $content = "<p>This PEG does not have any functional coupling</p>";
1157        }
1158        return ($content);
1159    }
1160    
1161    
1162    #########################################
1163    #########################################
1164  package Observation::Domain;  package Observation::Domain;
1165    
1166  use base qw(Observation);  use base qw(Observation);
# Line 865  Line 1181 
1181  sub display {  sub display {
1182      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1183      my $lines = [];      my $lines = [];
1184      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1185                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1186                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1187      my $color = "4";      my $color = "4";
1188    
1189      my $line_data = [];      my $line_data = [];
1190      my $links_list = [];      my $links_list = [];
1191      my $descriptions = [];      my $descriptions = [];
1192    
1193      my $description_function;      my $db_and_id = $thing->acc;
1194      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1195    
1196      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology',
1197                                    -host     => $WebConfig::DBHOST,
1198                                    -user     => $WebConfig::DBUSER,
1199                                    -password => $WebConfig::DBPWD);
1200    
1201        my ($name_title,$name_value,$description_title,$description_value);
1202        if($db eq "CDD"){
1203            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1204            if(!scalar(@$cdd_objs)){
1205                $name_title = "name";
1206                $name_value = "not available";
1207                $description_title = "description";
1208                $description_value = "not available";
1209            }
1210            else{
1211                my $cdd_obj = $cdd_objs->[0];
1212                $name_title = "name";
1213                $name_value = $cdd_obj->term;
1214                $description_title = "description";
1215                $description_value = $cdd_obj->description;
1216            }
1217        }
1218        elsif($db =~ /PFAM/){
1219            my ($new_id) = ($id) =~ /(.*?)_/;
1220            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1221            if(!scalar(@$pfam_objs)){
1222                $name_title = "name";
1223                $name_value = "not available";
1224                $description_title = "description";
1225                $description_value = "not available";
1226            }
1227            else{
1228                my $pfam_obj = $pfam_objs->[0];
1229                $name_title = "name";
1230                $name_value = $pfam_obj->term;
1231                #$description_title = "description";
1232                #$description_value = $pfam_obj->description;
1233            }
1234        }
1235    
1236        my $short_title = $thing->acc;
1237        $short_title =~ s/::/ - /ig;
1238        my $new_short_title=$short_title;
1239        if ($short_title =~ /interpro/){
1240            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1241        }
1242        my $line_config = { 'title' => $name_value,
1243                            'hover_title', => 'Domain',
1244                            'short_title' => $new_short_title,
1245                            'basepair_offset' => '1' };
1246    
1247        my $name;
1248        my ($new_id) = ($id) =~ /(.*?)_/;
1249        $name = {"title" => $db,
1250                 "value" => $new_id};
1251        push(@$descriptions,$name);
1252    
1253    #    my $description;
1254    #    $description = {"title" => $description_title,
1255    #                   "value" => $description_value};
1256    #    push(@$descriptions,$description);
1257    
1258      my $score;      my $score;
1259      $score = {"title" => "score",      $score = {"title" => "score",
1260                "value" => $thing->evalue};                "value" => $thing->evalue};
1261      push(@$descriptions,$score);      push(@$descriptions,$score);
1262    
1263        my $location;
1264        $location = {"title" => "location",
1265                     "value" => $thing->start . " - " . $thing->stop};
1266        push(@$descriptions,$location);
1267    
1268      my $link_id;      my $link_id;
1269      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/::(.*)/){
1270          $link_id = $1;          $link_id = $1;
1271      }      }
1272    
1273      my $link;      my $link;
1274        my $link_url;
1275        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"}
1276        elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1277        else{$link_url = "NO_URL"}
1278    
1279      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1280               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1281      push(@$links_list,$link);      push(@$links_list,$link);
1282    
1283      my $element_hash = {      my $element_hash = {
1284          "title" => $thing->type,          "title" => $name_value,
1285          "start" => $thing->start,          "start" => $thing->start,
1286          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1287          "color"=> $color,          "color"=> $color,
# Line 911  Line 1296 
1296    
1297  }  }
1298    
1299    sub display_table {
1300        my ($self,$dataset) = @_;
1301        my $cgi = new CGI;
1302        my $data = [];
1303        my $count = 0;
1304        my $content;
1305    
1306        foreach my $thing (@$dataset) {
1307            next if ($thing->type !~ /dom/);
1308            my $single_domain = [];
1309            $count++;
1310    
1311            my $db_and_id = $thing->acc;
1312            my ($db,$id) = split("::",$db_and_id);
1313    
1314            my $dbmaster = DBMaster->new(-database =>'Ontology',
1315                                    -host     => $WebConfig::DBHOST,
1316                                    -user     => $WebConfig::DBUSER,
1317                                    -password => $WebConfig::DBPWD);
1318    
1319            my ($name_title,$name_value,$description_title,$description_value);
1320            if($db eq "CDD"){
1321                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1322                if(!scalar(@$cdd_objs)){
1323                    $name_title = "name";
1324                    $name_value = "not available";
1325                    $description_title = "description";
1326                    $description_value = "not available";
1327                }
1328                else{
1329                    my $cdd_obj = $cdd_objs->[0];
1330                    $name_title = "name";
1331                    $name_value = $cdd_obj->term;
1332                    $description_title = "description";
1333                    $description_value = $cdd_obj->description;
1334                }
1335            }
1336            elsif($db =~ /PFAM/){
1337                my ($new_id) = ($id) =~ /(.*?)_/;
1338                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1339                if(!scalar(@$pfam_objs)){
1340                    $name_title = "name";
1341                    $name_value = "not available";
1342                    $description_title = "description";
1343                    $description_value = "not available";
1344                }
1345                else{
1346                    my $pfam_obj = $pfam_objs->[0];
1347                    $name_title = "name";
1348                    $name_value = $pfam_obj->term;
1349                    #$description_title = "description";
1350                    #$description_value = $pfam_obj->description;
1351                }
1352            }
1353    
1354            my $location =  $thing->start . " - " . $thing->stop;
1355    
1356            push(@$single_domain,$db);
1357            push(@$single_domain,$thing->acc);
1358            push(@$single_domain,$name_value);
1359            push(@$single_domain,$location);
1360            push(@$single_domain,$thing->evalue);
1361            push(@$single_domain,$description_value);
1362            push(@$data,$single_domain);
1363        }
1364    
1365        if ($count >0){
1366            $content = $data;
1367        }
1368        else
1369        {
1370            $content = "<p>This PEG does not have any similarities to domains</p>";
1371        }
1372    }
1373    
1374    
1375    #########################################
1376    #########################################
1377    package Observation::Location;
1378    
1379    use base qw(Observation);
1380    
1381    sub new {
1382    
1383        my ($class,$dataset) = @_;
1384        my $self = $class->SUPER::new($dataset);
1385        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1386        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1387        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1388        $self->{cello_location} = $dataset->{'cello_location'};
1389        $self->{cello_score} = $dataset->{'cello_score'};
1390        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1391        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1392        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1393        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1394    
1395        bless($self,$class);
1396        return $self;
1397    }
1398    
1399    sub display_cello {
1400        my ($thing) = @_;
1401        my $html;
1402        my $cello_location = $thing->cello_location;
1403        my $cello_score = $thing->cello_score;
1404        if($cello_location){
1405            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1406            #$html .= "<p>CELLO score: $cello_score </p>";
1407        }
1408        return ($html);
1409    }
1410    
1411    sub display {
1412        my ($thing,$gd,$fig) = @_;
1413    
1414        my $fid = $thing->fig_id;
1415        #my $fig= new FIG;
1416        my $length = length($fig->get_translation($fid));
1417    
1418        my $cleavage_prob;
1419        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1420        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1421        my $signal_peptide_score = $thing->signal_peptide_score;
1422        my $cello_location = $thing->cello_location;
1423        my $cello_score = $thing->cello_score;
1424        my $tmpred_score = $thing->tmpred_score;
1425        my @tmpred_locations = split(",",$thing->tmpred_locations);
1426    
1427        my $phobius_signal_location = $thing->phobius_signal_location;
1428        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1429    
1430        my $lines = [];
1431    
1432        #color is
1433        my $color = "6";
1434    
1435    =pod=
1436    
1437        if($cello_location){
1438            my $cello_descriptions = [];
1439            my $line_data =[];
1440    
1441            my $line_config = { 'title' => 'Localization Evidence',
1442                                'short_title' => 'CELLO',
1443                                'hover_title' => 'Localization',
1444                                'basepair_offset' => '1' };
1445    
1446            my $description_cello_location = {"title" => 'Best Cello Location',
1447                                              "value" => $cello_location};
1448    
1449            push(@$cello_descriptions,$description_cello_location);
1450    
1451            my $description_cello_score = {"title" => 'Cello Score',
1452                                           "value" => $cello_score};
1453    
1454            push(@$cello_descriptions,$description_cello_score);
1455    
1456            my $element_hash = {
1457                "title" => "CELLO",
1458                "color"=> $color,
1459                "start" => "1",
1460                "end" =>  $length + 1,
1461                "zlayer" => '1',
1462                "description" => $cello_descriptions};
1463    
1464            push(@$line_data,$element_hash);
1465            $gd->add_line($line_data, $line_config);
1466        }
1467    
1468        $color = "2";
1469        if($tmpred_score){
1470            my $line_data =[];
1471            my $line_config = { 'title' => 'Localization Evidence',
1472                                'short_title' => 'Transmembrane',
1473                                'basepair_offset' => '1' };
1474    
1475            foreach my $tmpred (@tmpred_locations){
1476                my $descriptions = [];
1477                my ($begin,$end) =split("-",$tmpred);
1478                my $description_tmpred_score = {"title" => 'TMPRED score',
1479                                 "value" => $tmpred_score};
1480    
1481                push(@$descriptions,$description_tmpred_score);
1482    
1483                my $element_hash = {
1484                "title" => "transmembrane location",
1485                "start" => $begin + 1,
1486                "end" =>  $end + 1,
1487                "color"=> $color,
1488                "zlayer" => '5',
1489                "type" => 'box',
1490                "description" => $descriptions};
1491    
1492                push(@$line_data,$element_hash);
1493    
1494            }
1495            $gd->add_line($line_data, $line_config);
1496        }
1497    =cut
1498    
1499        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1500            my $line_data =[];
1501            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1502                                'short_title' => 'TM and SP',
1503                                'hover_title' => 'Localization',
1504                                'basepair_offset' => '1' };
1505    
1506            foreach my $tm_loc (@phobius_tm_locations){
1507                my $descriptions = [];
1508                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1509                                 "value" => $tm_loc};
1510                push(@$descriptions,$description_phobius_tm_locations);
1511    
1512                my ($begin,$end) =split("-",$tm_loc);
1513    
1514                my $element_hash = {
1515                "title" => "Phobius",
1516                "start" => $begin + 1,
1517                "end" =>  $end + 1,
1518                "color"=> '6',
1519                "zlayer" => '4',
1520                "type" => 'bigbox',
1521                "description" => $descriptions};
1522    
1523                push(@$line_data,$element_hash);
1524    
1525            }
1526    
1527            if($phobius_signal_location){
1528                my $descriptions = [];
1529                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1530                                 "value" => $phobius_signal_location};
1531                push(@$descriptions,$description_phobius_signal_location);
1532    
1533    
1534                my ($begin,$end) =split("-",$phobius_signal_location);
1535                my $element_hash = {
1536                "title" => "phobius signal locations",
1537                "start" => $begin + 1,
1538                "end" =>  $end + 1,
1539                "color"=> '1',
1540                "zlayer" => '5',
1541                "type" => 'box',
1542                "description" => $descriptions};
1543                push(@$line_data,$element_hash);
1544            }
1545    
1546            $gd->add_line($line_data, $line_config);
1547        }
1548    
1549    =head3
1550        $color = "1";
1551        if($signal_peptide_score){
1552            my $line_data = [];
1553            my $descriptions = [];
1554    
1555            my $line_config = { 'title' => 'Localization Evidence',
1556                                'short_title' => 'SignalP',
1557                                'hover_title' => 'Localization',
1558                                'basepair_offset' => '1' };
1559    
1560            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1561                                                    "value" => $signal_peptide_score};
1562    
1563            push(@$descriptions,$description_signal_peptide_score);
1564    
1565            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1566                                             "value" => $cleavage_prob};
1567    
1568            push(@$descriptions,$description_cleavage_prob);
1569    
1570            my $element_hash = {
1571                "title" => "SignalP",
1572                "start" => $cleavage_loc_begin - 2,
1573                "end" =>  $cleavage_loc_end + 1,
1574                "type" => 'bigbox',
1575                "color"=> $color,
1576                "zlayer" => '10',
1577                "description" => $descriptions};
1578    
1579            push(@$line_data,$element_hash);
1580            $gd->add_line($line_data, $line_config);
1581        }
1582    =cut
1583    
1584        return ($gd);
1585    
1586    }
1587    
1588    sub cleavage_loc {
1589      my ($self) = @_;
1590    
1591      return $self->{cleavage_loc};
1592    }
1593    
1594    sub cleavage_prob {
1595      my ($self) = @_;
1596    
1597      return $self->{cleavage_prob};
1598    }
1599    
1600    sub signal_peptide_score {
1601      my ($self) = @_;
1602    
1603      return $self->{signal_peptide_score};
1604    }
1605    
1606    sub tmpred_score {
1607      my ($self) = @_;
1608    
1609      return $self->{tmpred_score};
1610    }
1611    
1612    sub tmpred_locations {
1613      my ($self) = @_;
1614    
1615      return $self->{tmpred_locations};
1616    }
1617    
1618    sub cello_location {
1619      my ($self) = @_;
1620    
1621      return $self->{cello_location};
1622    }
1623    
1624    sub cello_score {
1625      my ($self) = @_;
1626    
1627      return $self->{cello_score};
1628    }
1629    
1630    sub phobius_signal_location {
1631      my ($self) = @_;
1632      return $self->{phobius_signal_location};
1633    }
1634    
1635    sub phobius_tm_locations {
1636      my ($self) = @_;
1637      return $self->{phobius_tm_locations};
1638    }
1639    
1640    
1641    
1642    #########################################
1643    #########################################
1644    package Observation::Sims;
1645    
1646    use base qw(Observation);
1647    
1648    sub new {
1649    
1650        my ($class,$dataset) = @_;
1651        my $self = $class->SUPER::new($dataset);
1652        $self->{identity} = $dataset->{'identity'};
1653        $self->{acc} = $dataset->{'acc'};
1654        $self->{query} = $dataset->{'query'};
1655        $self->{evalue} = $dataset->{'evalue'};
1656        $self->{qstart} = $dataset->{'qstart'};
1657        $self->{qstop} = $dataset->{'qstop'};
1658        $self->{hstart} = $dataset->{'hstart'};
1659        $self->{hstop} = $dataset->{'hstop'};
1660        $self->{database} = $dataset->{'database'};
1661        $self->{organism} = $dataset->{'organism'};
1662        $self->{function} = $dataset->{'function'};
1663        $self->{qlength} = $dataset->{'qlength'};
1664        $self->{hlength} = $dataset->{'hlength'};
1665    
1666        bless($self,$class);
1667        return $self;
1668    }
1669    
1670    =head3 display()
1671    
1672    If available use the function specified here to display a graphical observation.
1673    This code will display a graphical view of the similarities using the genome drawer object
1674    
1675    =cut
1676    
1677    sub display {
1678        my ($self,$gd,$array,$fig) = @_;
1679        #my $fig = new FIG;
1680    
1681        my @ids;
1682        foreach my $thing(@$array){
1683            next if ($thing->class ne "SIM");
1684            push (@ids, $thing->acc);
1685        }
1686    
1687        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1688    
1689        my %sims_objects_evalue;
1690        my $count = 0;
1691        foreach my $thing (@$array){
1692            if ($thing->class eq "SIM"){
1693                $sims_objects_evalue{$count} = $thing->evalue;
1694            }
1695            $count++;
1696        }
1697    
1698        foreach my $index (sort {$sims_objects_evalue{$a}<=>$sims_objects_evalue{$b}} keys %sims_objects_evalue){
1699    #    foreach my $thing ( @$array){
1700            my $thing = $array->[$index];
1701            if ($thing->class eq "SIM"){
1702                my $peg = $thing->acc;
1703                my $query = $thing->query;
1704    
1705                my $organism = $thing->organism;
1706                my $genome = $fig->genome_of($peg);
1707                my ($org_tax) = ($genome) =~ /(.*)\./;
1708                my $function = $thing->function;
1709                my $abbrev_name = $fig->abbrev($organism);
1710                my $align_start = $thing->qstart;
1711                my $align_stop = $thing->qstop;
1712                my $hit_start = $thing->hstart;
1713                my $hit_stop = $thing->hstop;
1714    
1715                my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1716    
1717                my $line_config = { 'title' => "$organism [$org_tax]",
1718                                    'short_title' => "$abbrev_name",
1719                                    'title_link' => '$tax_link',
1720                                    'basepair_offset' => '0'
1721                                    };
1722    
1723                my $line_data = [];
1724    
1725                my $element_hash;
1726                my $links_list = [];
1727                my $descriptions = [];
1728    
1729                # get subsystem information
1730                my $url_link = "?page=Annotation&feature=".$peg;
1731                my $link;
1732                $link = {"link_title" => $peg,
1733                         "link" => $url_link};
1734                push(@$links_list,$link);
1735    
1736                #my @subsystems = $fig->peg_to_subsystems($peg);
1737                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1738                my @subsystems;
1739    
1740                foreach my $array (@subs){
1741                    my $subsystem = $$array[0];
1742                    push(@subsystems,$subsystem);
1743                    my $link;
1744                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1745                             "link_title" => $subsystem};
1746                    push(@$links_list,$link);
1747                }
1748    
1749                $link = {"link_title" => "view blast alignment",
1750                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1751                push (@$links_list,$link);
1752    
1753                my $description_function;
1754                $description_function = {"title" => "function",
1755                                         "value" => $function};
1756                push(@$descriptions,$description_function);
1757    
1758                my ($description_ss, $ss_string);
1759                $ss_string = join (",", @subsystems);
1760                $description_ss = {"title" => "subsystems",
1761                                   "value" => $ss_string};
1762                push(@$descriptions,$description_ss);
1763    
1764                my $description_loc;
1765                $description_loc = {"title" => "location start",
1766                                    "value" => $hit_start};
1767                push(@$descriptions, $description_loc);
1768    
1769                $description_loc = {"title" => "location stop",
1770                                    "value" => $hit_stop};
1771                push(@$descriptions, $description_loc);
1772    
1773                my $evalue = $thing->evalue;
1774                while ($evalue =~ /-0/)
1775                {
1776                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1777                    $chunk2 = substr($chunk2,1);
1778                    $evalue = $chunk1 . "-" . $chunk2;
1779                }
1780    
1781                my $color = &color($evalue);
1782    
1783                my $description_eval = {"title" => "E-Value",
1784                                        "value" => $evalue};
1785                push(@$descriptions, $description_eval);
1786    
1787                my $identity = $self->identity;
1788                my $description_identity = {"title" => "Identity",
1789                                            "value" => $identity};
1790                push(@$descriptions, $description_identity);
1791    
1792                $element_hash = {
1793                    "title" => $peg,
1794                    "start" => $align_start,
1795                    "end" =>  $align_stop,
1796                    "type"=> 'box',
1797                    "color"=> $color,
1798                    "zlayer" => "2",
1799                    "links_list" => $links_list,
1800                    "description" => $descriptions
1801                    };
1802                push(@$line_data,$element_hash);
1803                $gd->add_line($line_data, $line_config);
1804            }
1805        }
1806        return ($gd);
1807    }
1808    
1809    =head3 display_domain_composition()
1810    
1811    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
1812    
1813    =cut
1814    
1815    sub display_domain_composition {
1816        my ($self,$gd,$fig) = @_;
1817    
1818        #$fig = new FIG;
1819        my $peg = $self->acc;
1820    
1821        my $line_data = [];
1822        my $links_list = [];
1823        my $descriptions = [];
1824    
1825        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1826        #my @domain_query_results = ();
1827        foreach $dqr (@domain_query_results){
1828            my $key = @$dqr[1];
1829            my @parts = split("::",$key);
1830            my $db = $parts[0];
1831            my $id = $parts[1];
1832            my $val = @$dqr[2];
1833            my $from;
1834            my $to;
1835            my $evalue;
1836    
1837            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1838                my $raw_evalue = $1;
1839                $from = $2;
1840                $to = $3;
1841                if($raw_evalue =~/(\d+)\.(\d+)/){
1842                    my $part2 = 1000 - $1;
1843                    my $part1 = $2/100;
1844                    $evalue = $part1."e-".$part2;
1845                }
1846                else{
1847                    $evalue = "0.0";
1848                }
1849            }
1850    
1851            my $dbmaster = DBMaster->new(-database =>'Ontology',
1852                                    -host     => $WebConfig::DBHOST,
1853                                    -user     => $WebConfig::DBUSER,
1854                                    -password => $WebConfig::DBPWD);
1855            my ($name_value,$description_value);
1856    
1857            if($db eq "CDD"){
1858                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1859                if(!scalar(@$cdd_objs)){
1860                    $name_title = "name";
1861                    $name_value = "not available";
1862                    $description_title = "description";
1863                    $description_value = "not available";
1864                }
1865                else{
1866                    my $cdd_obj = $cdd_objs->[0];
1867                    $name_value = $cdd_obj->term;
1868                    $description_value = $cdd_obj->description;
1869                }
1870            }
1871    
1872            my $domain_name;
1873            $domain_name = {"title" => "name",
1874                            "value" => $name_value};
1875            push(@$descriptions,$domain_name);
1876    
1877            my $description;
1878            $description = {"title" => "description",
1879                            "value" => $description_value};
1880            push(@$descriptions,$description);
1881    
1882            my $score;
1883            $score = {"title" => "score",
1884                      "value" => $evalue};
1885            push(@$descriptions,$score);
1886    
1887            my $link_id = $id;
1888            my $link;
1889            my $link_url;
1890            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"}
1891            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1892            else{$link_url = "NO_URL"}
1893    
1894            $link = {"link_title" => $name_value,
1895                     "link" => $link_url};
1896            push(@$links_list,$link);
1897    
1898            my $domain_element_hash = {
1899                "title" => $peg,
1900                "start" => $from,
1901                "end" =>  $to,
1902                "type"=> 'box',
1903                "zlayer" => '4',
1904                "links_list" => $links_list,
1905                "description" => $descriptions
1906                };
1907    
1908            push(@$line_data,$domain_element_hash);
1909    
1910            #just one CDD domain for now, later will add option for multiple domains from selected DB
1911            last;
1912        }
1913    
1914        my $line_config = { 'title' => $peg,
1915                            'hover_title' => 'Domain',
1916                            'short_title' => $peg,
1917                            'basepair_offset' => '1' };
1918    
1919        $gd->add_line($line_data, $line_config);
1920    
1921        return ($gd);
1922    
1923    }
1924    
1925    =head3 display_table()
1926    
1927    If available use the function specified here to display the "raw" observation.
1928    This code will display a table for the similarities protein
1929    
1930    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.
1931    
1932    =cut
1933    
1934    sub display_table {
1935        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1936    
1937        my $data = [];
1938        my $count = 0;
1939        my $content;
1940        #my $fig = new FIG;
1941        my $cgi = new CGI;
1942        my @ids;
1943        $lineages = $fig->taxonomy_list();
1944    
1945        foreach my $thing (@$dataset) {
1946            next if ($thing->class ne "SIM");
1947            push (@ids, $thing->acc);
1948        }
1949    
1950        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1951        my @attributes = $fig->get_attributes(\@ids);
1952    
1953        # get the column for the subsystems
1954        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1955    
1956        # get the column for the evidence codes
1957        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1958    
1959        # get the column for pfam_domain
1960        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1961    
1962        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1963        my $alias_col = &get_aliases(\@ids,$fig);
1964        #my $alias_col = {};
1965    
1966        my $figfam_data = "$FIG_Config::FigfamsData";
1967        my $figfams = new FFs($figfam_data);
1968    #    my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1969    
1970        my %sims_objects_evalue;
1971        my $simcount = 0;
1972        foreach my $thing (@$dataset){
1973            if ($thing->class eq "SIM"){
1974                $sims_objects_evalue{$simcount} = $thing->evalue;
1975            }
1976            $simcount++;
1977        }
1978    
1979        foreach my $index (sort {$sims_objects_evalue{$a}<=>$sims_objects_evalue{$b}} keys %sims_objects_evalue){
1980    #    foreach my $thing ( @$dataset){
1981            my $thing = $dataset->[$index];
1982    
1983            next if ($thing->class ne "SIM");
1984            my $single_domain = [];
1985            $count++;
1986    
1987            my $id      = $thing->acc;
1988            my $taxid   = $fig->genome_of($id);
1989            my $iden    = $thing->identity;
1990            my $ln1     = $thing->qlength;
1991            my $ln2     = $thing->hlength;
1992            my $b1      = $thing->qstart;
1993            my $e1      = $thing->qstop;
1994            my $b2      = $thing->hstart;
1995            my $e2      = $thing->hstop;
1996            my $d1      = abs($e1 - $b1) + 1;
1997            my $d2      = abs($e2 - $b2) + 1;
1998            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1999            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
2000    
2001            # checkbox column
2002            my $field_name = "tables_" . $id;
2003            my $pair_name = "visual_" . $id;
2004            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2005            my ($tax) = ($id) =~ /fig\|(.*?)\./;
2006    
2007            # get the linked fig id
2008            my $fig_col;
2009            if (defined ($e_identical{$id})){
2010                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
2011            }
2012            else{
2013                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
2014            }
2015    
2016            push (@$single_domain, $box_col, $fig_col, $thing->evalue,
2017                  "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
2018    
2019            my ($ff) = $figfams->families_containing_peg($id);
2020    
2021            foreach my $col (sort keys %$scroll_list){
2022                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
2023                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2024                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2025                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
2026                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
2027                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
2028                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
2029                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
2030                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
2031                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
2032                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
2033                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
2034                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
2035                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2036                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2037                #elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2038                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");}
2039            }
2040            push(@$data,$single_domain);
2041        }
2042        if ($count >0 ){
2043            $content = $data;
2044        }
2045        else{
2046            $content = "<p>This PEG does not have any similarities</p>";
2047        }
2048        return ($content);
2049    }
2050    
2051    sub get_box_column{
2052        my ($ids) = @_;
2053        my %column;
2054        foreach my $id (@$ids){
2055            my $field_name = "tables_" . $id;
2056            my $pair_name = "visual_" . $id;
2057            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2058        }
2059        return (%column);
2060    }
2061    
2062    sub get_subsystems_column{
2063        my ($ids,$fig) = @_;
2064    
2065        #my $fig = new FIG;
2066        my $cgi = new CGI;
2067        my %in_subs  = $fig->subsystems_for_pegs($ids);
2068        my %column;
2069        foreach my $id (@$ids){
2070            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2071            my @subsystems;
2072    
2073            if (@in_sub > 0) {
2074                foreach my $array(@in_sub){
2075                    my $ss = $$array[0];
2076                    $ss =~ s/_/ /ig;
2077                    push (@subsystems, "-" . $ss);
2078                }
2079                my $in_sub_line = join ("<br>", @subsystems);
2080                $column{$id} = $in_sub_line;
2081            } else {
2082                $column{$id} = "&nbsp;";
2083            }
2084        }
2085        return (%column);
2086    }
2087    
2088    sub get_essentially_identical{
2089        my ($fid,$dataset,$fig) = @_;
2090        #my $fig = new FIG;
2091    
2092        my %id_list;
2093        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2094    
2095        foreach my $thing (@$dataset){
2096            if($thing->class eq "IDENTICAL"){
2097                my $rows = $thing->rows;
2098                my $count_identical = 0;
2099                foreach my $row (@$rows) {
2100                    my $id = $row->[0];
2101                    if (($id ne $fid) && ($fig->function_of($id))) {
2102                        $id_list{$id} = 1;
2103                    }
2104                }
2105            }
2106        }
2107    
2108    #    foreach my $id (@maps_to) {
2109    #        if (($id ne $fid) && ($fig->function_of($id))) {
2110    #           $id_list{$id} = 1;
2111    #        }
2112    #    }
2113        return(%id_list);
2114    }
2115    
2116    
2117    sub get_evidence_column{
2118        my ($ids, $attributes,$fig) = @_;
2119        #my $fig = new FIG;
2120        my $cgi = new CGI;
2121        my (%column, %code_attributes);
2122    
2123        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2124        foreach my $key (@codes){
2125            push (@{$code_attributes{$$key[0]}}, $key);
2126        }
2127    
2128        foreach my $id (@$ids){
2129            # add evidence code with tool tip
2130            my $ev_codes=" &nbsp; ";
2131    
2132            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2133            my @ev_codes = ();
2134            foreach my $code (@codes) {
2135                my $pretty_code = $code->[2];
2136                if ($pretty_code =~ /;/) {
2137                    my ($cd, $ss) = split(";", $code->[2]);
2138                    $ss =~ s/_/ /g;
2139                    $pretty_code = $cd;# . " in " . $ss;
2140                }
2141                push(@ev_codes, $pretty_code);
2142            }
2143    
2144            if (scalar(@ev_codes) && $ev_codes[0]) {
2145                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2146                $ev_codes = $cgi->a(
2147                                    {
2148                                        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));
2149            }
2150            $column{$id}=$ev_codes;
2151        }
2152        return (%column);
2153    }
2154    
2155    sub get_pfam_column{
2156        my ($ids, $attributes,$fig) = @_;
2157        #my $fig = new FIG;
2158        my $cgi = new CGI;
2159        my (%column, %code_attributes, %attribute_locations);
2160        my $dbmaster = DBMaster->new(-database =>'Ontology',
2161                                    -host     => $WebConfig::DBHOST,
2162                                    -user     => $WebConfig::DBUSER,
2163                                    -password => $WebConfig::DBPWD);
2164    
2165        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2166        foreach my $key (@codes){
2167            my $name = $key->[1];
2168            if ($name =~ /_/){
2169                ($name) = ($key->[1]) =~ /(.*?)_/;
2170            }
2171            push (@{$code_attributes{$key->[0]}}, $name);
2172            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2173        }
2174    
2175        foreach my $id (@$ids){
2176            # add evidence code
2177            my $pfam_codes=" &nbsp; ";
2178            my @pfam_codes = "";
2179            my %description_codes;
2180    
2181            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2182                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2183                @pfam_codes = ();
2184    
2185                # get only unique values
2186                my %saw;
2187                foreach my $key (@ncodes) {$saw{$key}=1;}
2188                @ncodes = keys %saw;
2189    
2190                foreach my $code (@ncodes) {
2191                    my @parts = split("::",$code);
2192                    my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2193    
2194                    # get the locations for the domain
2195                    my @locs;
2196                    foreach my $part (@{$attribute_location{$id}{$code}}){
2197                        my ($loc) = ($part) =~ /\;(.*)/;
2198                        push (@locs,$loc);
2199                    }
2200                    my %locsaw;
2201                    foreach my $key (@locs) {$locsaw{$key}=1;}
2202                    @locs = keys %locsaw;
2203    
2204                    my $locations = join (", ", @locs);
2205    
2206                    if (defined ($description_codes{$parts[1]})){
2207                        push(@pfam_codes, "$parts[1] ($locations)");
2208                    }
2209                    else {
2210                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2211                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2212                        push(@pfam_codes, "$pfam_link ($locations)");
2213                    }
2214                }
2215            }
2216    
2217            $column{$id}=join("<br><br>", @pfam_codes);
2218        }
2219        return (%column);
2220    
2221    }
2222    
2223    sub get_aliases {
2224        my ($ids,$fig) = @_;
2225    
2226        my $all_aliases = $fig->feature_aliases_bulk($ids);
2227        foreach my $id (@$ids){
2228            foreach my $alias (@{$$all_aliases{$id}}){
2229                my $id_db = &Observation::get_database($alias);
2230                next if ($aliases->{$id}->{$id_db});
2231                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2232            }
2233        }
2234        return ($aliases);
2235    }
2236    
2237    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2238    
2239    sub color {
2240        my ($evalue) = @_;
2241        my $palette = WebColors::get_palette('vitamins');
2242        my $color;
2243        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2244        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2245        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2246        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2247        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2248        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2249        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2250        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2251        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2252        else{        $color = $palette->[9];    }
2253        return ($color);
2254    }
2255    
2256    
2257    ############################
2258    package Observation::Cluster;
2259    
2260    use base qw(Observation);
2261    
2262    sub new {
2263    
2264        my ($class,$dataset) = @_;
2265        my $self = $class->SUPER::new($dataset);
2266        $self->{context} = $dataset->{'context'};
2267        bless($self,$class);
2268        return $self;
2269    }
2270    
2271    sub display {
2272        my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2273    
2274        $taxes = $fig->taxonomy_list();
2275    
2276        my $fid = $self->fig_id;
2277        my $compare_or_coupling = $self->context;
2278        my $gd_window_size = $gd->window_size;
2279        my $range = $gd_window_size;
2280        my $all_regions = [];
2281        my $gene_associations={};
2282    
2283        #get the organism genome
2284        my $target_genome = $fig->genome_of($fid);
2285        $gene_associations->{$fid}->{"organism"} = $target_genome;
2286        $gene_associations->{$fid}->{"main_gene"} = $fid;
2287        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2288    
2289        # get location of the gene
2290        my $data = $fig->feature_location($fid);
2291        my ($contig, $beg, $end);
2292        my %reverse_flag;
2293    
2294        if ($data =~ /(.*)_(\d+)_(\d+)$/){
2295            $contig = $1;
2296            $beg = $2;
2297            $end = $3;
2298        }
2299    
2300        my $offset;
2301        my ($region_start, $region_end);
2302        if ($beg < $end)
2303        {
2304            $region_start = $beg - ($range);
2305            $region_end = $end+ ($range);
2306            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2307        }
2308        else
2309        {
2310            $region_start = $end-($range);
2311            $region_end = $beg+($range);
2312            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2313            $reverse_flag{$target_genome} = $fid;
2314            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2315        }
2316    
2317        # call genes in region
2318        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2319        #foreach my $feat (@$target_gene_features){
2320        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2321        #}
2322        push(@$all_regions,$target_gene_features);
2323        my (@start_array_region);
2324        push (@start_array_region, $offset);
2325    
2326        my %all_genes;
2327        my %all_genomes;
2328        foreach my $feature (@$target_gene_features){
2329            #if ($feature =~ /peg/){
2330                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2331            #}
2332        }
2333    
2334        my @selected_sims;
2335    
2336        if ($compare_or_coupling eq "sims"){
2337            # get the selected boxes
2338            my @selected_taxonomy = @$selected_taxonomies;
2339    
2340            # get the similarities and store only the ones that match the lineages selected
2341            if (@selected_taxonomy > 0){
2342                foreach my $sim (@$sims_array){
2343                    next if ($sim->class ne "SIM");
2344                    next if ($sim->acc !~ /fig\|/);
2345    
2346                    #my $genome = $fig->genome_of($sim->[1]);
2347                    my $genome = $fig->genome_of($sim->acc);
2348                    #my ($genome1) = ($genome) =~ /(.*)\./;
2349                    my $lineage = $taxes->{$genome};
2350                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2351                    foreach my $taxon(@selected_taxonomy){
2352                        if ($lineage =~ /$taxon/){
2353                            #push (@selected_sims, $sim->[1]);
2354                            push (@selected_sims, $sim->acc);
2355                        }
2356                    }
2357                }
2358            }
2359            else{
2360                my $simcount = 0;
2361                foreach my $sim (@$sims_array){
2362                    next if ($sim->class ne "SIM");
2363                    next if ($sim->acc !~ /fig\|/);
2364    
2365                    push (@selected_sims, $sim->acc);
2366                    $simcount++;
2367                    last if ($simcount > 4);
2368                }
2369            }
2370    
2371            my %saw;
2372            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2373    
2374            # get the gene context for the sorted matches
2375            foreach my $sim_fid(@selected_sims){
2376                #get the organism genome
2377                my $sim_genome = $fig->genome_of($sim_fid);
2378                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2379                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2380                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2381    
2382                # get location of the gene
2383                my $data = $fig->feature_location($sim_fid);
2384                my ($contig, $beg, $end);
2385    
2386                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2387                    $contig = $1;
2388                    $beg = $2;
2389                    $end = $3;
2390                }
2391    
2392                my $offset;
2393                my ($region_start, $region_end);
2394                if ($beg < $end)
2395                {
2396                    $region_start = $beg - ($range/2);
2397                    $region_end = $end+($range/2);
2398                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2399                }
2400                else
2401                {
2402                    $region_start = $end-($range/2);
2403                    $region_end = $beg+($range/2);
2404                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2405                    $reverse_flag{$sim_genome} = $sim_fid;
2406                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2407                }
2408    
2409                # call genes in region
2410                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2411                push(@$all_regions,$sim_gene_features);
2412                push (@start_array_region, $offset);
2413                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2414                $all_genomes{$sim_genome} = 1;
2415            }
2416    
2417        }
2418    
2419        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2420        # cluster the genes
2421        my @all_pegs = keys %all_genes;
2422        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2423        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2424        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2425    
2426        foreach my $region (@$all_regions){
2427            my $sample_peg = @$region[0];
2428            my $region_genome = $fig->genome_of($sample_peg);
2429            my $region_gs = $fig->genus_species($region_genome);
2430            my $abbrev_name = $fig->abbrev($region_gs);
2431            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2432            my $lineage = $taxes->{$region_genome};
2433            #my $lineage = $fig->taxonomy_of($region_genome);
2434            #$region_gs .= "Lineage:$lineage";
2435            my $line_config = { 'title' => $region_gs,
2436                                'short_title' => $abbrev_name,
2437                                'basepair_offset' => '0'
2438                                };
2439    
2440            my $offsetting = shift @start_array_region;
2441    
2442            my $second_line_config = { 'title' => "$lineage",
2443                                       'short_title' => "",
2444                                       'basepair_offset' => '0',
2445                                       'no_middle_line' => '1'
2446                                       };
2447    
2448            my $line_data = [];
2449            my $second_line_data = [];
2450    
2451            # initialize variables to check for overlap in genes
2452            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2453            my $major_line_flag = 0;
2454            my $prev_second_flag = 0;
2455    
2456            foreach my $fid1 (@$region){
2457                $second_line_flag = 0;
2458                my $element_hash;
2459                my $links_list = [];
2460                my $descriptions = [];
2461    
2462                my $color = $color_sets->{$fid1};
2463    
2464                # get subsystem information
2465                my $function = $fig->function_of($fid1);
2466                my $url_link = "?page=Annotation&feature=".$fid1;
2467    
2468                my $link;
2469                $link = {"link_title" => $fid1,
2470                         "link" => $url_link};
2471                push(@$links_list,$link);
2472    
2473                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2474                my @subsystems;
2475                foreach my $array (@subs){
2476                    my $subsystem = $$array[0];
2477                    my $ss = $subsystem;
2478                    $ss =~ s/_/ /ig;
2479                    push (@subsystems, $ss);
2480                    my $link;
2481                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2482                             "link_title" => $ss};
2483                    push(@$links_list,$link);
2484                }
2485    
2486                if ($fid1 eq $fid){
2487                    my $link;
2488                    $link = {"link_title" => "Annotate this sequence",
2489                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2490                    push (@$links_list,$link);
2491                }
2492    
2493                my $description_function;
2494                $description_function = {"title" => "function",
2495                                         "value" => $function};
2496                push(@$descriptions,$description_function);
2497    
2498                my $description_ss;
2499                my $ss_string = join (", ", @subsystems);
2500                $description_ss = {"title" => "subsystems",
2501                                   "value" => $ss_string};
2502                push(@$descriptions,$description_ss);
2503    
2504    
2505                my $fid_location = $fig->feature_location($fid1);
2506                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2507                    my($start,$stop);
2508                    $start = $2 - $offsetting;
2509                    $stop = $3 - $offsetting;
2510    
2511                    if ( (($prev_start) && ($prev_stop) ) &&
2512                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2513                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2514                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2515                            $second_line_flag = 1;
2516                            $major_line_flag = 1;
2517                        }
2518                    }
2519                    $prev_start = $start;
2520                    $prev_stop = $stop;
2521                    $prev_fig = $fid1;
2522    
2523                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2524                        $start = $gd_window_size - $start;
2525                        $stop = $gd_window_size - $stop;
2526                    }
2527    
2528                    my $title = $fid1;
2529                    if ($fid1 eq $fid){
2530                        $title = "My query gene: $fid1";
2531                    }
2532    
2533                    $element_hash = {
2534                        "title" => $title,
2535                        "start" => $start,
2536                        "end" =>  $stop,
2537                        "type"=> 'arrow',
2538                        "color"=> $color,
2539                        "zlayer" => "2",
2540                        "links_list" => $links_list,
2541                        "description" => $descriptions
2542                    };
2543    
2544                    # if there is an overlap, put into second line
2545                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2546                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2547    
2548                    if ($fid1 eq $fid){
2549                        $element_hash = {
2550                            "title" => 'Query',
2551                            "start" => $start,
2552                            "end" =>  $stop,
2553                            "type"=> 'bigbox',
2554                            "color"=> $color,
2555                            "zlayer" => "1"
2556                            };
2557    
2558                        # if there is an overlap, put into second line
2559                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2560                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2561                    }
2562                }
2563            }
2564            $gd->add_line($line_data, $line_config);
2565            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2566        }
2567        return ($gd, \@selected_sims);
2568    }
2569    
2570    sub cluster_genes {
2571        my($fig,$all_pegs,$peg) = @_;
2572        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2573    
2574        my @color_sets = ();
2575    
2576        $conn = &get_connections_by_similarity($fig,$all_pegs);
2577    
2578        for ($i=0; ($i < @$all_pegs); $i++) {
2579            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2580            if (! $seen{$i}) {
2581                $cluster = [$i];
2582                $seen{$i} = 1;
2583                for ($j=0; ($j < @$cluster); $j++) {
2584                    $x = $conn->{$cluster->[$j]};
2585                    foreach $k (@$x) {
2586                        if (! $seen{$k}) {
2587                            push(@$cluster,$k);
2588                            $seen{$k} = 1;
2589                        }
2590                    }
2591                }
2592    
2593                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2594                    push(@color_sets,$cluster);
2595                }
2596            }
2597        }
2598        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2599        $red_set = $color_sets[$i];
2600        splice(@color_sets,$i,1);
2601        @color_sets = sort { @$b <=> @$a } @color_sets;
2602        unshift(@color_sets,$red_set);
2603    
2604        my $color_sets = {};
2605        for ($i=0; ($i < @color_sets); $i++) {
2606            foreach $x (@{$color_sets[$i]}) {
2607                $color_sets->{$all_pegs->[$x]} = $i;
2608            }
2609        }
2610        return $color_sets;
2611    }
2612    
2613    sub get_connections_by_similarity {
2614        my($fig,$all_pegs) = @_;
2615        my($i,$j,$tmp,$peg,%pos_of);
2616        my($sim,%conn,$x,$y);
2617    
2618        for ($i=0; ($i < @$all_pegs); $i++) {
2619            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2620            push(@{$pos_of{$tmp}},$i);
2621            if ($tmp ne $all_pegs->[$i]) {
2622                push(@{$pos_of{$all_pegs->[$i]}},$i);
2623            }
2624        }
2625    
2626        foreach $y (keys(%pos_of)) {
2627            $x = $pos_of{$y};
2628            for ($i=0; ($i < @$x); $i++) {
2629                for ($j=$i+1; ($j < @$x); $j++) {
2630                    push(@{$conn{$x->[$i]}},$x->[$j]);
2631                    push(@{$conn{$x->[$j]}},$x->[$i]);
2632                }
2633            }
2634        }
2635    
2636        for ($i=0; ($i < @$all_pegs); $i++) {
2637            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2638                if (defined($x = $pos_of{$sim->id2})) {
2639                    foreach $y (@$x) {
2640                        push(@{$conn{$i}},$y);
2641                    }
2642                }
2643            }
2644        }
2645        return \%conn;
2646    }
2647    
2648    sub in {
2649        my($x,$xL) = @_;
2650        my($i);
2651    
2652        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2653        return ($i < @$xL);
2654    }
2655    
2656    #############################################
2657    #############################################
2658    package Observation::Commentary;
2659    
2660    use base qw(Observation);
2661    
2662    =head3 display_protein_commentary()
2663    
2664    =cut
2665    
2666    sub display_protein_commentary {
2667        my ($self,$dataset,$mypeg,$fig) = @_;
2668    
2669        my $all_rows = [];
2670        my $content;
2671        #my $fig = new FIG;
2672        my $cgi = new CGI;
2673        my $count = 0;
2674        my $peg_array = [];
2675        my (%evidence_column, %subsystems_column,  %e_identical);
2676    
2677        if (@$dataset != 1){
2678            foreach my $thing (@$dataset){
2679                if ($thing->class eq "SIM"){
2680                    push (@$peg_array, $thing->acc);
2681                }
2682            }
2683            # get the column for the evidence codes
2684            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2685    
2686            # get the column for the subsystems
2687            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2688    
2689            # get essentially identical seqs
2690            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2691        }
2692        else{
2693            push (@$peg_array, @$dataset);
2694        }
2695    
2696        my $selected_sims = [];
2697        foreach my $id (@$peg_array){
2698            last if ($count > 10);
2699            my $row_data = [];
2700            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2701            $org = $fig->org_of($id);
2702            $function = $fig->function_of($id);
2703            if ($mypeg ne $id){
2704                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2705                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2706                if (defined($e_identical{$id})) { $id_cell .= "*";}
2707            }
2708            else{
2709                $function_cell = "&nbsp;&nbsp;$function";
2710                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2711                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2712            }
2713    
2714            push(@$row_data,$id_cell);
2715            push(@$row_data,$org);
2716            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2717            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2718            push(@$row_data, $fig->translation_length($id));
2719            push(@$row_data,$function_cell);
2720            push(@$all_rows,$row_data);
2721            push (@$selected_sims, $id);
2722            $count++;
2723        }
2724    
2725        if ($count >0){
2726            $content = $all_rows;
2727        }
2728        else{
2729            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2730        }
2731        return ($content,$selected_sims);
2732    }
2733    
2734    sub display_protein_history {
2735        my ($self, $id,$fig) = @_;
2736        my $all_rows = [];
2737        my $content;
2738    
2739        my $cgi = new CGI;
2740        my $count = 0;
2741        foreach my $feat ($fig->feature_annotations($id)){
2742            my $row = [];
2743            my $col1 = $feat->[2];
2744            my $col2 = $feat->[1];
2745            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2746            my $text = $feat->[3];
2747    
2748            push (@$row, $col1);
2749            push (@$row, $col2);
2750            push (@$row, $text);
2751            push (@$all_rows, $row);
2752            $count++;
2753        }
2754        if ($count > 0){
2755            $content = $all_rows;
2756        }
2757        else {
2758            $content = "There is no history for this PEG";
2759        }
2760    
2761        return($content);
2762    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3