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

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.49

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3