[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.44, Tue Nov 27 20:13:21 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 $function = $fig->function_of($fid);
388        #my $taxonomy = $fig->taxonomy_of($org_id);
389        my $length = $fig->translation_length($fid);
390    
391        push (@$row, $org_name);
392        push (@$row, $fid);
393        push (@$row, $length);
394        push (@$row, $function);
395    
396        # initialize the table for commentary and annotations
397        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
398        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
399        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
400        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
401        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
402        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
403        #$content .= qq(</table><p>\n);
404    
405        push(@$content, $row);
406    
407  =head3 get_url (internal)      return ($content);
408    }
 get_url() return a valid URL or undef for any observation.  
   
 URLs are constructed by looking at the Accession acc()  and  name()  
409    
410  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 get_sims_summary
411    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
412    
413  =cut  =cut
414    
415  sub get_url {  sub get_sims_summary {
416        my ($observation, $fid, $taxes, $dataset, $fig) = @_;
417        my %families;
418        #my @sims= $fig->nsims($fid,20000,10,"fig");
419    
420   my ($self) = @_;      foreach my $thing (@$dataset) {
421   my $url='';          next if ($thing->class ne "SIM");
422    
423  # a hash with a URL for each observation; identified by name()          my $id      = $thing->acc;
424  #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="  
 #};  
425    
426  # if (defined $URL{$self->name}) {          next if ($id !~ /fig\|/);
427  #     $url = $URL{$self->name}.$self->acc;          next if ($fig->is_deleted_fid($id));
428  #     return $url;          my $genome = $fig->genome_of($id);
429  # }          my ($genome1) = ($genome) =~ /(.*)\./;
430  # else          my $taxonomy = $taxes->{$genome1};
431       return undef;          #my $taxonomy = $fig->taxonomy_of($fig->genome_of($id)); # use this if the taxonomies have been updated
432            my $parent_tax = "Root";
433            my @currLineage = ($parent_tax);
434            foreach my $tax (split(/\; /, $taxonomy)){
435                push (@{$families{children}{$parent_tax}}, $tax);
436                push (@currLineage, $tax);
437                $families{parent}{$tax} = $parent_tax;
438                $families{lineage}{$tax} = join(";", @currLineage);
439                if (defined ($families{evalue}{$tax})){
440                    if ($sim->[10] < $families{evalue}{$tax}){
441                        $families{evalue}{$tax} = $evalue;
442                        $families{color}{$tax} = &get_taxcolor($evalue);
443                    }
444                }
445                else{
446                    $families{evalue}{$tax} = $evalue;
447                    $families{color}{$tax} = &get_taxcolor($evalue);
448  }  }
449    
450  =head3 get_display_method (internal)              $parent_tax = $tax;
451            }
452        }
453    
454  get_display_method() return a valid URL or undef for any observation.      foreach my $key (keys %{$families{children}}){
455            $families{count}{$key} = @{$families{children}{$key}};
456    
457  URLs are constructed by looking at the Accession acc()  and  name()          my %saw;
458  and Info from both attributes is combined with a table of base URLs stored in this function.          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
459            $families{children}{$key} = \@out;
460        }
461        return (\%families);
462    }
463    
464  =cut  =head1 Internal Methods
465    
466  sub get_display_method {  These methods are not meant to be used outside of this package.
467    
468   my ($self) = @_;  B<Please do not use them outside of this package!>
469    
470  # 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="  
 # };  
471    
472  #if (defined $URL{$self->name}) {  sub get_taxcolor{
473  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;      my ($evalue) = @_;
474  #     return $url;      my $color;
475  # }      if ($evalue <= 1e-170){        $color = "#FF2000";    }
476  # else      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
477       return undef;      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
478        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
479        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
480        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
481        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
482        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
483        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
484        else{        $color = "#6666FF";    }
485        return ($color);
486  }  }
487    
488    
489  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
490    
491      # 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)
492      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
493    
494      my $fig = new FIG;      #my $fig = new FIG;
495    
496      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
497          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
498          my @parts = split("::",$key);          my @parts = split("::",$key);
499          my $class = $parts[0];          my $class = $parts[0];
# Line 576  Line 519 
519                                 'type' => "dom" ,                                 'type' => "dom" ,
520                                 'evalue' => $evalue,                                 'evalue' => $evalue,
521                                 'start' => $from,                                 'start' => $from,
522                                 'stop' => $to                                 'stop' => $to,
523                                   'fig_id' => $fid,
524                                   'score' => $raw_evalue
525                                 };                                 };
526    
527                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 585  Line 530 
530      }      }
531  }  }
532    
533  =head3 get_attribute_based_evidence (internal)  sub get_attribute_based_location_observations{
534    
535  This method retrieves evidence from the attribute server      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
536        #my $fig = new FIG;
537    
538  =cut      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
539    
540  sub get_attribute_based_observations{      my $dataset = {'type' => "loc",
541                       'class' => 'SIGNALP_CELLO_TMPRED',
542                       'fig_id' => $fid
543                       };
544    
545      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      foreach my $attr_ref (@$attributes_ref){
546      my ($fid,$datasets_ref) = (@_);          my $key = @$attr_ref[1];
547            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
548            my @parts = split("::",$key);
549            my $sub_class = $parts[0];
550            my $sub_key = $parts[1];
551            my $value = @$attr_ref[2];
552            if($sub_class eq "SignalP"){
553                if($sub_key eq "cleavage_site"){
554                    my @value_parts = split(";",$value);
555                    $dataset->{'cleavage_prob'} = $value_parts[0];
556                    $dataset->{'cleavage_loc'} = $value_parts[1];
557                }
558                elsif($sub_key eq "signal_peptide"){
559                    $dataset->{'signal_peptide_score'} = $value;
560                }
561            }
562    
563            elsif($sub_class eq "CELLO"){
564                $dataset->{'cello_location'} = $sub_key;
565                $dataset->{'cello_score'} = $value;
566            }
567    
568      my $_myfig = new FIG;          elsif($sub_class eq "Phobius"){
569                if($sub_key eq "transmembrane"){
570                    $dataset->{'phobius_tm_locations'} = $value;
571                }
572                elsif($sub_key eq "signal"){
573                    $dataset->{'phobius_signal_location'} = $value;
574                }
575            }
576    
577      foreach my $attr_ref ($_myfig->get_attributes($fid)) {          elsif($sub_class eq "TMPRED"){
578                my @value_parts = split(/\;/,$value);
579                $dataset->{'tmpred_score'} = $value_parts[0];
580                $dataset->{'tmpred_locations'} = $value_parts[1];
581            }
582        }
583    
584          # convert the ref into a string for easier handling      push (@{$datasets_ref} ,$dataset);
         my ($string) = "@$attr_ref";  
585    
586  #       print "S:$string\n";  }
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
587    
588          # 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  
         #  
589    
590          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  This methods sets the type and class for pdb observations
591    
592              # some keys are composite CDD::1233244 or PFAM:PF1233  =cut
593    
594              if ( $key =~ /::/ ) {  sub get_pdb_observations{
595                  my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
             }  
596    
597              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );      #my $fig = new FIG;
598    
599              my $evalue= 255;      foreach my $attr_ref (@$attributes_ref){
600              if (defined $raw_evalue) { # some of the tool do not give us an evalue          my $key = @$attr_ref[1];
601            next if ( ($key !~ /PDB/));
602            my($key1,$key2) =split("::",$key);
603            my $value = @$attr_ref[2];
604            my ($evalue,$location) = split(";",$value);
605    
606                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);          if($evalue =~/(\d+)\.(\d+)/){
607                  my ($new_k, $new_exp);              my $part2 = 1000 - $1;
608                my $part1 = $2/100;
609                $evalue = $part1."e-".$part2;
610            }
611    
612                  #          my($start,$stop) =split("-",$location);
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
613    
614  #                   $new_exp = (1000+$expo);          my $url = @$attr_ref[3];
615          #           $new_k = $k / 100;          my $dataset = {'class' => 'PDB',
616                           'type' => 'seq' ,
617                           'acc' => $key2,
618                           'evalue' => $evalue,
619                           'start' => $start,
620                           'stop' => $stop,
621                           'fig_id' => $fid
622                           };
623    
624            push (@{$datasets_ref} ,$dataset);
625                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
626              }              }
627    
628              # unroll it all into an array of hashes  =head3 get_cluster_observations() (internal)
629              # this needs to be done differently for different types of observations  
630              my $dataset = [ { name => 'class', value => $key },  This methods sets the type and class for cluster observations
                             { name => 'acc' , value => $acc},  
                             { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  
                             { name => 'evalue', value => $evalue },  
                             { name => 'start', value => $from},  
                             { name => 'stop' , value => $to}  
                             ];  
631    
632    =cut
633    
634    sub get_cluster_observations{
635        my ($fid,$datasets_ref,$scope) = (@_);
636    
637        my $dataset = {'class' => 'CLUSTER',
638                       'type' => 'fc',
639                       'context' => $scope,
640                       'fig_id' => $fid
641                       };
642              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
643          }          }
644      }  
 }  
