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

Diff of /FigKernelPackages/Observation.pm

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

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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3