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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3