645    
646  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
647    
# Line 665  Line 651 
651    
652  sub get_sims_observations{  sub get_sims_observations{
653    
654      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
655      my $fig = new FIG;      #my $fig = new FIG;
656  #    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");  
657      my ($dataset);      my ($dataset);
658    
659      foreach my $sim (@sims){      foreach my $sim (@sims){
660            next if ($fig->is_deleted_fid($sim->[1]));
661          my $hit = $sim->[1];          my $hit = $sim->[1];
662          my $percent = $sim->[2];          my $percent = $sim->[2];
663          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 672 
672          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
673    
674          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
675                        'query' => $sim->[0],
676                      'acc' => $hit,                      'acc' => $hit,
677                      'identity' => $percent,                      'identity' => $percent,
678                      'type' => 'seq',                      'type' => 'seq',
# Line 697  Line 685 
685                      'organism' => $organism,                      'organism' => $organism,
686                      'function' => $func,                      'function' => $func,
687                      'qlength' => $qlength,                      'qlength' => $qlength,
688                      'hlength' => $hlength                      'hlength' => $hlength,
689                        'fig_id' => $fid
690                      };                      };
691    
692          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
# Line 720  Line 709 
709      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
710      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
711      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
712      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
713      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
714      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
715      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 729  Line 718 
718    
719  }  }
720    
721    
722  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
723    
724  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 737  Line 727 
727    
728  sub get_identical_proteins{  sub get_identical_proteins{
729    
730      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
731      my $fig = new FIG;      #my $fig = new FIG;
732      my @funcs = ();      my $funcs_ref;
733    
734      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);
   
735      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
736          my ($tmp, $who);          my ($tmp, $who);
737          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
738              $who = &get_database($id);              $who = &get_database($id);
739              push(@funcs, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
740          }          }
741      }      }
742    
     my ($dataset);  
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
743          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
744                         'type' => 'seq',                         'type' => 'seq',
745                         'database' => $who,                     'fig_id' => $fid,
746                         'function' => $assignment                     'rows' => $funcs_ref
747                         };                         };
748    
749          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
750      }  
751    
752  }  }
753    
# Line 779  Line 759 
759    
760  sub get_functional_coupling{  sub get_functional_coupling{
761    
762      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
763      my $fig = new FIG;      #my $fig = new FIG;
764      my @funcs = ();      my @funcs = ();
765    
766      # initialize some variables      # initialize some variables
# Line 798  Line 778 
778                    } @fc_data;                    } @fc_data;
779    
780      my ($dataset);      my ($dataset);
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
781          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
782                         'type' => 'fc',                         'type' => 'fc',
783                         'function' => $description                     'fig_id' => $fid,
784                       'rows' => \@rows
785                         };                         };
786    
787          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";  
 #       }  
   
 #     }  
   
788    
789    }
790    
791  =head3 new (internal)  =head3 new (internal)
792    
# Line 867  Line 797 
797  sub new {  sub new {
798    my ($class,$dataset) = @_;    my ($class,$dataset) = @_;
799    
   
   #$self = { acc => '',  
 #           description => '',  
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
   
800    my $self = { class => $dataset->{'class'},    my $self = { class => $dataset->{'class'},
801                 type => $dataset->{'type'}                 type => $dataset->{'type'},
802                   fig_id => $dataset->{'fig_id'},
803                   score => $dataset->{'score'},
804             };             };
805    
806    bless($self,$class);    bless($self,$class);
# Line 906  Line 820 
820      return $self->{identity};      return $self->{identity};
821  }  }
822    
823    =head3 fig_id (internal)
824    
825    =cut
826    
827    sub fig_id {
828      my ($self) = @_;
829      return $self->{fig_id};
830    }
831    
832  =head3 feature_id (internal)  =head3 feature_id (internal)
833    
834    
# Line 965  Line 888 
888      return $self->{database};      return $self->{database};
889  }  }
890    
891    sub score {
892      my ($self) = @_;
893    
894      return $self->{score};
895    }
896    
897  ############################################################  ############################################################
898  ############################################################  ############################################################
899  package Observation::Identical;  package Observation::PDB;
900    
901  use base qw(Observation);  use base qw(Observation);
902    
# Line 977  Line 904 
904    
905      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
906      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
907      $self->{id} = $dataset->{'id'};      $self->{acc} = $dataset->{'acc'};
908      $self->{organism} = $dataset->{'organism'};      $self->{evalue} = $dataset->{'evalue'};
909      $self->{function} = $dataset->{'function'};      $self->{start} = $dataset->{'start'};
910      $self->{database} = $dataset->{'database'};      $self->{stop} = $dataset->{'stop'};
   
911      bless($self,$class);      bless($self,$class);
912      return $self;      return $self;
913  }  }
914    
915  =head3 display()  =head3 display()
916    
917  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.  
918    
919  =cut  =cut
920    
921  sub display{  sub display{
922      my ($self, $cgi, $dataset) = @_;      my ($self,$gd,$fig) = @_;
923    
924      my $all_domains = [];      my $fid = $self->fig_id;
925      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);  
     }  
