[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3