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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3