926    
927      if ($count_identical >0){      my $acc = $self->acc;
928          $content = $all_domains;  
929        my ($pdb_description,$pdb_source,$pdb_ligand);
930        my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
931        if(!scalar(@$pdb_objs)){
932            $pdb_description = "not available";
933            $pdb_source = "not available";
934            $pdb_ligand = "not available";
935      }      }
936      else{      else{
937          $content = "<p>This PEG does not have any essentially identical proteins</p>";          my $pdb_obj = $pdb_objs->[0];
938      }          $pdb_description = $pdb_obj->description;
939      return ($content);          $pdb_source = $pdb_obj->source;
940            $pdb_ligand = $pdb_obj->ligand;
941  }  }
942    
943  1;      my $lines = [];
944        my $line_data = [];
945        my $line_config = { 'title' => "PDB hit for $fid",
946                            'short_title' => "best PDB",
947                            'basepair_offset' => '1' };
948    
949        #my $fig = new FIG;
950        my $seq = $fig->get_translation($fid);
951        my $fid_stop = length($seq);
952    
953        my $fid_element_hash = {
954            "title" => $fid,
955            "start" => '1',
956            "end" =>  $fid_stop,
957            "color"=> '1',
958            "zlayer" => '1'
959            };
960    
961  #########################################      push(@$line_data,$fid_element_hash);
 #########################################  
 package Observation::FC;  
 1;  
