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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3