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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3