962    
963  use base qw(Observation);      my $links_list = [];
964        my $descriptions = [];
965    
966  sub new {      my $name;
967        $name = {"title" => 'id',
968                 "value" => $acc};
969        push(@$descriptions,$name);
970    
971        my $description;
972        $description = {"title" => 'pdb description',
973                        "value" => $pdb_description};
974        push(@$descriptions,$description);
975    
976      my ($class,$dataset) = @_;      my $score;
977      my $self = $class->SUPER::new($dataset);      $score = {"title" => "score",
978      $self->{score} = $dataset->{'score'};                "value" => $self->evalue};
979      $self->{id} = $dataset->{'id'};      push(@$descriptions,$score);
     $self->{function} = $dataset->{'function'};  
980    
981      bless($self,$class);      my $start_stop;
982      return $self;      my $start_stop_value = $self->start."_".$self->stop;
983  }      $start_stop = {"title" => "start-stop",
984                       "value" => $start_stop_value};
985        push(@$descriptions,$start_stop);
986    
987        my $source;
988        $source = {"title" => "source",
989                  "value" => $pdb_source};
990        push(@$descriptions,$source);
991    
992        my $ligand;
993        $ligand = {"title" => "pdb ligand",
994                   "value" => $pdb_ligand};
995        push(@$descriptions,$ligand);
996    
997  =head3 display()      my $link;
998        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
999    
1000  If available use the function specified here to display the "raw" observation.      $link = {"link_title" => $acc,
1001                 "link" => $link_url};
1002        push(@$links_list,$link);
1003    
1004        my $pdb_element_hash = {
1005            "title" => "PDB homology",
1006            "start" => $self->start,
1007            "end" =>  $self->stop,
1008            "color"=> '6',
1009            "zlayer" => '3',
1010            "links_list" => $links_list,
1011            "description" => $descriptions};
1012    
1013        push(@$line_data,$pdb_element_hash);
1014        $gd->add_line($line_data, $line_config);
1015    
1016        return $gd;
1017    }
1018    
1019    1;
1020    
1021    ############################################################
1022    ############################################################
1023    package Observation::Identical;
1024    
1025    use base qw(Observation);
1026    
1027    sub new {
1028    
1029        my ($class,$dataset) = @_;
1030        my $self = $class->SUPER::new($dataset);
1031        $self->{rows} = $dataset->{'rows'};
1032    
1033        bless($self,$class);
1034        return $self;
1035    }
1036    
1037    =head3 display_table()
1038    
1039    If available use the function specified here to display the "raw" observation.
1040  This code will display a table for the identical protein  This code will display a table for the identical protein
1041    
1042    
# Line 1058  Line 1045 
1045    
1046  =cut  =cut
1047    
 sub display {  
     my ($self,$cgi,$dataset, $fid) = @_;  
1048    
1049    sub display_table{
1050        my ($self,$fig) = @_;
1051    
1052        #my $fig = new FIG;
1053        my $fid = $self->fig_id;
1054        my $rows = $self->rows;
1055        my $cgi = new CGI;
1056        my $all_domains = [];
1057        my $count_identical = 0;
1058        my $content;
1059        foreach my $row (@$rows) {
1060            my $id = $row->[0];
1061            my $who = $row->[1];
1062            my $assignment = $row->[2];
1063            my $organism = $fig->org_of($id);
1064            my $single_domain = [];
1065            push(@$single_domain,$who);
1066            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1067            push(@$single_domain,$organism);
1068            push(@$single_domain,$assignment);
1069            push(@$all_domains,$single_domain);
1070            $count_identical++;
1071        }
1072    
1073        if ($count_identical >0){
1074            $content = $all_domains;
1075        }
1076        else{
1077            $content = "<p>This PEG does not have any essentially identical proteins</p>";
1078        }
1079        return ($content);
1080    }
1081    
1082    1;
1083    
1084    #########################################
1085    #########################################
1086    package Observation::FC;
1087    1;
1088    
1089    use base qw(Observation);
1090    
1091    sub new {
1092    
1093        my ($class,$dataset) = @_;
1094        my $self = $class->SUPER::new($dataset);
1095        $self->{rows} = $dataset->{'rows'};
1096    
1097        bless($self,$class);
1098        return $self;
1099    }
1100    
1101    =head3 display_table()
1102    
1103    If available use the function specified here to display the "raw" observation.
1104    This code will display a table for the identical protein
1105    
1106    
1107    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
1108    dence.
1109    
1110    =cut
1111    
1112    sub display_table {
1113    
1114        my ($self,$dataset,$fig) = @_;
1115        my $fid = $self->fig_id;
1116        my $rows = $self->rows;
1117        my $cgi = new CGI;
1118      my $functional_data = [];      my $functional_data = [];
1119      my $count = 0;      my $count = 0;
1120      my $content;      my $content;
1121    
1122      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1123          my $single_domain = [];          my $single_domain = [];
         next if ($thing->class ne "PCH");  
1124          $count++;          $count++;
1125    
1126          # construct the score link          # construct the score link
1127          my $score = $thing->score;          my $score = $row->[0];
1128          my $toid = $thing->id;          my $toid = $row->[1];
1129          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";
1130          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1131    
1132          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1133          push(@$single_domain,$thing->id);          push(@$single_domain,$row->[1]);
1134          push(@$single_domain,$thing->function);          push(@$single_domain,$row->[2]);
1135          push(@$functional_data,$single_domain);          push(@$functional_data,$single_domain);
1136      }      }
1137    
# Line 1115  Line 1168 
1168  sub display {  sub display {
1169      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1170      my $lines = [];      my $lines = [];
1171      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1172                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1173                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1174      my $color = "4";      my $color = "4";
1175    
1176      my $line_data = [];      my $line_data = [];
1177      my $links_list = [];      my $links_list = [];
1178      my $descriptions = [];      my $descriptions = [];
1179    
1180      my $description_function;      my $db_and_id = $thing->acc;
1181      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1182    
1183      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology');
1184    
1185        my ($name_title,$name_value,$description_title,$description_value);
1186        if($db eq "CDD"){
1187            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1188            if(!scalar(@$cdd_objs)){
1189                $name_title = "name";
1190                $name_value = "not available";
1191                $description_title = "description";
1192                $description_value = "not available";
1193            }
1194            else{
1195                my $cdd_obj = $cdd_objs->[0];
1196                $name_title = "name";
1197                $name_value = $cdd_obj->term;
1198                $description_title = "description";
1199                $description_value = $cdd_obj->description;
1200            }
1201        }
1202        elsif($db =~ /PFAM/){
1203            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1204            if(!scalar(@$pfam_objs)){
1205                $name_title = "name";
1206                $name_value = "not available";
1207                $description_title = "description";
1208                $description_value = "not available";
1209            }
1210            else{
1211                my $pfam_obj = $pfam_objs->[0];
1212                $name_title = "name";
1213                $name_value = $pfam_obj->term;
1214                #$description_title = "description";
1215                #$description_value = $pfam_obj->description;
1216            }
1217        }
1218    
1219        my $short_title = $thing->acc;
1220        $short_title =~ s/::/ - /ig;
1221        my $line_config = { 'title' => $name_value,
1222                            'short_title' => $short_title,
1223                            'basepair_offset' => '1' };
1224    
1225        my $name;
1226        $name = {"title" => $db,
1227                 "value" => $id};
1228        push(@$descriptions,$name);
1229    
1230    #    my $description;
1231    #    $description = {"title" => $description_title,
1232    #                   "value" => $description_value};
1233    #    push(@$descriptions,$description);
1234    
1235      my $score;      my $score;
1236      $score = {"title" => "score",      $score = {"title" => "score",
1237                "value" => $thing->evalue};                "value" => $thing->evalue};
1238      push(@$descriptions,$score);      push(@$descriptions,$score);
1239    
1240        my $location;
1241        $location = {"title" => "location",
1242                     "value" => $thing->start . " - " . $thing->stop};
1243        push(@$descriptions,$location);
1244    
1245      my $link_id;      my $link_id;
1246      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/::(.*)/){
1247          $link_id = $1;          $link_id = $1;
1248      }      }
1249    
1250      my $link;      my $link;
1251        my $link_url;
1252        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"}
1253        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1254        else{$link_url = "NO_URL"}
1255    
1256      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1257               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1258      push(@$links_list,$link);      push(@$links_list,$link);
1259    
1260      my $element_hash = {      my $element_hash = {
1261          "title" => $thing->type,          "title" => $name_value,
1262          "start" => $thing->start,          "start" => $thing->start,
1263          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1264          "color"=> $color,          "color"=> $color,
# Line 1161  Line 1273 
1273    
1274  }  }
1275    
1276    sub display_table {
1277        my ($self,$dataset) = @_;
1278        my $cgi = new CGI;
1279        my $data = [];
1280        my $count = 0;
1281        my $content;
1282    
1283        foreach my $thing (@$dataset) {
1284            next if ($thing->type !~ /dom/);
1285            my $single_domain = [];
1286            $count++;
1287    
1288            my $db_and_id = $thing->acc;
1289            my ($db,$id) = split("::",$db_and_id);
1290    
1291            my $dbmaster = DBMaster->new(-database =>'Ontology');
1292    
1293            my ($name_title,$name_value,$description_title,$description_value);
1294            if($db eq "CDD"){
1295                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1296                if(!scalar(@$cdd_objs)){
1297                    $name_title = "name";
1298                    $name_value = "not available";
1299                    $description_title = "description";
1300                    $description_value = "not available";
1301                }
1302                else{
1303                    my $cdd_obj = $cdd_objs->[0];
1304                    $name_title = "name";
1305                    $name_value = $cdd_obj->term;
1306                    $description_title = "description";
1307                    $description_value = $cdd_obj->description;
1308                }
1309            }
1310    
1311            my $location =  $thing->start . " - " . $thing->stop;
1312    
1313            push(@$single_domain,$db);
1314            push(@$single_domain,$thing->acc);
1315            push(@$single_domain,$name_value);
1316            push(@$single_domain,$location);
1317            push(@$single_domain,$thing->evalue);
1318            push(@$single_domain,$description_value);
1319            push(@$data,$single_domain);
1320        }
1321    
1322        if ($count >0){
1323            $content = $data;
1324        }
1325        else
1326        {
1327            $content = "<p>This PEG does not have any similarities to domains</p>";
1328        }
1329    }
1330    
1331    
1332  #########################################  #########################################
1333  #########################################  #########################################
1334  package Observation::Sims;  package Observation::Location;
1335    
1336  use base qw(Observation);  use base qw(Observation);
1337    
# Line 1171  Line 1339 
1339    
1340      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1341      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1342      $self->{identity} = $dataset->{'identity'};      $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1343      $self->{acc} = $dataset->{'acc'};      $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1344      $self->{evalue} = $dataset->{'evalue'};      $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1345      $self->{qstart} = $dataset->{'qstart'};      $self->{cello_location} = $dataset->{'cello_location'};
1346      $self->{qstop} = $dataset->{'qstop'};      $self->{cello_score} = $dataset->{'cello_score'};
1347      $self->{hstart} = $dataset->{'hstart'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1348      $self->{hstop} = $dataset->{'hstop'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1349      $self->{database} = $dataset->{'database'};      $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1350      $self->{organism} = $dataset->{'organism'};      $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
     $self->{function} = $dataset->{'function'};  
     $self->{qlength} = $dataset->{'qlength'};  
     $self->{hlength} = $dataset->{'hlength'};  
1351    
1352      bless($self,$class);      bless($self,$class);
1353      return $self;      return $self;
1354  }  }
1355    
1356  =head3 display()  sub display_cello {
1357        my ($thing,$fig) = @_;
1358        my $html;
1359        my $cello_location = $thing->cello_location;
1360        my $cello_score = $thing->cello_score;
1361        if($cello_location){
1362            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1363            #$html .= "<p>CELLO score: $cello_score </p>";
1364        }
1365        return ($html);
1366    }
1367    
1368  If available use the function specified here to display the "raw" observation.  sub display {
1369  This code will display a table for the similarities protein      my ($thing,$gd,$fig) = @_;
1370    
1371  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;
1372        #my $fig= new FIG;
1373        my $length = length($fig->get_translation($fid));
1374    
1375        my $cleavage_prob;
1376        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1377        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1378        my $signal_peptide_score = $thing->signal_peptide_score;
1379        my $cello_location = $thing->cello_location;
1380        my $cello_score = $thing->cello_score;
1381        my $tmpred_score = $thing->tmpred_score;
1382        my @tmpred_locations = split(",",$thing->tmpred_locations);
1383    
1384  =cut      my $phobius_signal_location = $thing->phobius_signal_location;
1385        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1386    
1387  sub display {      my $lines = [];
     my ($self,$cgi,$dataset) = @_;  
1388    
1389      my $data = [];      #color is
1390      my $count = 0;      my $color = "6";
     my $content;  
     my $fig = new FIG;  
1391    
1392      foreach my $thing (@$dataset) {  =pod=
         my $single_domain = [];  
         next if ($thing->class ne "SIM");  
         $count++;  
1393    
1394          my $id = $thing->acc;      if($cello_location){
1395            my $cello_descriptions = [];
1396            my $line_data =[];
1397    
1398          # add the subsystem information          my $line_config = { 'title' => 'Localization Evidence',
1399          my @in_sub  = $fig->peg_to_subsystems($id);                              'short_title' => 'CELLO',
1400          my $in_sub;                              'basepair_offset' => '1' };
1401    
1402          if (@in_sub > 0) {          my $description_cello_location = {"title" => 'Best Cello Location',
1403              $in_sub = @in_sub;                                            "value" => $cello_location};
1404    
1405              # 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;";  
         }  
1406    
1407          # add evidence code with tool tip          my $description_cello_score = {"title" => 'Cello Score',
1408          my $ev_codes=" &nbsp; ";                                         "value" => $cello_score};
1409          my @ev_codes = "";  
1410          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          push(@$cello_descriptions,$description_cello_score);
1411              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);  
1412              @ev_codes = ();          my $element_hash = {
1413              foreach my $code (@codes) {              "title" => "CELLO",
1414                  my $pretty_code = $code->[2];              "color"=> $color,
1415                  if ($pretty_code =~ /;/) {              "start" => "1",
1416                      my ($cd, $ss) = split(";", $code->[2]);              "end" =>  $length + 1,
1417                      $ss =~ s/_/ /g;              "zlayer" => '1',
1418                      $pretty_code = $cd;# . " in " . $ss;              "description" => $cello_descriptions};
1419    
1420            push(@$line_data,$element_hash);
1421            $gd->add_line($line_data, $line_config);
1422                  }                  }
1423                  push(@ev_codes, $pretty_code);  
1424        $color = "2";
1425        if($tmpred_score){
1426            my $line_data =[];
1427            my $line_config = { 'title' => 'Localization Evidence',
1428                                'short_title' => 'Transmembrane',
1429                                'basepair_offset' => '1' };
1430    
1431            foreach my $tmpred (@tmpred_locations){
1432                my $descriptions = [];
1433                my ($begin,$end) =split("-",$tmpred);
1434                my $description_tmpred_score = {"title" => 'TMPRED score',
1435                                 "value" => $tmpred_score};
1436    
1437                push(@$descriptions,$description_tmpred_score);
1438    
1439                my $element_hash = {
1440                "title" => "transmembrane location",
1441                "start" => $begin + 1,
1442                "end" =>  $end + 1,
1443                "color"=> $color,
1444                "zlayer" => '5',
1445                "type" => 'box',
1446                "description" => $descriptions};
1447    
1448                push(@$line_data,$element_hash);
1449    
1450              }              }
1451            $gd->add_line($line_data, $line_config);
1452          }          }
1453    =cut
1454    
1455          if (scalar(@ev_codes) && $ev_codes[0]) {      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1456              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);          my $line_data =[];
1457              $ev_codes = $cgi->a(          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1458                                  {                              'short_title' => 'TM and SP',
1459                                      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));                              'basepair_offset' => '1' };
         }  
