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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3