1460    
1461          # add the aliases          foreach my $tm_loc (@phobius_tm_locations){
1462          my $aliases = undef;              my $descriptions = [];
1463          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1464          $aliases = &HTML::set_prot_links( $cgi, $aliases );                               "value" => $tm_loc};
1465          $aliases ||= "&nbsp;";              push(@$descriptions,$description_phobius_tm_locations);
1466    
1467          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>)";  
1468    
1469                my $element_hash = {
1470                "title" => "Phobius",
1471                "start" => $begin + 1,
1472                "end" =>  $end + 1,
1473                "color"=> '6',
1474                "zlayer" => '4',
1475                "type" => 'bigbox',
1476                "description" => $descriptions};
1477    
1478                push(@$line_data,$element_hash);
1479    
         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);  
1480      }      }
1481    
1482      if ($count >0){          if($phobius_signal_location){
1483          $content = $data;              my $descriptions = [];
1484                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1485                                 "value" => $phobius_signal_location};
1486                push(@$descriptions,$description_phobius_signal_location);
1487    
1488    
1489                my ($begin,$end) =split("-",$phobius_signal_location);
1490                my $element_hash = {
1491                "title" => "phobius signal locations",
1492                "start" => $begin + 1,
1493                "end" =>  $end + 1,
1494                "color"=> '1',
1495                "zlayer" => '5',
1496                "type" => 'box',
1497                "description" => $descriptions};
1498                push(@$line_data,$element_hash);
1499      }      }
1500      else  
1501      {          $gd->add_line($line_data, $line_config);
         $content = "<p>This PEG does not have any similarities</p>";  
1502      }      }
1503      return ($content);  
1504    =head3
1505        $color = "1";
1506        if($signal_peptide_score){
1507            my $line_data = [];
1508            my $descriptions = [];
1509    
1510            my $line_config = { 'title' => 'Localization Evidence',
1511                                'short_title' => 'SignalP',
1512                                'basepair_offset' => '1' };
1513    
1514            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1515                                                    "value" => $signal_peptide_score};
1516    
1517            push(@$descriptions,$description_signal_peptide_score);
1518    
1519            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1520                                             "value" => $cleavage_prob};
1521    
1522            push(@$descriptions,$description_cleavage_prob);
1523    
1524            my $element_hash = {
1525                "title" => "SignalP",
1526                "start" => $cleavage_loc_begin - 2,
1527                "end" =>  $cleavage_loc_end + 1,
1528                "type" => 'bigbox',
1529                "color"=> $color,
1530                "zlayer" => '10',
1531                "description" => $descriptions};
1532    
1533            push(@$line_data,$element_hash);
1534            $gd->add_line($line_data, $line_config);
1535  }  }
1536    =cut
1537    
1538  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }      return ($gd);
1539    
1540    }
1541    
1542    sub cleavage_loc {
1543      my ($self) = @_;
1544    
1545      return $self->{cleavage_loc};
1546    }
1547    
1548    sub cleavage_prob {
1549      my ($self) = @_;
1550    
1551      return $self->{cleavage_prob};
1552    }
1553    
1554    sub signal_peptide_score {
1555      my ($self) = @_;
1556    
1557      return $self->{signal_peptide_score};
1558    }
1559    
1560    sub tmpred_score {
1561      my ($self) = @_;
1562    
1563      return $self->{tmpred_score};
1564    }
1565    
1566    sub tmpred_locations {
1567      my ($self) = @_;
1568    
1569      return $self->{tmpred_locations};
1570    }
1571    
1572    sub cello_location {
1573      my ($self) = @_;
1574    
1575      return $self->{cello_location};
1576    }
1577    
1578    sub cello_score {
1579      my ($self) = @_;
1580    
1581      return $self->{cello_score};
1582    }
1583    
1584    sub phobius_signal_location {
1585      my ($self) = @_;
1586      return $self->{phobius_signal_location};
1587    }
1588    
1589    sub phobius_tm_locations {
1590      my ($self) = @_;
1591      return $self->{phobius_tm_locations};
1592    }
1593    
1594    
1595    
1596    #########################################
1597    #########################################
1598    package Observation::Sims;
1599    
1600    use base qw(Observation);
1601    
1602    sub new {
1603    
1604        my ($class,$dataset) = @_;
1605        my $self = $class->SUPER::new($dataset);
1606        $self->{identity} = $dataset->{'identity'};
1607        $self->{acc} = $dataset->{'acc'};
1608        $self->{query} = $dataset->{'query'};
1609        $self->{evalue} = $dataset->{'evalue'};
1610        $self->{qstart} = $dataset->{'qstart'};
1611        $self->{qstop} = $dataset->{'qstop'};
1612        $self->{hstart} = $dataset->{'hstart'};
1613        $self->{hstop} = $dataset->{'hstop'};
1614        $self->{database} = $dataset->{'database'};
1615        $self->{organism} = $dataset->{'organism'};
1616        $self->{function} = $dataset->{'function'};
1617        $self->{qlength} = $dataset->{'qlength'};
1618        $self->{hlength} = $dataset->{'hlength'};
1619    
1620        bless($self,$class);
1621        return $self;
1622    }
1623    
1624    =head3 display()
1625    
1626    If available use the function specified here to display a graphical observation.
1627    This code will display a graphical view of the similarities using the genome drawer object
1628    
1629    =cut
1630    
1631    sub display {
1632        my ($self,$gd,$array,$fig) = @_;
1633        #my $fig = new FIG;
1634    
1635        my @ids;
1636        foreach my $thing(@$array){
1637            next if ($thing->class ne "SIM");
1638            push (@ids, $thing->acc);
1639        }
1640    
1641        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1642    
1643        foreach my $thing (@$array){
1644            if ($thing->class eq "SIM"){
1645    
1646                my $peg = $thing->acc;
1647                my $query = $thing->query;
1648    
1649                my $organism = $thing->organism;
1650                my $genome = $fig->genome_of($peg);
1651                my ($org_tax) = ($genome) =~ /(.*)\./;
1652                my $function = $thing->function;
1653                my $abbrev_name = $fig->abbrev($organism);
1654                my $align_start = $thing->qstart;
1655                my $align_stop = $thing->qstop;
1656                my $hit_start = $thing->hstart;
1657                my $hit_stop = $thing->hstop;
1658    
1659                my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1660    
1661                my $line_config = { 'title' => "$organism [$org_tax]",
1662                                    'short_title' => "$abbrev_name",
1663                                    'title_link' => '$tax_link',
1664                                    'basepair_offset' => '0'
1665                                    };
1666    
1667                my $line_data = [];
1668    
1669                my $element_hash;
1670                my $links_list = [];
1671                my $descriptions = [];
1672    
1673                # get subsystem information
1674                my $url_link = "?page=Annotation&feature=".$peg;
1675                my $link;
1676                $link = {"link_title" => $peg,
1677                         "link" => $url_link};
1678                push(@$links_list,$link);
1679    
1680                #my @subsystems = $fig->peg_to_subsystems($peg);
1681                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1682                my @subsystems;
1683    
1684                foreach my $array (@subs){
1685                    my $subsystem = $$array[0];
1686                    push(@subsystems,$subsystem);
1687                    my $link;
1688                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1689                             "link_title" => $subsystem};
1690                    push(@$links_list,$link);
1691                }
1692    
1693                $link = {"link_title" => "view blast alignment",
1694                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1695                push (@$links_list,$link);
1696    
1697                my $description_function;
1698                $description_function = {"title" => "function",
1699                                         "value" => $function};
1700                push(@$descriptions,$description_function);
1701    
1702                my ($description_ss, $ss_string);
1703                $ss_string = join (",", @subsystems);
1704                $description_ss = {"title" => "subsystems",
1705                                   "value" => $ss_string};
1706                push(@$descriptions,$description_ss);
1707    
1708                my $description_loc;
1709                $description_loc = {"title" => "location start",
1710                                    "value" => $hit_start};
1711                push(@$descriptions, $description_loc);
1712    
1713                $description_loc = {"title" => "location stop",
1714                                    "value" => $hit_stop};
1715                push(@$descriptions, $description_loc);
1716    
1717                my $evalue = $thing->evalue;
1718                while ($evalue =~ /-0/)
1719                {
1720                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1721                    $chunk2 = substr($chunk2,1);
1722                    $evalue = $chunk1 . "-" . $chunk2;
1723                }
1724    
1725                my $color = &color($evalue);
1726    
1727                my $description_eval = {"title" => "E-Value",
1728                                        "value" => $evalue};
1729                push(@$descriptions, $description_eval);
1730    
1731                my $identity = $self->identity;
1732                my $description_identity = {"title" => "Identity",
1733                                            "value" => $identity};
1734                push(@$descriptions, $description_identity);
1735    
1736                $element_hash = {
1737                    "title" => $peg,
1738                    "start" => $align_start,
1739                    "end" =>  $align_stop,
1740                    "type"=> 'box',
1741                    "color"=> $color,
1742                    "zlayer" => "2",
1743                    "links_list" => $links_list,
1744                    "description" => $descriptions
1745                    };
1746                push(@$line_data,$element_hash);
1747                $gd->add_line($line_data, $line_config);
1748            }
1749        }
1750        return ($gd);
1751    }
1752    
1753    =head3 display_domain_composition()
1754    
1755    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
1756    
1757    =cut
1758    
1759    sub display_domain_composition {
1760        my ($self,$gd,$fig) = @_;
1761    
1762        #my $fig = new FIG;
1763        my $peg = $self->acc;
1764    
1765        my $line_data = [];
1766        my $links_list = [];
1767        my $descriptions = [];
1768    
1769        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1770        my @domain_query_results = ();
1771        foreach $dqr (@domain_query_results){
1772            my $key = @$dqr[1];
1773            my @parts = split("::",$key);
1774            my $db = $parts[0];
1775            my $id = $parts[1];
1776            my $val = @$dqr[2];
1777            my $from;
1778            my $to;
1779            my $evalue;
1780    
1781            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1782                my $raw_evalue = $1;
1783                $from = $2;
1784                $to = $3;
1785                if($raw_evalue =~/(\d+)\.(\d+)/){
1786                    my $part2 = 1000 - $1;
1787                    my $part1 = $2/100;
1788                    $evalue = $part1."e-".$part2;
1789                }
1790                else{
1791                    $evalue = "0.0";
1792                }
1793            }
1794    
1795            my $dbmaster = DBMaster->new(-database =>'Ontology');
1796            my ($name_value,$description_value);
1797    
1798            if($db eq "CDD"){
1799                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1800                if(!scalar(@$cdd_objs)){
1801                    $name_title = "name";
1802                    $name_value = "not available";
1803                    $description_title = "description";
1804                    $description_value = "not available";
1805                }
1806                else{
1807                    my $cdd_obj = $cdd_objs->[0];
1808                    $name_value = $cdd_obj->term;
1809                    $description_value = $cdd_obj->description;
1810                }
1811            }
1812    
1813            my $domain_name;
1814            $domain_name = {"title" => "name",
1815                     "value" => $name_value};
1816            push(@$descriptions,$domain_name);
1817    
1818            my $description;
1819            $description = {"title" => "description",
1820                            "value" => $description_value};
1821            push(@$descriptions,$description);
1822    
1823            my $score;
1824            $score = {"title" => "score",
1825                      "value" => $evalue};
1826            push(@$descriptions,$score);
1827    
1828            my $link_id = $id;
1829            my $link;
1830            my $link_url;
1831            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"}
1832            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1833            else{$link_url = "NO_URL"}
1834    
1835            $link = {"link_title" => $name_value,
1836                     "link" => $link_url};
1837            push(@$links_list,$link);
1838    
1839            my $domain_element_hash = {
1840                "title" => $peg,
1841                "start" => $from,
1842                "end" =>  $to,
1843                "type"=> 'box',
1844                "zlayer" => '4',
1845                "links_list" => $links_list,
1846                "description" => $descriptions
1847                };
1848    
1849            push(@$line_data,$domain_element_hash);
1850    
1851            #just one CDD domain for now, later will add option for multiple domains from selected DB
1852            last;
1853        }
1854    
1855        my $line_config = { 'title' => $peg,
1856                            'short_title' => $peg,
1857                            'basepair_offset' => '1' };
1858    
1859        $gd->add_line($line_data, $line_config);
1860    
1861        return ($gd);
1862    
1863    }
1864    
1865    =head3 display_table()
1866    
1867    If available use the function specified here to display the "raw" observation.
1868    This code will display a table for the similarities protein
1869    
1870    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.
1871    
1872    =cut
1873    
1874    sub display_table {
1875        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1876    
1877        my $data = [];
1878        my $count = 0;
1879        my $content;
1880        #my $fig = new FIG;
1881        my $cgi = new CGI;
1882        my @ids;
1883        foreach my $thing (@$dataset) {
1884            next if ($thing->class ne "SIM");
1885            push (@ids, $thing->acc);
1886        }
1887    
1888        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1889        my @attributes = $fig->get_attributes(\@ids);
1890    
1891        # get the column for the subsystems
1892        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1893    
1894        # get the column for the evidence codes
1895        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1896    
1897        # get the column for pfam_domain
1898        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1899    
1900        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1901        my $alias_col = &get_aliases(\@ids,$fig);
1902        #my $alias_col = {};
1903    
1904        foreach my $thing (@$dataset) {
1905            next if ($thing->class ne "SIM");
1906            my $single_domain = [];
1907            $count++;
1908    
1909            my $id      = $thing->acc;
1910            my $iden    = $thing->identity;
1911            my $ln1     = $thing->qlength;
1912            my $ln2     = $thing->hlength;
1913            my $b1      = $thing->qstart;
1914            my $e1      = $thing->qstop;
1915            my $b2      = $thing->hstart;
1916            my $e2      = $thing->hstop;
1917            my $d1      = abs($e1 - $b1) + 1;
1918            my $d2      = abs($e2 - $b2) + 1;
1919            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1920            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1921    
1922            # checkbox column
1923            my $field_name = "tables_" . $id;
1924            my $pair_name = "visual_" . $id;
1925            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1926            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1927    
1928            # get the linked fig id
1929            my $fig_col;
1930            if (defined ($e_identical{$id})){
1931                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1932            }
1933            else{
1934                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1935            }
1936    
1937            push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1938                  "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1939    
1940            foreach my $col (sort keys %$scroll_list){
1941                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1942                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1943                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1944                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1945                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1946                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1947                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1948                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1949                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1950                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1951                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1952                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1953                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1954                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
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($sim->[1]));
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            #$region_gs .= "Lineage:$lineage";
2345            my $line_config = { 'title' => $region_gs,
2346                                'short_title' => $abbrev_name,
2347                                'basepair_offset' => '0'
2348                                };
2349    
2350            my $offsetting = shift @start_array_region;
2351    
2352            my $second_line_config = { 'title' => "$lineage",
2353                                       'short_title' => "",
2354                                       'basepair_offset' => '0',
2355                                       'no_middle_line' => '1'
2356                                       };
2357    
2358            my $line_data = [];
2359            my $second_line_data = [];
2360    
2361            # initialize variables to check for overlap in genes
2362            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2363            my $major_line_flag = 0;
2364            my $prev_second_flag = 0;
2365    
2366            foreach my $fid1 (@$region){
2367                $second_line_flag = 0;
2368                my $element_hash;
2369                my $links_list = [];
2370                my $descriptions = [];
2371    
2372                my $color = $color_sets->{$fid1};
2373    
2374                # get subsystem information
2375                my $function = $fig->function_of($fid1);
2376                my $url_link = "?page=Annotation&feature=".$fid1;
2377    
2378                my $link;
2379                $link = {"link_title" => $fid1,
2380                         "link" => $url_link};
2381                push(@$links_list,$link);
2382    
2383                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2384                my @subsystems;
2385                foreach my $array (@subs){
2386                    my $subsystem = $$array[0];
2387                    my $ss = $subsystem;
2388                    $ss =~ s/_/ /ig;
2389                    push (@subsystems, $ss);
2390                    my $link;
2391                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2392                             "link_title" => $ss};
2393                    push(@$links_list,$link);
2394                }
2395    
2396                if ($fid1 eq $fid){
2397                    my $link;
2398                    $link = {"link_title" => "Annotate this sequence",
2399                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2400                    push (@$links_list,$link);
2401                }
2402    
2403                my $description_function;
2404                $description_function = {"title" => "function",
2405                                         "value" => $function};
2406                push(@$descriptions,$description_function);
2407    
2408                my $description_ss;
2409                my $ss_string = join (", ", @subsystems);
2410                $description_ss = {"title" => "subsystems",
2411                                   "value" => $ss_string};
2412                push(@$descriptions,$description_ss);
2413    
2414    
2415                my $fid_location = $fig->feature_location($fid1);
2416                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2417                    my($start,$stop);
2418                    $start = $2 - $offsetting;
2419                    $stop = $3 - $offsetting;
2420    
2421                    if ( (($prev_start) && ($prev_stop) ) &&
2422                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2423                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2424                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2425                            $second_line_flag = 1;
2426                            $major_line_flag = 1;
2427                        }
2428                    }
2429                    $prev_start = $start;
2430                    $prev_stop = $stop;
2431                    $prev_fig = $fid1;
2432    
2433                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2434                        $start = $gd_window_size - $start;
2435                        $stop = $gd_window_size - $stop;
2436                    }
2437    
2438                    my $title = $fid1;
2439                    if ($fid1 eq $fid){
2440                        $title = "My query gene: $fid1";
2441                    }
2442    
2443                    $element_hash = {
2444                        "title" => $title,
2445                        "start" => $start,
2446                        "end" =>  $stop,
2447                        "type"=> 'arrow',
2448                        "color"=> $color,
2449                        "zlayer" => "2",
2450                        "links_list" => $links_list,
2451                        "description" => $descriptions
2452                    };
2453    
2454                    # if there is an overlap, put into second line
2455                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2456                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2457    
2458                    if ($fid1 eq $fid){
2459                        $element_hash = {
2460                            "title" => 'Query',
2461                            "start" => $start,
2462                            "end" =>  $stop,
2463                            "type"=> 'bigbox',
2464                            "color"=> $color,
2465                            "zlayer" => "1"
2466                            };
2467    
2468                        # if there is an overlap, put into second line
2469                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2470                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2471                    }
2472                }
2473            }
2474            $gd->add_line($line_data, $line_config);
2475            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2476        }
2477        return ($gd, \@selected_sims);
2478    }
2479    
2480    sub cluster_genes {
2481        my($fig,$all_pegs,$peg) = @_;
2482        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2483    
2484        my @color_sets = ();
2485    
2486        $conn = &get_connections_by_similarity($fig,$all_pegs);
2487    
2488        for ($i=0; ($i < @$all_pegs); $i++) {
2489            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2490            if (! $seen{$i}) {
2491                $cluster = [$i];
2492                $seen{$i} = 1;
2493                for ($j=0; ($j < @$cluster); $j++) {
2494                    $x = $conn->{$cluster->[$j]};
2495                    foreach $k (@$x) {
2496                        if (! $seen{$k}) {
2497                            push(@$cluster,$k);
2498                            $seen{$k} = 1;
2499                        }
2500                    }
2501                }
2502    
2503                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2504                    push(@color_sets,$cluster);
2505                }
2506            }
2507        }
2508        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2509        $red_set = $color_sets[$i];
2510        splice(@color_sets,$i,1);
2511        @color_sets = sort { @$b <=> @$a } @color_sets;
2512        unshift(@color_sets,$red_set);
2513    
2514        my $color_sets = {};
2515        for ($i=0; ($i < @color_sets); $i++) {
2516            foreach $x (@{$color_sets[$i]}) {
2517                $color_sets->{$all_pegs->[$x]} = $i;
2518            }
2519        }
2520        return $color_sets;
2521    }
2522    
2523    sub get_connections_by_similarity {
2524        my($fig,$all_pegs) = @_;
2525        my($i,$j,$tmp,$peg,%pos_of);
2526        my($sim,%conn,$x,$y);
2527    
2528        for ($i=0; ($i < @$all_pegs); $i++) {
2529            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2530            push(@{$pos_of{$tmp}},$i);
2531            if ($tmp ne $all_pegs->[$i]) {
2532                push(@{$pos_of{$all_pegs->[$i]}},$i);
2533            }
2534        }
2535    
2536        foreach $y (keys(%pos_of)) {
2537            $x = $pos_of{$y};
2538            for ($i=0; ($i < @$x); $i++) {
2539                for ($j=$i+1; ($j < @$x); $j++) {
2540                    push(@{$conn{$x->[$i]}},$x->[$j]);
2541                    push(@{$conn{$x->[$j]}},$x->[$i]);
2542                }
2543            }
2544        }
2545    
2546        for ($i=0; ($i < @$all_pegs); $i++) {
2547            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2548                if (defined($x = $pos_of{$sim->id2})) {
2549                    foreach $y (@$x) {
2550                        push(@{$conn{$i}},$y);
2551                    }
2552                }
2553            }
2554        }
2555        return \%conn;
2556    }
2557    
2558    sub in {
2559        my($x,$xL) = @_;
2560        my($i);
2561    
2562        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2563        return ($i < @$xL);
2564    }
2565    
2566    #############################################
2567    #############################################
2568    package Observation::Commentary;
2569    
2570    use base qw(Observation);
2571    
2572    =head3 display_protein_commentary()
2573    
2574    =cut
2575    
2576    sub display_protein_commentary {
2577        my ($self,$dataset,$mypeg,$fig) = @_;
2578    
2579        my $all_rows = [];
2580        my $content;
2581        #my $fig = new FIG;
2582        my $cgi = new CGI;
2583        my $count = 0;
2584        my $peg_array = [];
2585        my (%evidence_column, %subsystems_column,  %e_identical);
2586    
2587        if (@$dataset != 1){
2588            foreach my $thing (@$dataset){
2589                if ($thing->class eq "SIM"){
2590                    push (@$peg_array, $thing->acc);
2591                }
2592            }
2593            # get the column for the evidence codes
2594            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2595    
2596            # get the column for the subsystems
2597            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2598    
2599            # get essentially identical seqs
2600            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2601        }
2602        else{
2603            push (@$peg_array, @$dataset);
2604        }
2605    
2606        my $selected_sims = [];
2607        foreach my $id (@$peg_array){
2608            last if ($count > 10);
2609            my $row_data = [];
2610            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2611            $org = $fig->org_of($id);
2612            $function = $fig->function_of($id);
2613            if ($mypeg ne $id){
2614                $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";
2615                $id_cell .= &HTML::set_prot_links($cgi,$id);
2616                if (defined($e_identical{$id})) { $id_cell .= "*";}
2617            }
2618            else{
2619                $function_cell = "&nbsp;&nbsp;$function";
2620                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2621                $id_cell .= &HTML::set_prot_links($cgi,$id);
2622            }
2623    
2624            push(@$row_data,$id_cell);
2625            push(@$row_data,$org);
2626            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2627            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2628            push(@$row_data, $fig->translation_length($id));
2629            push(@$row_data,$function_cell);
2630            push(@$all_rows,$row_data);
2631            push (@$selected_sims, $id);
2632            $count++;
2633        }
2634    
2635        if ($count >0){
2636            $content = $all_rows;
2637        }
2638        else{
2639            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2640        }
2641        return ($content,$selected_sims);
2642    }
2643    
2644    sub display_protein_history {
2645        my ($self, $id,$fig) = @_;
2646        my $all_rows = [];
2647        my $content;
2648    
2649        my $cgi = new CGI;
2650        my $count = 0;
2651        foreach my $feat ($fig->feature_annotations($id)){
2652            my $row = [];
2653            my $col1 = $feat->[2];
2654            my $col2 = $feat->[1];
2655            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2656            my $text = $feat->[3];
2657    
2658            push (@$row, $col1);
2659            push (@$row, $col2);
2660            push (@$row, $text);
2661            push (@$all_rows, $row);
2662            $count++;
2663        }
2664        if ($count > 0){
2665            $content = $all_rows;
2666        }
2667        else {
2668            $content = "There is no history for this PEG";
2669        }
2670    
2671        return($content);
2672    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3