[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.8, Tue Jun 19 22:11:25 2007 UTC revision 1.68, Sun Aug 24 15:00:17 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3    #use lib '/vol/ontologies';
4    use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10  use strict;  use WebColors;
11  use warnings;  use WebConfig;
 use Table;  
12    
13  1;  use FIG_Config;
14    #use strict;
15    #use warnings;
16    use HTML;
17    use FFs;
18    
19  # $Id$  1;
20    
21  =head1 NAME  =head1 NAME
22    
# 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 65  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 73  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 101  Line 109 
109    
110  =over 9  =over 9
111    
112    =item IDENTICAL (seq)
113    
114  =item SIM (seq)  =item SIM (seq)
115    
116  =item BBH (seq)  =item BBH (seq)
# Line 115  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 156  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 183  Line 193 
193    return $self->{stop};    return $self->{stop};
194  }  }
195    
196  =head3 evalue()  =head3 start()
197    
198  E-value or P-Value if present.  Start of hit in query sequence.
199    
200  =cut  =cut
201    
202  sub evalue {  sub qstart {
203    my ($self) = @_;    my ($self) = @_;
204    
205    return $self->{evalue};      return $self->{qstart};
206  }  }
207    
208  =head3 score()  =head3 qstop()
   
 Score if present.  
209    
210  B<Please note: >  End of the hit in query sequence.
 Either score or eval are required.  
211    
212  =cut  =cut
213    
214  sub score {  sub qstop {
215    my ($self) = @_;    my ($self) = @_;
216    return $self->{score};  
217        return $self->{qstop};
218  }  }
219    
220    =head3 hstart()
221    
222  =head3 display_method()  Start of hit in hit sequence.
223    
224  If available use the function specified here to display the "raw" observation.  =cut
 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".  
225    
226  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.  sub hstart {
227        my ($self) = @_;
228    
229  =cut      return $self->{hstart};
230    }
231    
232  sub display {  =head3 end()
233    
234    die "Abstract Method Called\n";  End of the hit in hit sequence.
235    
236  }  =cut
237    
238    sub hstop {
239        my ($self) = @_;
240    
241  =head3 rank()      return $self->{hstop};
242    }
243    
244  Returns an integer from 1 - 10 indicating the importance of this observations.  =head3 qlength()
245    
246  Currently always returns 1.  length of the query sequence in similarities
247    
248  =cut  =cut
249    
250  sub rank {  sub qlength {
251    my ($self) = @_;    my ($self) = @_;
252    
253  #  return $self->{rank};      return $self->{qlength};
   
   return 1;  
254  }  }
255    
256  =head3 supports_annotation()  =head3 hlength()
   
 Does a this observation support the annotation of its feature?  
257    
258  Returns  length of the hit sequence in similarities
259    
260  =over 3  =cut
261    
262  =item 10, if feature annotation is identical to $self->description  sub hlength {
263        my ($self) = @_;
264    
265  =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()      return $self->{hlength};
266    }
267    
268  =item undef  =head3 evalue()
269    
270  =back  E-value or P-Value if present.
271    
272  =cut  =cut
273    
274  sub supports_annotation {  sub evalue {
275    my ($self) = @_;    my ($self) = @_;
276    
277    # no code here so far    return $self->{evalue};
   
   return $self->{supports_annotation};  
278  }  }
279    
280  =head3 url()  =head3 score()
281    
282  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.  Score if present.
283    
284  =cut  =cut
285    
286  sub url {  sub score {
287    my ($self) = @_;    my ($self) = @_;
288      return $self->{score};
289    }
290    
291    =head3 display()
292    
293    will be different for each type
294    
295    =cut
296    
297    my $url = get_url($self->type, $self->acc);  sub display {
298    
299      die "Abstract Method Called\n";
300    
   return $url;  
301  }  }
302    
303  =head3 get_objects()  =head3 display_table()
304    
305  This is the B<REAL WORKHORSE> method of this Package.  will be different for each type
306    
307    =cut
308    
309    sub display_table {
310    
311  It will probably have to:    die "Abstract Table Method Called\n";
312    
 - 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;  
313   }   }
314    
315  It will invoke the required calls to the SEED API to retrieve the information required.  =head3 get_objects()
316    
317    This is the B<REAL WORKHORSE> method of this Package.
318    
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$classes) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
   
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
# Line 327  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          foreach my $class (@$classes){          my @attributes = $fig->get_attributes($fid);
336              if($class =~/(IPR|CDD|PFAM)/){          $domain_classes{'CDD'} = 1;
337                  $domain_classes{$class} = 1;          $domain_classes{'PFAM'} = 1;
338            get_identical_proteins($fid,\@matched_datasets,$fig);
339              }          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          }          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
341          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets,$fig);
342            get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343          #add CELLO and SignalP later          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 352  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            elsif($dataset->{'class'} eq "PCH"){
352                $object = Observation::FC->new($dataset);
353            }
354            elsif ($dataset->{'class'} eq "IDENTICAL"){
355                $object = Observation::Identical->new($dataset);
356            }
357            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);
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 359  Line 374 
374    
375  }  }
376    
377  =head1 Internal Methods  =head
378        provides layer of abstraction between tools and underlying access method to Attribute Server
379    =cut
380    
381  These methods are not meant to be used outside of this package.  sub get_attributes{
382        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
383        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
384        return @attributes;
385    }
386    
387  B<Please do not use them outside of this package!>  =head3 get_sims_objects()
388    
389    This is the B<REAL WORKHORSE> method of this Package.
390    
391  =cut  =cut
392    
393    sub get_sims_objects {
394        my ($self,$fid,$fig,$parameters) = @_;
395    
396        my $objects = [];
397        my @matched_datasets=();
398    
399  =head3 get_url (internal)      # call function that fetches attribute based observations
400        # returns an array of arrays of hashes
401        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
402    
403  get_url() return a valid URL or undef for any observation.      foreach my $dataset (@matched_datasets) {
404            my $object;
405            if ($dataset->{'class'} eq "SIM"){
406                $object = Observation::Sims->new($dataset);
407            }
408            push (@$objects, $object);
409        }
410        return $objects;
411    }
412    
 URLs are constructed by looking at the Accession acc()  and  name()  
413    
414  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 display_housekeeping
415    This method returns the housekeeping data for a given peg in a table format
416    
417  =cut  =cut
418    sub display_housekeeping {
419        my ($self,$fid,$fig) = @_;
420        my $content = [];
421        my $row = [];
422    
423        my $org_name = "Data not available";
424        if ( $fig->org_of($fid)){
425            $org_name = $fig->org_of($fid);
426        }
427        my $org_id = $fig->genome_of($fid);
428        my $function = $fig->function_of($fid);
429        #my $taxonomy = $fig->taxonomy_of($org_id);
430        my $length = $fig->translation_length($fid);
431    
432        push (@$row, $org_name);
433        push (@$row, $fid);
434        push (@$row, $length);
435        push (@$row, $function);
436    
437        # initialize the table for commentary and annotations
438        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
439        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
440        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
441        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
442        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
443        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
444        #$content .= qq(</table><p>\n);
445    
446  sub get_url {      push(@$content, $row);
447    
448   my ($self) = @_;      return ($content);
449   my $url='';  }
450    
451  # a hash with a URL for each observation; identified by name()  =head3 get_sims_summary
452  #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\  This method uses as input the similarities of a peg and creates a tree view of their taxonomy
 #                       '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="  
 #};  
453    
454  # if (defined $URL{$self->name}) {  =cut
455  #     $url = $URL{$self->name}.$self->acc;  
456  #     return $url;  sub get_sims_summary {
457  # }      my ($observation, $dataset, $fig) = @_;
458  # else      my %families;
459       return undef;      my $taxes = $fig->taxonomy_list();
460    
461        foreach my $thing (@$dataset) {
462            my ($id, $evalue);
463            if ($thing =~ /fig\|/){
464                $id = $thing;
465                $evalue = -1;
466            }
467            else{
468                next if ($thing->class ne "SIM");
469                $id      = $thing->acc;
470                $evalue  = $thing->evalue;
471            }
472            next if ($id !~ /fig\|/);
473            next if ($fig->is_deleted_fid($id));
474    
475            my $genome = $fig->genome_of($id);
476            #my ($genome1) = ($genome) =~ /(.*)\./;
477            my $taxonomy = $taxes->{$genome};
478            my $parent_tax = "Root";
479            my @currLineage = ($parent_tax);
480            push (@{$families{figs}{$parent_tax}}, $id);
481            my $level = 2;
482            foreach my $tax (split(/\; /, $taxonomy),$id){
483                push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
484                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
485                $families{level}{$tax} = $level;
486                push (@currLineage, $tax);
487                $families{parent}{$tax} = $parent_tax;
488                $families{lineage}{$tax} = join(";", @currLineage);
489                if (defined ($families{evalue}{$tax})){
490                    if ($evalue < $families{evalue}{$tax}){
491                        $families{evalue}{$tax} = $evalue;
492                        $families{color}{$tax} = &get_taxcolor($evalue);
493                    }
494                }
495                else{
496                    $families{evalue}{$tax} = $evalue;
497                    $families{color}{$tax} = &get_taxcolor($evalue);
498  }  }
499    
500  =head3 get_display_method (internal)              $parent_tax = $tax;
501                $level++;
502            }
503        }
504    
505  get_display_method() return a valid URL or undef for any observation.      foreach my $key (keys %{$families{children}}){
506            $families{count}{$key} = @{$families{children}{$key}};
507    
508  URLs are constructed by looking at the Accession acc()  and  name()          my %saw;
509  and Info from both attributes is combined with a table of base URLs stored in this function.          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
510            $families{children}{$key} = \@out;
511        }
512    
513  =cut      return \%families;
514    }
515    
516  sub get_display_method {  =head1 Internal Methods
517    
518   my ($self) = @_;  These methods are not meant to be used outside of this package.
519    
520  # a hash with a URL for each observation; identified by name()  B<Please do not use them outside of this package!>
 #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\  
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
521    
522  #if (defined $URL{$self->name}) {  =cut
523  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;  
524  #     return $url;  sub get_taxcolor{
525  # }      my ($evalue) = @_;
526  # else      my $color;
527       return undef;      if ($evalue == -1){            $color = "black";      }
528        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
529        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
530        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
531        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
532        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
533        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
534        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
535        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
536        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
537        else{        $color = "#6666FF";    }
538        return ($color);
539  }  }
540    
541    
542  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
543    
544      # 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)
545      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
546        my $seen = {};
547      my $fig = new FIG;      foreach my $attr_ref (@$attributes_ref) {
   
     foreach my $attr_ref ($fig->get_attributes($fid)) {  
548          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
549          my @parts = split("::",$key);          my @parts = split("::",$key);
550          my $class = $parts[0];          my $class = $parts[0];
551            my $name = $parts[1];
552            next if ($seen->{$name});
553            $seen->{$name}++;
554            #next if (($class eq "PFAM") && ($name !~ /interpro/));
555    
556          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
557              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 447  Line 560 
560                  my $from = $2;                  my $from = $2;
561                  my $to = $3;                  my $to = $3;
562                  my $evalue;                  my $evalue;
563                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
564                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
565                      my $part1 = $2/100;                      my $part1 = $2/100;
566                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
567                  }                  }
568                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
569                        $evalue=$raw_evalue;
570                    }
571                  else{                  else{
572                      $evalue = "0.0";                      $evalue = "0.0";
573                  }                  }
# Line 461  Line 577 
577                                 'type' => "dom" ,                                 'type' => "dom" ,
578                                 'evalue' => $evalue,                                 'evalue' => $evalue,
579                                 'start' => $from,                                 'start' => $from,
580                                 'stop' => $to                                 'stop' => $to,
581                                   'fig_id' => $fid,
582                                   'score' => $raw_evalue
583                                 };                                 };
584    
585                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 470  Line 588 
588      }      }
589  }  }
590    
591  =head3 get_attribute_based_evidence (internal)  sub get_attribute_based_location_observations{
592    
593  This method retrieves evidence from the attribute server      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
594        #my $fig = new FIG;
595    
596  =cut      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
597    
598        my $dataset = {'type' => "loc",
599                       'class' => 'SIGNALP_CELLO_TMPRED',
600                       'fig_id' => $fid
601                       };
602    
603  sub get_attribute_based_observations{      foreach my $attr_ref (@$attributes_ref){
604            my $key = @$attr_ref[1];
605            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
606            my @parts = split("::",$key);
607            my $sub_class = $parts[0];
608            my $sub_key = $parts[1];
609            my $value = @$attr_ref[2];
610            if($sub_class eq "SignalP"){
611                if($sub_key eq "cleavage_site"){
612                    my @value_parts = split(";",$value);
613                    $dataset->{'cleavage_prob'} = $value_parts[0];
614                    $dataset->{'cleavage_loc'} = $value_parts[1];
615                }
616                elsif($sub_key eq "signal_peptide"){
617                    $dataset->{'signal_peptide_score'} = $value;
618                }
619            }
620    
621      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)          elsif($sub_class eq "CELLO"){
622      my ($fid,$datasets_ref) = (@_);              $dataset->{'cello_location'} = $sub_key;
623                $dataset->{'cello_score'} = $value;
624            }
625    
626      my $_myfig = new FIG;          elsif($sub_class eq "Phobius"){
627                if($sub_key eq "transmembrane"){
628                    $dataset->{'phobius_tm_locations'} = $value;
629                }
630                elsif($sub_key eq "signal"){
631                    $dataset->{'phobius_signal_location'} = $value;
632                }
633            }
634    
635      foreach my $attr_ref ($_myfig->get_attributes($fid)) {          elsif($sub_class eq "TMPRED"){
636                my @value_parts = split(/\;/,$value);
637                $dataset->{'tmpred_score'} = $value_parts[0];
638                $dataset->{'tmpred_locations'} = $value_parts[1];
639            }
640        }
641    
642          # convert the ref into a string for easier handling      push (@{$datasets_ref} ,$dataset);
         my ($string) = "@$attr_ref";  
643    
644  #       print "S:$string\n";  }
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
645    
646          # 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  
         #  
647    
648          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  This methods sets the type and class for pdb observations
649    
650              # some keys are composite CDD::1233244 or PFAM:PF1233  =cut
651    
652              if ( $key =~ /::/ ) {  sub get_pdb_observations{
653                  my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
             }  
654    
655              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );      #my $fig = new FIG;
656    
657              my $evalue= 255;      foreach my $attr_ref (@$attributes_ref){
658              if (defined $raw_evalue) { # some of the tool do not give us an evalue          my $key = @$attr_ref[1];
659            next if ( ($key !~ /PDB/));
660            my($key1,$key2) =split("::",$key);
661            my $value = @$attr_ref[2];
662            my ($evalue,$location) = split(";",$value);
663    
664                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);          if($evalue =~/(\d+)\.(\d+)/){
665                  my ($new_k, $new_exp);              my $part2 = 1000 - $1;
666                my $part1 = $2/100;
667                $evalue = $part1."e-".$part2;
668            }
669    
670                  #          my($start,$stop) =split("-",$location);
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
671    
672  #                   $new_exp = (1000+$expo);          my $url = @$attr_ref[3];
673          #           $new_k = $k / 100;          my $dataset = {'class' => 'PDB',
674                           'type' => 'seq' ,
675                           'acc' => $key2,
676                           'evalue' => $evalue,
677                           'start' => $start,
678                           'stop' => $stop,
679                           'fig_id' => $fid
680                           };
681    
682            push (@{$datasets_ref} ,$dataset);
683                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
684              }              }
685    
686              # unroll it all into an array of hashes  =head3 get_cluster_observations() (internal)
687              # this needs to be done differently for different types of observations  
688              my $dataset = [ { name => 'class', value => $key },  This methods sets the type and class for cluster observations
689                              { name => 'acc' , value => $acc},  
690                              { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  =cut
691                              { name => 'evalue', value => $evalue },  
692                              { name => 'start', value => $from},  sub get_cluster_observations{
693                              { name => 'stop' , value => $to}      my ($fid,$datasets_ref,$scope) = (@_);
                             ];  
694    
695        my $dataset = {'class' => 'CLUSTER',
696                       'type' => 'fc',
697                       'context' => $scope,
698                       'fig_id' => $fid
699                       };
700              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
701          }          }
702      }  
 }  
703    
704  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
705    
# Line 549  Line 708 
708  =cut  =cut
709    
710  sub get_sims_observations{  sub get_sims_observations{
711        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
712    
713        my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
714        if ( (defined $parameters->{flag}) && ($parameters->{flag})){
715          $max_sims = $parameters->{max_sims};
716          $max_expand = $parameters->{max_expand};
717          $max_eval = $parameters->{max_eval};
718          $db_filter = $parameters->{db_filter};
719          $sim_filters->{ sort_by } = $parameters->{sim_order};
720          #$sim_order = $parameters->{sim_order};
721          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
722        }
723        elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
724          $max_sims = 50;
725          $max_expand = 5;
726          $max_eval = 1e-5;
727          $db_filter = "all";
728          $sim_filters->{ sort_by } = 'id';
729        }
730        else{
731          $max_sims = 50;
732          $max_expand = 5;
733          $max_eval = 1e-5;
734          $db_filter = "figx";
735          $sim_filters->{ sort_by } = 'id';
736          #$sim_order = "id";
737        }
738    
739      my ($fid,$datasets_ref) = (@_);      my($id, $genome, @genomes, %sims);
740      my $fig = new FIG;      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
741      my @sims= $fig->nsims($fid,100,1e-20,"fig");      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
742      my ($dataset);      my ($dataset);
743      foreach my $sim (@sims){  
744        if ($group_by_genome){
745          #  Collect all sims from genome with the first occurance of the genome:
746          foreach $sim ( @tmp ){
747            $id = $sim->id2;
748            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
749            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
750            push @{ $sims{ $genome } }, $sim;
751          }
752          @tmp = map { @{ $sims{$_} } } @genomes;
753        }
754    
755        my $seen_sims={};
756        foreach my $sim (@tmp){
757          my $hit = $sim->[1];          my $hit = $sim->[1];
758            next if ($seen_sims->{$hit});
759            $seen_sims->{$hit}++;
760            my $percent = $sim->[2];
761          my $evalue = $sim->[10];          my $evalue = $sim->[10];
762          my $from = $sim->[8];          my $qfrom = $sim->[6];
763          my $to = $sim->[9];          my $qto = $sim->[7];
764          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
765                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
766                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
767                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
768                          { name => 'start', value => $from},          my $db = get_database($hit);
769                          { name => 'stop' , value => $to}          my $func = $fig->function_of($hit);
770                          ];          my $organism;
771            if ($fig->org_of($hit)){
772                $organism = $fig->org_of($hit);
773            }
774            else{
775                $organism = "Data not available";
776            }
777    
778            $dataset = {'class' => 'SIM',
779                        'query' => $sim->[0],
780                        'acc' => $hit,
781                        'identity' => $percent,
782                        'type' => 'seq',
783                        'evalue' => $evalue,
784                        'qstart' => $qfrom,
785                        'qstop' => $qto,
786                        'hstart' => $hfrom,
787                        'hstop' => $hto,
788                        'database' => $db,
789                        'organism' => $organism,
790                        'function' => $func,
791                        'qlength' => $qlength,
792                        'hlength' => $hlength,
793                        'fig_id' => $fid
794                        };
795    
796      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
797      }      }
798  }  }
799    
800    =head3 get_database (internal)
801    This method gets the database association from the sequence id
802    
803    =cut
804    
805    sub get_database{
806        my ($id) = (@_);
807    
808        my ($db);
809        if ($id =~ /^fig\|/)              { $db = "SEED" }
810        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
811        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
812        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
813        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
814        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
815        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
816        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
817        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
818        elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
819        elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
820        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
821        elsif ($id =~ /^img\|/)           { $db = "JGI" }
822        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
823        elsif ($id =~ /^img\|/)           { $db = "IMG" }
824        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
825        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
826    
827        return ($db);
828    
829    }
830    
831    
832  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
833    
834  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 578  Line 837 
837    
838  sub get_identical_proteins{  sub get_identical_proteins{
839    
840      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
841      my $fig = new FIG;      #my $fig = new FIG;
842      my @funcs = ();      my $funcs_ref;
843    
844      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);
   
845      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
846          my ($tmp, $who);          my ($tmp, $who);
847          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
848              if ($id =~ /^fig\|/)           { $who = "FIG" }              $who = &get_database($id);
849              elsif ($id =~ /^gi\|/)            { $who = "NCBI" }              push(@$funcs_ref, [$id,$who,$tmp]);
             elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }  
             elsif ($id =~ /^sp\|/)            { $who = "SwissProt" }  
             elsif ($id =~ /^uni\|/)           { $who = "UniProt" }  
             elsif ($id =~ /^tigr\|/)          { $who = "TIGR" }  
             elsif ($id =~ /^pir\|/)           { $who = "PIR" }  
             elsif ($id =~ /^kegg\|/)          { $who = "KEGG" }  
             elsif ($id =~ /^tr\|/)            { $who = "TrEMBL" }  
             elsif ($id =~ /^eric\|/)          { $who = "ASAP" }  
   
             push(@funcs, [$id,$who,$tmp]);  
850          }          }
851      }      }
852    
853      my ($dataset);      my $dataset = {'class' => 'IDENTICAL',
854      foreach my $row (@funcs){                     'type' => 'seq',
855          my $id = $row->[0];                     'fig_id' => $fid,
856          my $organism = $fig->org_of($fid);                     'rows' => $funcs_ref
857          my $who = $row->[1];                     };
858          my $assignment = $row->[2];  
         $dataset = [ { name => 'class', value => "IDENTICAL" },  
                      { name => 'id' , value => $id},  
                      { name => 'organism', value => "$organism"} ,  
                      { name => 'database', value => $who },  
                      { name => 'description' , value => $assignment}  
                      ];  
859          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
860      }  
861    
862  }  }
863    
# Line 627  Line 869 
869    
870  sub get_functional_coupling{  sub get_functional_coupling{
871    
872      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
873      my $fig = new FIG;      #my $fig = new FIG;
874      my @funcs = ();      my @funcs = ();
875    
876      # initialize some variables      # initialize some variables
# Line 645  Line 887 
887                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
888                    } @fc_data;                    } @fc_data;
889    
890      my ($dataset);      my $dataset = {'class' => 'PCH',
891      foreach my $row (@rows){                     'type' => 'fc',
892          my $id = $row->[1];                     'fig_id' => $fid,
893          my $score = $row->[0];                     'rows' => \@rows
894          my $description = $row->[2];                     };
895          $dataset = [ { name => 'class', value => "FC" },  
                      { name => 'score' , value => $score},  
                      { name => 'id', value => "$id"} ,  
                      { name => 'description' , value => $description}  
                      ];  
896          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
897      }  
898  }  }
899    
900  =head3 get_sims_and_bbhs() (internal)  =head3 new (internal)
901    
902  This methods retrieves sims and also BBHs and fills the internal data structures.  Instantiate a new object.
903    
904  =cut  =cut
905    
906  #     sub get_sims_and_bbhs{  sub new {
907      my ($class,$dataset) = @_;
 #       # 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";  
 #       }  
908    
909  #     }    my $self = { class => $dataset->{'class'},
910                   type => $dataset->{'type'},
911                   fig_id => $dataset->{'fig_id'},
912                   score => $dataset->{'score'},
913               };
914    
915      bless($self,$class);
916    
917      return $self;
918    }
919    
920  =head3 new (internal)  =head3 identity (internal)
921    
922  Instantiate a new object.  Returns the % identity of the similar sequence
923    
924  =cut  =cut
925    
926  sub new {  sub identity {
927    my ($class,$dataset) = @_;      my ($self) = @_;
   
928    
929    #$self = { acc => '',      return $self->{identity};
930  #           description => '',  }
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
931    
932    my $self = { class => $dataset->{'class'},  =head3 fig_id (internal)
                type => $dataset->{'type'}  
             };  
933    
934    bless($self,$class);  =cut
935    
936    return $self;  sub fig_id {
937      my ($self) = @_;
938      return $self->{fig_id};
939  }  }
940    
941  =head3 feature_id (internal)  =head3 feature_id (internal)
# Line 775  Line 973 
973      return $self->{organism};      return $self->{organism};
974  }  }
975    
976  =head3 database (internal)  =head3 function (internal)
977    
978  Returns the database of the identical sequence  Returns the function of the identical sequence
979    
980    =cut
981    
982    sub function {
983        my ($self) = @_;
984    
985        return $self->{function};
986    }
987    
988    =head3 database (internal)
989    
990    Returns the database of the identical sequence
991    
992  =cut  =cut
993    
# Line 787  Line 997 
997      return $self->{database};      return $self->{database};
998  }  }
999    
1000  #package Observation::Identical;  ############################################################
1001  #1;  ############################################################
1002  #  package Observation::PDB;
1003  #our @ISA = qw(Observation);  # inherits all the methods from Observation  
1004    use base qw(Observation);
1005    
1006    sub new {
1007    
1008        my ($class,$dataset) = @_;
1009        my $self = $class->SUPER::new($dataset);
1010        $self->{acc} = $dataset->{'acc'};
1011        $self->{evalue} = $dataset->{'evalue'};
1012        $self->{start} = $dataset->{'start'};
1013        $self->{stop} = $dataset->{'stop'};
1014        bless($self,$class);
1015        return $self;
1016    }
1017    
1018    =head3 display()
1019    
1020    displays data stored in best_PDB attribute and in Ontology server for given PDB id
1021    
1022    =cut
1023    
1024    sub display{
1025        my ($self,$gd,$fig) = @_;
1026    
1027        my $fid = $self->fig_id;
1028        my $dbmaster = DBMaster->new(-database =>'Ontology',
1029                                    -host     => $WebConfig::DBHOST,
1030                                    -user     => $WebConfig::DBUSER,
1031                                    -password => $WebConfig::DBPWD);
1032    
1033        my $acc = $self->acc;
1034    
1035        my ($pdb_description,$pdb_source,$pdb_ligand);
1036        my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
1037        if(!scalar(@$pdb_objs)){
1038            $pdb_description = "not available";
1039            $pdb_source = "not available";
1040            $pdb_ligand = "not available";
1041        }
1042        else{
1043            my $pdb_obj = $pdb_objs->[0];
1044            $pdb_description = $pdb_obj->description;
1045            $pdb_source = $pdb_obj->source;
1046            $pdb_ligand = $pdb_obj->ligand;
1047        }
1048    
1049        my $lines = [];
1050        my $line_data = [];
1051        my $line_config = { 'title' => "PDB hit for $fid",
1052                            'hover_title' => 'PDB',
1053                            'short_title' => "best PDB",
1054                            'basepair_offset' => '1' };
1055    
1056        #my $fig = new FIG;
1057        my $seq = $fig->get_translation($fid);
1058        my $fid_stop = length($seq);
1059    
1060        my $fid_element_hash = {
1061            "title" => $fid,
1062            "start" => '1',
1063            "end" =>  $fid_stop,
1064            "color"=> '1',
1065            "zlayer" => '1'
1066            };
1067    
1068        push(@$line_data,$fid_element_hash);
1069    
1070        my $links_list = [];
1071        my $descriptions = [];
1072    
1073        my $name;
1074        $name = {"title" => 'id',
1075                 "value" => $acc};
1076        push(@$descriptions,$name);
1077    
1078        my $description;
1079        $description = {"title" => 'pdb description',
1080                        "value" => $pdb_description};
1081        push(@$descriptions,$description);
1082    
1083        my $score;
1084        $score = {"title" => "score",
1085                  "value" => $self->evalue};
1086        push(@$descriptions,$score);
1087    
1088        my $start_stop;
1089        my $start_stop_value = $self->start."_".$self->stop;
1090        $start_stop = {"title" => "start-stop",
1091                       "value" => $start_stop_value};
1092        push(@$descriptions,$start_stop);
1093    
1094        my $source;
1095        $source = {"title" => "source",
1096                  "value" => $pdb_source};
1097        push(@$descriptions,$source);
1098    
1099        my $ligand;
1100        $ligand = {"title" => "pdb ligand",
1101                   "value" => $pdb_ligand};
1102        push(@$descriptions,$ligand);
1103    
1104        my $link;
1105        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
1106    
1107        $link = {"link_title" => $acc,
1108                 "link" => $link_url};
1109        push(@$links_list,$link);
1110    
1111        my $pdb_element_hash = {
1112            "title" => "PDB homology",
1113            "start" => $self->start,
1114            "end" =>  $self->stop,
1115            "color"=> '6',
1116            "zlayer" => '3',
1117            "links_list" => $links_list,
1118            "description" => $descriptions};
1119    
1120        push(@$line_data,$pdb_element_hash);
1121        $gd->add_line($line_data, $line_config);
1122    
1123        return $gd;
1124    }
1125    
1126    1;
1127    
1128    ############################################################
1129    ############################################################
1130    package Observation::Identical;
1131    
1132    use base qw(Observation);
1133    
1134    sub new {
1135    
1136        my ($class,$dataset) = @_;
1137        my $self = $class->SUPER::new($dataset);
1138        $self->{rows} = $dataset->{'rows'};
1139    
1140        bless($self,$class);
1141        return $self;
1142    }
1143    
1144  =head3 display_identical()  =head3 display_table()
1145    
1146  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1147  This code will display a table for the identical protein  This code will display a table for the identical protein
1148    
1149    
1150  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.  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
1151    dence.
1152    
1153  =cut  =cut
1154    
 sub display_identical {  
     my ($self, $fid, $cgi) = @_;  
1155    
1156      my $content;  sub display_table{
1157      my $array=Observation->get_objects($fid);      my ($self,$fig) = @_;
1158    
1159        #my $fig = new FIG;
1160        my $fid = $self->fig_id;
1161        my $rows = $self->rows;
1162        my $cgi = new CGI;
1163      my $all_domains = [];      my $all_domains = [];
1164      my $count_identical = 0;      my $count_identical = 0;
1165      foreach my $thing (@$array) {      my $content;
1166          next if ($thing->class ne "IDENTICAL");      foreach my $row (@$rows) {
1167            my $id = $row->[0];
1168            my $who = $row->[1];
1169            my $assignment = $row->[2];
1170            my $organism = "Data not available";
1171            if ($fig->org_of($id)){
1172                $organism = $fig->org_of($id);
1173            }
1174          my $single_domain = [];          my $single_domain = [];
1175          push(@$single_domain,$thing->class);          push(@$single_domain,$who);
1176          my $id = $thing->id;          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1177          $count_identical++;          push(@$single_domain,$organism);
1178          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,$assignment);
         push(@$single_domain,$thing->organism);  
         push(@$single_domain,$thing->database);  
         push(@$single_domain,$thing->description);  
1179          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1180            $count_identical++;
1181      }      }
1182    
1183      if ($count_identical >0){      if ($count_identical >0){
1184          my $table_component = $self->application->component('DomainTable');          $content = $all_domains;
   
         $table_component->columns ([ { 'name' => 'Name', 'filter' => 1 },  
                                      { 'name' => 'ID' },  
                                      { 'name' => 'Organism' },  
                                      { 'name' => 'Database' },  
                                      { 'name' => 'Assignment' }  
                                      ]);  
         $table_component->data($all_domains);  
         $table_component->show_top_browse(1);  
         $table_component->show_bottom_browse(1);  
         $table_component->items_per_page(50);  
         $table_component->show_select_items_per_page(1);  
         $content .= $table_component->output();  
1185      }      }
1186      else{      else{
1187          $content = "<p>This PEG does not have any essentially identical proteins</p>";          $content = "<p>This PEG does not have any essentially identical proteins</p>";
# Line 845  Line 1189 
1189      return ($content);      return ($content);
1190  }  }
1191    
1192    1;
1193    
1194    #########################################
1195    #########################################
1196    package Observation::FC;
1197    1;
1198    
1199    use base qw(Observation);
1200    
1201    sub new {
1202    
1203        my ($class,$dataset) = @_;
1204        my $self = $class->SUPER::new($dataset);
1205        $self->{rows} = $dataset->{'rows'};
1206    
1207        bless($self,$class);
1208        return $self;
1209    }
1210    
1211    =head3 display_table()
1212    
1213    If available use the function specified here to display the "raw" observation.
1214    This code will display a table for the identical protein
1215    
1216    
1217    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
1218    dence.
1219    
1220    =cut
1221    
1222    sub display_table {
1223    
1224        my ($self,$dataset,$fig) = @_;
1225        my $fid = $self->fig_id;
1226        my $rows = $self->rows;
1227        my $cgi = new CGI;
1228        my $functional_data = [];
1229        my $count = 0;
1230        my $content;
1231    
1232        foreach my $row (@$rows) {
1233            my $single_domain = [];
1234            $count++;
1235    
1236            # construct the score link
1237            my $score = $row->[0];
1238            my $toid = $row->[1];
1239            my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1240            my $sc_link = "<a href='$link'>$score</a>";
1241    
1242            push(@$single_domain,$sc_link);
1243            push(@$single_domain,$row->[1]);
1244            push(@$single_domain,$row->[2]);
1245            push(@$functional_data,$single_domain);
1246        }
1247    
1248        if ($count >0){
1249            $content = $functional_data;
1250        }
1251        else
1252        {
1253            $content = "<p>This PEG does not have any functional coupling</p>";
1254        }
1255        return ($content);
1256    }
1257    
1258    
1259    #########################################
1260    #########################################
1261  package Observation::Domain;  package Observation::Domain;
1262    
1263  use base qw(Observation);  use base qw(Observation);
# Line 865  Line 1278 
1278  sub display {  sub display {
1279      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1280      my $lines = [];      my $lines = [];
1281      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1282                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1283                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1284      my $color = "4";      my $color = "4";
1285    
1286      my $line_data = [];      my $line_data = [];
1287      my $links_list = [];      my $links_list = [];
1288      my $descriptions = [];      my $descriptions = [];
1289    
1290      my $description_function;      my $db_and_id = $thing->acc;
1291      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1292    
1293      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology',
1294                                    -host     => $WebConfig::DBHOST,
1295                                    -user     => $WebConfig::DBUSER,
1296                                    -password => $WebConfig::DBPWD);
1297    
1298        my ($name_title,$name_value,$description_title,$description_value);
1299        if($db eq "CDD"){
1300            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1301            if(!scalar(@$cdd_objs)){
1302                $name_title = "name";
1303                $name_value = "not available";
1304                $description_title = "description";
1305                $description_value = "not available";
1306            }
1307            else{
1308                my $cdd_obj = $cdd_objs->[0];
1309                $name_title = "name";
1310                $name_value = $cdd_obj->term;
1311                $description_title = "description";
1312                $description_value = $cdd_obj->description;
1313            }
1314        }
1315        elsif($db =~ /PFAM/){
1316            my ($new_id) = ($id) =~ /(.*?)_/;
1317            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1318            if(!scalar(@$pfam_objs)){
1319                $name_title = "name";
1320                $name_value = "not available";
1321                $description_title = "description";
1322                $description_value = "not available";
1323            }
1324            else{
1325                my $pfam_obj = $pfam_objs->[0];
1326                $name_title = "name";
1327                $name_value = $pfam_obj->term;
1328                #$description_title = "description";
1329                #$description_value = $pfam_obj->description;
1330            }
1331        }
1332    
1333        my $short_title = $thing->acc;
1334        $short_title =~ s/::/ - /ig;
1335        my $new_short_title=$short_title;
1336        if ($short_title =~ /interpro/){
1337            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1338        }
1339        my $line_config = { 'title' => $name_value,
1340                            'hover_title', => 'Domain',
1341                            'short_title' => $new_short_title,
1342                            'basepair_offset' => '1' };
1343    
1344        my $name;
1345        my ($new_id) = ($id) =~ /(.*?)_/;
1346        $name = {"title" => $db,
1347                 "value" => $new_id};
1348        push(@$descriptions,$name);
1349    
1350    #    my $description;
1351    #    $description = {"title" => $description_title,
1352    #                   "value" => $description_value};
1353    #    push(@$descriptions,$description);
1354    
1355      my $score;      my $score;
1356      $score = {"title" => "score",      $score = {"title" => "score",
1357                "value" => $thing->evalue};                "value" => $thing->evalue};
1358      push(@$descriptions,$score);      push(@$descriptions,$score);
1359    
1360        my $location;
1361        $location = {"title" => "location",
1362                     "value" => $thing->start . " - " . $thing->stop};
1363        push(@$descriptions,$location);
1364    
1365      my $link_id;      my $link_id;
1366      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/::(.*)/){
1367          $link_id = $1;          $link_id = $1;
1368      }      }
1369    
1370      my $link;      my $link;
1371        my $link_url;
1372        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"}
1373        elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1374        else{$link_url = "NO_URL"}
1375    
1376      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1377               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1378      push(@$links_list,$link);      push(@$links_list,$link);
1379    
1380      my $element_hash = {      my $element_hash = {
1381          "title" => $thing->type,          "title" => $name_value,
1382          "start" => $thing->start,          "start" => $thing->start,
1383          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1384          "color"=> $color,          "color"=> $color,
# Line 911  Line 1393 
1393    
1394  }  }
1395    
1396    sub display_table {
1397        my ($self,$dataset) = @_;
1398        my $cgi = new CGI;
1399        my $data = [];
1400        my $count = 0;
1401        my $content;
1402    
1403        foreach my $thing (@$dataset) {
1404            next if ($thing->type !~ /dom/);
1405            my $single_domain = [];
1406            $count++;
1407    
1408            my $db_and_id = $thing->acc;
1409            my ($db,$id) = split("::",$db_and_id);
1410    
1411            my $dbmaster = DBMaster->new(-database =>'Ontology',
1412                                    -host     => $WebConfig::DBHOST,
1413                                    -user     => $WebConfig::DBUSER,
1414                                    -password => $WebConfig::DBPWD);
1415    
1416            my ($name_title,$name_value,$description_title,$description_value);
1417            if($db eq "CDD"){
1418                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1419                if(!scalar(@$cdd_objs)){
1420                    $name_title = "name";
1421                    $name_value = "not available";
1422                    $description_title = "description";
1423                    $description_value = "not available";
1424                }
1425                else{
1426                    my $cdd_obj = $cdd_objs->[0];
1427                    $name_title = "name";
1428                    $name_value = $cdd_obj->term;
1429                    $description_title = "description";
1430                    $description_value = $cdd_obj->description;
1431                }
1432            }
1433            elsif($db =~ /PFAM/){
1434                my ($new_id) = ($id) =~ /(.*?)_/;
1435                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1436                if(!scalar(@$pfam_objs)){
1437                    $name_title = "name";
1438                    $name_value = "not available";
1439                    $description_title = "description";
1440                    $description_value = "not available";
1441                }
1442                else{
1443                    my $pfam_obj = $pfam_objs->[0];
1444                    $name_title = "name";
1445                    $name_value = $pfam_obj->term;
1446                    #$description_title = "description";
1447                    #$description_value = $pfam_obj->description;
1448                }
1449            }
1450    
1451            my $location =  $thing->start . " - " . $thing->stop;
1452    
1453            push(@$single_domain,$db);
1454            push(@$single_domain,$thing->acc);
1455            push(@$single_domain,$name_value);
1456            push(@$single_domain,$location);
1457            push(@$single_domain,$thing->evalue);
1458            push(@$single_domain,$description_value);
1459            push(@$data,$single_domain);
1460        }
1461    
1462        if ($count >0){
1463            $content = $data;
1464        }
1465        else
1466        {
1467            $content = "<p>This PEG does not have any similarities to domains</p>";
1468        }
1469    }
1470    
1471    
1472    #########################################
1473    #########################################
1474    package Observation::Location;
1475    
1476    use base qw(Observation);
1477    
1478    sub new {
1479    
1480        my ($class,$dataset) = @_;
1481        my $self = $class->SUPER::new($dataset);
1482        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1483        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1484        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1485        $self->{cello_location} = $dataset->{'cello_location'};
1486        $self->{cello_score} = $dataset->{'cello_score'};
1487        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1488        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1489        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1490        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1491    
1492        bless($self,$class);
1493        return $self;
1494    }
1495    
1496    sub display_cello {
1497        my ($thing) = @_;
1498        my $html;
1499        my $cello_location = $thing->cello_location;
1500        my $cello_score = $thing->cello_score;
1501        if($cello_location){
1502            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1503            #$html .= "<p>CELLO score: $cello_score </p>";
1504        }
1505        return ($html);
1506    }
1507    
1508    sub display {
1509        my ($thing,$gd,$fig) = @_;
1510    
1511        my $fid = $thing->fig_id;
1512        #my $fig= new FIG;
1513        my $length = length($fig->get_translation($fid));
1514    
1515        my $cleavage_prob;
1516        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1517        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1518        my $signal_peptide_score = $thing->signal_peptide_score;
1519        my $cello_location = $thing->cello_location;
1520        my $cello_score = $thing->cello_score;
1521        my $tmpred_score = $thing->tmpred_score;
1522        my @tmpred_locations = split(",",$thing->tmpred_locations);
1523    
1524        my $phobius_signal_location = $thing->phobius_signal_location;
1525        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1526    
1527        my $lines = [];
1528    
1529        #color is
1530        my $color = "6";
1531    
1532    =head3
1533    
1534        if($cello_location){
1535            my $cello_descriptions = [];
1536            my $line_data =[];
1537    
1538            my $line_config = { 'title' => 'Localization Evidence',
1539                                'short_title' => 'CELLO',
1540                                'hover_title' => 'Localization',
1541                                'basepair_offset' => '1' };
1542    
1543            my $description_cello_location = {"title" => 'Best Cello Location',
1544                                              "value" => $cello_location};
1545    
1546            push(@$cello_descriptions,$description_cello_location);
1547    
1548            my $description_cello_score = {"title" => 'Cello Score',
1549                                           "value" => $cello_score};
1550    
1551            push(@$cello_descriptions,$description_cello_score);
1552    
1553            my $element_hash = {
1554                "title" => "CELLO",
1555                "color"=> $color,
1556                "start" => "1",
1557                "end" =>  $length + 1,
1558                "zlayer" => '1',
1559                "description" => $cello_descriptions};
1560    
1561            push(@$line_data,$element_hash);
1562            $gd->add_line($line_data, $line_config);
1563        }
1564    
1565        $color = "2";
1566        if($tmpred_score){
1567            my $line_data =[];
1568            my $line_config = { 'title' => 'Localization Evidence',
1569                                'short_title' => 'Transmembrane',
1570                                'basepair_offset' => '1' };
1571    
1572            foreach my $tmpred (@tmpred_locations){
1573                my $descriptions = [];
1574                my ($begin,$end) =split("-",$tmpred);
1575                my $description_tmpred_score = {"title" => 'TMPRED score',
1576                                 "value" => $tmpred_score};
1577    
1578                push(@$descriptions,$description_tmpred_score);
1579    
1580                my $element_hash = {
1581                "title" => "transmembrane location",
1582                "start" => $begin + 1,
1583                "end" =>  $end + 1,
1584                "color"=> $color,
1585                "zlayer" => '5',
1586                "type" => 'box',
1587                "description" => $descriptions};
1588    
1589                push(@$line_data,$element_hash);
1590    
1591            }
1592            $gd->add_line($line_data, $line_config);
1593        }
1594    =cut
1595    
1596        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1597            my $line_data =[];
1598            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1599                                'short_title' => 'TM and SP',
1600                                'hover_title' => 'Localization',
1601                                'basepair_offset' => '1' };
1602    
1603            foreach my $tm_loc (@phobius_tm_locations){
1604                my $descriptions = [];
1605                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1606                                 "value" => $tm_loc};
1607                push(@$descriptions,$description_phobius_tm_locations);
1608    
1609                my ($begin,$end) =split("-",$tm_loc);
1610    
1611                my $element_hash = {
1612                "title" => "Phobius",
1613                "start" => $begin + 1,
1614                "end" =>  $end + 1,
1615                "color"=> '6',
1616                "zlayer" => '4',
1617                "type" => 'bigbox',
1618                "description" => $descriptions};
1619    
1620                push(@$line_data,$element_hash);
1621    
1622            }
1623    
1624            if($phobius_signal_location){
1625                my $descriptions = [];
1626                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1627                                 "value" => $phobius_signal_location};
1628                push(@$descriptions,$description_phobius_signal_location);
1629    
1630    
1631                my ($begin,$end) =split("-",$phobius_signal_location);
1632                my $element_hash = {
1633                "title" => "phobius signal locations",
1634                "start" => $begin + 1,
1635                "end" =>  $end + 1,
1636                "color"=> '1',
1637                "zlayer" => '5',
1638                "type" => 'box',
1639                "description" => $descriptions};
1640                push(@$line_data,$element_hash);
1641            }
1642    
1643            $gd->add_line($line_data, $line_config);
1644        }
1645    
1646    =head3
1647        $color = "1";
1648        if($signal_peptide_score){
1649            my $line_data = [];
1650            my $descriptions = [];
1651    
1652            my $line_config = { 'title' => 'Localization Evidence',
1653                                'short_title' => 'SignalP',
1654                                'hover_title' => 'Localization',
1655                                'basepair_offset' => '1' };
1656    
1657            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1658                                                    "value" => $signal_peptide_score};
1659    
1660            push(@$descriptions,$description_signal_peptide_score);
1661    
1662            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1663                                             "value" => $cleavage_prob};
1664    
1665            push(@$descriptions,$description_cleavage_prob);
1666    
1667            my $element_hash = {
1668                "title" => "SignalP",
1669                "start" => $cleavage_loc_begin - 2,
1670                "end" =>  $cleavage_loc_end + 1,
1671                "type" => 'bigbox',
1672                "color"=> $color,
1673                "zlayer" => '10',
1674                "description" => $descriptions};
1675    
1676            push(@$line_data,$element_hash);
1677            $gd->add_line($line_data, $line_config);
1678        }
1679    =cut
1680    
1681        return ($gd);
1682    
1683    }
1684    
1685    sub cleavage_loc {
1686      my ($self) = @_;
1687    
1688      return $self->{cleavage_loc};
1689    }
1690    
1691    sub cleavage_prob {
1692      my ($self) = @_;
1693    
1694      return $self->{cleavage_prob};
1695    }
1696    
1697    sub signal_peptide_score {
1698      my ($self) = @_;
1699    
1700      return $self->{signal_peptide_score};
1701    }
1702    
1703    sub tmpred_score {
1704      my ($self) = @_;
1705    
1706      return $self->{tmpred_score};
1707    }
1708    
1709    sub tmpred_locations {
1710      my ($self) = @_;
1711    
1712      return $self->{tmpred_locations};
1713    }
1714    
1715    sub cello_location {
1716      my ($self) = @_;
1717    
1718      return $self->{cello_location};
1719    }
1720    
1721    sub cello_score {
1722      my ($self) = @_;
1723    
1724      return $self->{cello_score};
1725    }
1726    
1727    sub phobius_signal_location {
1728      my ($self) = @_;
1729      return $self->{phobius_signal_location};
1730    }
1731    
1732    sub phobius_tm_locations {
1733      my ($self) = @_;
1734      return $self->{phobius_tm_locations};
1735    }
1736    
1737    
1738    
1739    #########################################
1740    #########################################
1741    package Observation::Sims;
1742    
1743    use base qw(Observation);
1744    
1745    sub new {
1746    
1747        my ($class,$dataset) = @_;
1748        my $self = $class->SUPER::new($dataset);
1749        $self->{identity} = $dataset->{'identity'};
1750        $self->{acc} = $dataset->{'acc'};
1751        $self->{query} = $dataset->{'query'};
1752        $self->{evalue} = $dataset->{'evalue'};
1753        $self->{qstart} = $dataset->{'qstart'};
1754        $self->{qstop} = $dataset->{'qstop'};
1755        $self->{hstart} = $dataset->{'hstart'};
1756        $self->{hstop} = $dataset->{'hstop'};
1757        $self->{database} = $dataset->{'database'};
1758        $self->{organism} = $dataset->{'organism'};
1759        $self->{function} = $dataset->{'function'};
1760        $self->{qlength} = $dataset->{'qlength'};
1761        $self->{hlength} = $dataset->{'hlength'};
1762    
1763        bless($self,$class);
1764        return $self;
1765    }
1766    
1767    =head3 display()
1768    
1769    If available use the function specified here to display a graphical observation.
1770    This code will display a graphical view of the similarities using the genome drawer object
1771    
1772    =cut
1773    
1774    sub display {
1775        my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1776    
1777        # declare variables
1778        my $window_size = $gd->window_size;
1779        my $peg = $thing->acc;
1780        my $query_id = $thing->query;
1781        my $organism = $thing->organism;
1782        my $abbrev_name = $fig->abbrev($organism);
1783        if (!$organism){
1784          $organism = $peg;
1785          $abbrev_name = $peg;
1786        }
1787        my $genome = $fig->genome_of($peg);
1788        my ($org_tax) = ($genome) =~ /(.*)\./;
1789        my $function = $thing->function;
1790        my $query_start = $thing->qstart;
1791        my $query_stop = $thing->qstop;
1792        my $hit_start = $thing->hstart;
1793        my $hit_stop = $thing->hstop;
1794        my $ln_query = $thing->qlength;
1795        my $ln_hit = $thing->hlength;
1796    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1797    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1798        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1799        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1800    
1801        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1802    
1803        # hit sequence title
1804        my $line_config = { 'title' => "$organism [$org_tax]",
1805                            'short_title' => "$abbrev_name",
1806                            'title_link' => '$tax_link',
1807                            'basepair_offset' => '0',
1808                            'no_middle_line' => '1'
1809                            };
1810    
1811        # query sequence title
1812        my $replace_id = $peg;
1813        $replace_id =~ s/\|/_/ig;
1814        my $anchor_name = "anchor_". $replace_id;
1815        my $query_config = { 'title' => "Query",
1816                             'short_title' => "Query",
1817                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1818                             'basepair_offset' => '0',
1819                             'no_middle_line' => '1'
1820                             };
1821        my $line_data = [];
1822        my $query_data = [];
1823    
1824        my $element_hash;
1825        my $hit_links_list = [];
1826        my $hit_descriptions = [];
1827        my $query_descriptions = [];
1828    
1829        # get sequence information
1830        # evidence link
1831        my $evidence_link;
1832        if ($peg =~ /^fig\|/){
1833          $evidence_link = "?page=Annotation&feature=".$peg;
1834        }
1835        else{
1836          my $db = &Observation::get_database($peg);
1837          my ($link_id) = ($peg) =~ /\|(.*)/;
1838          $evidence_link = &HTML::alias_url($link_id, $db);
1839          #print STDERR "LINK: $db    $evidence_link";
1840        }
1841        my $link = {"link_title" => $peg,
1842                    "link" => $evidence_link};
1843        push(@$hit_links_list,$link) if ($evidence_link);
1844    
1845        # subsystem link
1846        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1847        my @subsystems;
1848        foreach my $array (@$subs){
1849            my $subsystem = $$array[0];
1850            push(@subsystems,$subsystem);
1851            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1852                        "link_title" => $subsystem};
1853            push(@$hit_links_list,$link);
1854        }
1855    
1856        # blast alignment
1857        $link = {"link_title" => "view blast alignment",
1858                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1859        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1860    
1861        # description data
1862        my $description_function;
1863        $description_function = {"title" => "function",
1864                                 "value" => $function};
1865        push(@$hit_descriptions,$description_function);
1866    
1867        # subsystem description
1868        my $ss_string = join (",", @subsystems);
1869        $ss_string =~ s/_/ /ig;
1870        my $description_ss = {"title" => "subsystems",
1871                              "value" => $ss_string};
1872        push(@$hit_descriptions,$description_ss);
1873    
1874        # location description
1875        # hit
1876        my $description_loc;
1877        $description_loc = {"title" => "Hit Location",
1878                            "value" => $hit_start . " - " . $hit_stop};
1879        push(@$hit_descriptions, $description_loc);
1880    
1881        $description_loc = {"title" => "Sequence Length",
1882                            "value" => $ln_hit};
1883        push(@$hit_descriptions, $description_loc);
1884    
1885        # query
1886        $description_loc = {"title" => "Hit Location",
1887                            "value" => $query_start . " - " . $query_stop};
1888        push(@$query_descriptions, $description_loc);
1889    
1890        $description_loc = {"title" => "Sequence Length",
1891                            "value" => $ln_query};
1892        push(@$query_descriptions, $description_loc);
1893    
1894    
1895    
1896        # evalue score description
1897        my $evalue = $thing->evalue;
1898        while ($evalue =~ /-0/)
1899        {
1900            my ($chunk1, $chunk2) = split(/-/, $evalue);
1901            $chunk2 = substr($chunk2,1);
1902            $evalue = $chunk1 . "-" . $chunk2;
1903        }
1904    
1905        my $color = &color($evalue);
1906        my $description_eval = {"title" => "E-Value",
1907                                "value" => $evalue};
1908        push(@$hit_descriptions, $description_eval);
1909        push(@$query_descriptions, $description_eval);
1910    
1911        my $identity = $self->identity;
1912        my $description_identity = {"title" => "Identity",
1913                                    "value" => $identity};
1914        push(@$hit_descriptions, $description_identity);
1915        push(@$query_descriptions, $description_identity);
1916    
1917    
1918        my $number = $base_start + ($query_start-$hit_start);
1919        #print STDERR "START: $number";
1920        $element_hash = {
1921            "title" => $query_id,
1922            "start" => $base_start,
1923            "end" => $base_start+$ln_query,
1924            "type"=> 'box',
1925            "color"=> $color,
1926            "zlayer" => "2",
1927            "links_list" => $query_links_list,
1928            "description" => $query_descriptions
1929            };
1930        push(@$query_data,$element_hash);
1931    
1932        $element_hash = {
1933            "title" => $query_id . ': HIT AREA',
1934            "start" => $base_start + $query_start,
1935            "end" =>  $base_start + $query_stop,
1936            "type"=> 'smallbox',
1937            "color"=> $query_color,
1938            "zlayer" => "3",
1939            "links_list" => $query_links_list,
1940            "description" => $query_descriptions
1941            };
1942        push(@$query_data,$element_hash);
1943    
1944        $gd->add_line($query_data, $query_config);
1945    
1946    
1947        $element_hash = {
1948                    "title" => $peg,
1949                    "start" => $base_start + ($query_start-$hit_start),
1950                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1951                    "type"=> 'box',
1952                    "color"=> $color,
1953                    "zlayer" => "2",
1954                    "links_list" => $hit_links_list,
1955                    "description" => $hit_descriptions
1956                    };
1957        push(@$line_data,$element_hash);
1958    
1959        $element_hash = {
1960            "title" => $peg . ': HIT AREA',
1961            "start" => $base_start + $query_start,
1962            "end" =>  $base_start + $query_stop,
1963            "type"=> 'smallbox',
1964            "color"=> $hit_color,
1965            "zlayer" => "3",
1966            "links_list" => $hit_links_list,
1967            "description" => $hit_descriptions
1968            };
1969        push(@$line_data,$element_hash);
1970    
1971        $gd->add_line($line_data, $line_config);
1972    
1973        my $breaker = [];
1974        my $breaker_hash = {};
1975        my $breaker_config = { 'no_middle_line' => "1" };
1976    
1977        push (@$breaker, $breaker_hash);
1978        $gd->add_line($breaker, $breaker_config);
1979    
1980        return ($gd);
1981    }
1982    
1983    =head3 display_domain_composition()
1984    
1985    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
1986    
1987    =cut
1988    
1989    sub display_domain_composition {
1990        my ($self,$gd,$fig) = @_;
1991    
1992        #$fig = new FIG;
1993        my $peg = $self->acc;
1994    
1995        my $line_data = [];
1996        my $links_list = [];
1997        my $descriptions = [];
1998    
1999        my @domain_query_results =$fig->get_attributes($peg,"CDD");
2000        #my @domain_query_results = ();
2001        foreach $dqr (@domain_query_results){
2002            my $key = @$dqr[1];
2003            my @parts = split("::",$key);
2004            my $db = $parts[0];
2005            my $id = $parts[1];
2006            my $val = @$dqr[2];
2007            my $from;
2008            my $to;
2009            my $evalue;
2010    
2011            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
2012                my $raw_evalue = $1;
2013                $from = $2;
2014                $to = $3;
2015                if($raw_evalue =~/(\d+)\.(\d+)/){
2016                    my $part2 = 1000 - $1;
2017                    my $part1 = $2/100;
2018                    $evalue = $part1."e-".$part2;
2019                }
2020                else{
2021                    $evalue = "0.0";
2022                }
2023            }
2024    
2025            my $dbmaster = DBMaster->new(-database =>'Ontology',
2026                                    -host     => $WebConfig::DBHOST,
2027                                    -user     => $WebConfig::DBUSER,
2028                                    -password => $WebConfig::DBPWD);
2029            my ($name_value,$description_value);
2030    
2031            if($db eq "CDD"){
2032                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
2033                if(!scalar(@$cdd_objs)){
2034                    $name_title = "name";
2035                    $name_value = "not available";
2036                    $description_title = "description";
2037                    $description_value = "not available";
2038                }
2039                else{
2040                    my $cdd_obj = $cdd_objs->[0];
2041                    $name_value = $cdd_obj->term;
2042                    $description_value = $cdd_obj->description;
2043                }
2044            }
2045    
2046            my $domain_name;
2047            $domain_name = {"title" => "name",
2048                            "value" => $name_value};
2049            push(@$descriptions,$domain_name);
2050    
2051            my $description;
2052            $description = {"title" => "description",
2053                            "value" => $description_value};
2054            push(@$descriptions,$description);
2055    
2056            my $score;
2057            $score = {"title" => "score",
2058                      "value" => $evalue};
2059            push(@$descriptions,$score);
2060    
2061            my $link_id = $id;
2062            my $link;
2063            my $link_url;
2064            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"}
2065            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2066            else{$link_url = "NO_URL"}
2067    
2068            $link = {"link_title" => $name_value,
2069                     "link" => $link_url};
2070            push(@$links_list,$link);
2071    
2072            my $domain_element_hash = {
2073                "title" => $peg,
2074                "start" => $from,
2075                "end" =>  $to,
2076                "type"=> 'box',
2077                "zlayer" => '4',
2078                "links_list" => $links_list,
2079                "description" => $descriptions
2080                };
2081    
2082            push(@$line_data,$domain_element_hash);
2083    
2084            #just one CDD domain for now, later will add option for multiple domains from selected DB
2085            last;
2086        }
2087    
2088        my $line_config = { 'title' => $peg,
2089                            'hover_title' => 'Domain',
2090                            'short_title' => $peg,
2091                            'basepair_offset' => '1' };
2092    
2093        $gd->add_line($line_data, $line_config);
2094    
2095        return ($gd);
2096    
2097    }
2098    
2099    =head3 display_table()
2100    
2101    If available use the function specified here to display the "raw" observation.
2102    This code will display a table for the similarities protein
2103    
2104    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.
2105    
2106    =cut
2107    
2108    sub display_table {
2109        my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2110        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2111    
2112        my $scroll_list;
2113        foreach my $col (@$show_columns){
2114            push (@$scroll_list, $col->{key});
2115        }
2116    
2117        push (@ids, $query_fid);
2118        foreach my $thing (@$dataset) {
2119            next if ($thing->class ne "SIM");
2120            push (@ids, $thing->acc);
2121        }
2122    
2123        $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2124        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2125    
2126        # get the column for the subsystems
2127        $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2128    
2129        # get the column for the evidence codes
2130        $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2131    
2132        # get the column for pfam_domain
2133        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2134    
2135        # get the column for molecular weight
2136        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2137    
2138        # get the column for organism's habitat
2139        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2140    
2141        # get the column for organism's temperature optimum
2142        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2143    
2144        # get the column for organism's temperature range
2145        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2146    
2147        # get the column for organism's oxygen requirement
2148        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2149    
2150        # get the column for organism's pathogenicity
2151        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2152    
2153        # get the column for organism's pathogenicity host
2154        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2155    
2156        # get the column for organism's salinity
2157        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2158    
2159        # get the column for organism's motility
2160        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2161    
2162        # get the column for organism's gram stain
2163        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2164    
2165        # get the column for organism's endospores
2166        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2167    
2168        # get the column for organism's shape
2169        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2170    
2171        # get the column for organism's disease
2172        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2173    
2174        # get the column for organism's disease
2175        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2176    
2177        # get the column for transmembrane domains
2178        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2179    
2180        # get the column for similar to human
2181        my $similar_to_human_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2182    
2183        # get the column for signal peptide
2184        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2185    
2186        # get the column for transmembrane domains
2187        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2188    
2189        # get the column for conserved neighborhood
2190        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2191    
2192        # get the column for cellular location
2193        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2194    
2195        # get the aliases
2196        my $alias_col;
2197        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2198             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2199             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2200             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2201             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2202            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2203        }
2204    
2205        # get the colors for the function cell
2206        my $functions = $fig->function_of_bulk(\@ids,1);
2207        $functional_color = &get_function_color_cell($functions, $fig);
2208        my $query_function = $fig->function_of($query_fid);
2209    
2210        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2211    
2212        my $figfam_data = &FIG::get_figfams_data();
2213        my $figfams = new FFs($figfam_data);
2214        my $same_genome_flag = 0;
2215    
2216        my $func_color_offset=0;
2217        unshift(@$dataset, $query_fid);
2218        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2219    #    foreach my $thing ( @$dataset){
2220            my $thing = $dataset->[$thing_count];
2221            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2222            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2223            if ($thing eq $query_fid){
2224                $id = $thing;
2225                $taxid   = $fig->genome_of($id);
2226                $organism = $fig->genus_species($taxid);
2227                $current_function = $fig->function_of($id);
2228            }
2229            else{
2230                next if ($thing->class ne "SIM");
2231    
2232                $id      = $thing->acc;
2233                $evalue  = $thing->evalue;
2234                $taxid   = $fig->genome_of($id);
2235                $iden    = $thing->identity;
2236                $organism= $thing->organism;
2237                $ln1     = $thing->qlength;
2238                $ln2     = $thing->hlength;
2239                $b1      = $thing->qstart;
2240                $e1      = $thing->qstop;
2241                $b2      = $thing->hstart;
2242                $e2      = $thing->hstop;
2243                $d1      = abs($e1 - $b1) + 1;
2244                $d2      = abs($e2 - $b2) + 1;
2245                $color1  = match_color( $b1, $e1, $ln1 );
2246                $color2  = match_color( $b2, $e2, $ln2 );
2247                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2248                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2249                $current_function = $thing->function;
2250                $next_org = $next_thing->organism if (defined $next_thing);
2251            }
2252    
2253            my $single_domain = [];
2254            $count++;
2255    
2256            # organisms cell
2257            my ($org, $org_color) = $fig->org_and_color_of($id);
2258    
2259            my $org_cell;
2260            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2261                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2262            }
2263            elsif ($next_org eq $organism){
2264                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2265                $same_genome_flag = 1;
2266            }
2267            elsif ($same_genome_flag == 1){
2268                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2269                $same_genome_flag = 0;
2270            }
2271    
2272            # checkbox cell
2273            my ($box_cell,$tax, $radio_cell);
2274            my $field_name = "tables_" . $id;
2275            my $pair_name = "visual_" . $id;
2276            my $cell_name = "cell_". $id;
2277            my $replace_id = $id;
2278            $replace_id =~ s/\|/_/ig;
2279            my $white = '#ffffff';
2280            $white = '#999966' if ($id eq $query_fid);
2281            $org_color = '#999966' if ($id eq $query_fid);
2282            my $anchor_name = "anchor_". $replace_id;
2283            my $checked = "";
2284            #$checked = "checked" if ($id eq $query_fid);
2285            if ($id =~ /^fig\|/){
2286              my $box = qq~<a name="$anchor_name"></a><input type="checkbox" name="seq" value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');" $checked>~;
2287              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2288              $tax = $fig->genome_of($id);
2289            }
2290            else{
2291              my $box = qq(<a name="$anchor_name"></a>);
2292              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2293            }
2294    
2295            # create the radio cell for any sequence, not just fig ids
2296            my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" onClick="clearText('new_text_function')">);
2297            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2298    
2299            # get the linked fig id
2300            my $anchor_link = "graph_" . $replace_id;
2301            my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2302            $fig_data .= qq(<td><img height='10px' width='20px' src='./Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2303            my $fig_col = {'data'=> $fig_data,
2304                           'highlight'=>$white};
2305    
2306            $replace_id = $peg;
2307            $replace_id =~ s/\|/_/ig;
2308            $anchor_name = "anchor_". $replace_id;
2309            my $query_config = { 'title' => "Query",
2310                                 'short_title' => "Query",
2311                                 'title_link' => "changeSimsLocation('$replace_id')",
2312                                 'basepair_offset' => '0'
2313                                 };
2314    
2315            # function cell
2316            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2317                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2318                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2319    
2320            my $function_color;
2321            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2322                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2323            }
2324            else{
2325                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2326            }
2327            my $function_cell;
2328            if ($current_function){
2329              if ($current_function eq $query_function){
2330                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2331                $func_color_offset=1;
2332              }
2333              else{
2334                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2335              }
2336            }
2337            else{
2338              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2339            }
2340    
2341            if ($id eq $query_fid){
2342                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2343                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2344                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2345            }
2346            else{
2347                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2348                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2349            }
2350    
2351            if ( ( $application->session->user) ){
2352                my $user = $application->session->user;
2353                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2354                    push (@$single_domain,$radio_cell);
2355                }
2356            }
2357    
2358            my ($ff) = $figfams->families_containing_peg($id);
2359    
2360            foreach my $col (@$scroll_list){
2361                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2362                else { $highlight_color = "#ffffff"; }
2363    
2364                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2365                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2366                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2367                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2368                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2369                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2370                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2371                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2372                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2373                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2374                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2375                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2393                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2394                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2395                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2396                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2397                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2398            }
2399            push(@$data,$single_domain);
2400        }
2401        if ($count >0 ){
2402            $content = $data;
2403        }
2404        else{
2405            $content = "<p>This PEG does not have any similarities</p>";
2406        }
2407        shift(@$dataset);
2408        return ($content);
2409    }
2410    
2411    sub get_box_column{
2412        my ($ids) = @_;
2413        my %column;
2414        foreach my $id (@$ids){
2415            my $field_name = "tables_" . $id;
2416            my $pair_name = "visual_" . $id;
2417            my $cell_name = "cell_" . $id;
2418            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2419        }
2420        return (%column);
2421    }
2422    
2423    sub get_figfam_column{
2424        my ($ids, $fig, $cgi) = @_;
2425        my $column;
2426    
2427        my $figfam_data = &FIG::get_figfams_data();
2428        my $figfams = new FFs($figfam_data);
2429    
2430        foreach my $id (@$ids){
2431            my ($ff) =  $figfams->families_containing_peg($id);
2432            if ($ff){
2433                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2434            }
2435            else{
2436                push (@$column, " ");
2437            }
2438        }
2439    
2440        return $column;
2441    }
2442    
2443    sub get_subsystems_column{
2444        my ($ids,$fig,$cgi,$returnType) = @_;
2445    
2446        my %in_subs  = $fig->subsystems_for_pegs($ids);
2447        my ($column, $ss);
2448        foreach my $id (@$ids){
2449            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2450            my @subsystems;
2451    
2452            if (@in_sub > 0) {
2453                foreach my $array(@in_sub){
2454                    my $ss = $array->[0];
2455                    $ss =~ s/_/ /ig;
2456                    push (@subsystems, "-" . $ss);
2457                }
2458                my $in_sub_line = join ("<br>", @subsystems);
2459                $ss->{$id} = $in_sub_line;
2460            } else {
2461                $ss->{$id} = "None added";
2462            }
2463            push (@$column, $ss->{$id});
2464        }
2465    
2466        if ($returnType eq 'hash') { return $ss; }
2467        elsif ($returnType eq 'array') { return $column; }
2468    }
2469    
2470    sub get_lineage_column{
2471        my ($ids, $fig, $cgi) = @_;
2472    
2473        my $lineages = $fig->taxonomy_list();
2474    
2475        foreach my $id (@$ids){
2476            my $genome = $fig->genome_of($id);
2477            if ($lineages->{$genome}){
2478    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2479                push (@$column, $lineages->{$genome});
2480            }
2481            else{
2482                push (@$column, " ");
2483            }
2484        }
2485        return $column;
2486    }
2487    
2488    sub match_color {
2489        my ( $b, $e, $n , $rgb) = @_;
2490        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2491        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2492        my $cov = ( $r - $l + 1 ) / $n;
2493        my $sat = 1 - 10 * $cov / 9;
2494        my $br  = 1;
2495        if ($rgb){
2496            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2497        }
2498        else{
2499            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2500        }
2501    }
2502    
2503    sub hsb2rgb {
2504        my ( $h, $s, $br ) = @_;
2505        $h = 6 * ($h - floor($h));
2506        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2507        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2508        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2509                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2510                                          :               ( 0,      1,      $h - 2 )
2511                                          )
2512                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2513                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2514                                          :               ( 1,      0,      6 - $h )
2515                                          );
2516        ( ( $r * $s + 1 - $s ) * $br,
2517          ( $g * $s + 1 - $s ) * $br,
2518          ( $b * $s + 1 - $s ) * $br
2519        )
2520    }
2521    
2522    sub html2rgb {
2523        my ($hex) = @_;
2524        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2525        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2526                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2527    
2528        my @R = split(//, $r);
2529        my @G = split(//, $g);
2530        my @B = split(//, $b);
2531    
2532        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2533        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2534        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2535    
2536        my $rgb = [$red, $green, $blue];
2537        return $rgb;
2538    
2539    }
2540    
2541    sub rgb2html {
2542        my ( $r, $g, $b ) = @_;
2543        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2544        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2545        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2546        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2547    }
2548    
2549    sub floor {
2550        my $x = $_[0];
2551        defined( $x ) || return undef;
2552        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2553    }
2554    
2555    sub get_function_color_cell{
2556      my ($functions, $fig) = @_;
2557    
2558      # figure out the quantity of each function
2559      my %hash;
2560      foreach my $key (keys %$functions){
2561        my $func = $functions->{$key};
2562        $hash{$func}++;
2563      }
2564    
2565      my %func_colors;
2566      my $count = 1;
2567      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2568        $func_colors{$key}=$count;
2569        $count++;
2570      }
2571    
2572      return \%func_colors;
2573    }
2574    
2575    sub get_essentially_identical{
2576        my ($fid,$dataset,$fig) = @_;
2577        #my $fig = new FIG;
2578    
2579        my %id_list;
2580        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2581    
2582        foreach my $thing (@$dataset){
2583            if($thing->class eq "IDENTICAL"){
2584                my $rows = $thing->rows;
2585                my $count_identical = 0;
2586                foreach my $row (@$rows) {
2587                    my $id = $row->[0];
2588                    if (($id ne $fid) && ($fig->function_of($id))) {
2589                        $id_list{$id} = 1;
2590                    }
2591                }
2592            }
2593        }
2594    
2595    #    foreach my $id (@maps_to) {
2596    #        if (($id ne $fid) && ($fig->function_of($id))) {
2597    #           $id_list{$id} = 1;
2598    #        }
2599    #    }
2600        return(%id_list);
2601    }
2602    
2603    
2604    sub get_evidence_column{
2605        my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2606        my ($column, $code_attributes);
2607    
2608        if (! defined $attributes) {
2609            my @attributes_array = $fig->get_attributes($ids);
2610            $attributes = \@attributes_array;
2611        }
2612    
2613        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2614        foreach my $key (@codes){
2615            push (@{$code_attributes->{$key->[0]}}, $key);
2616        }
2617    
2618        foreach my $id (@$ids){
2619            # add evidence code with tool tip
2620            my $ev_codes=" &nbsp; ";
2621    
2622            my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2623            my @ev_codes = ();
2624            foreach my $code (@codes) {
2625                my $pretty_code = $code->[2];
2626                if ($pretty_code =~ /;/) {
2627                    my ($cd, $ss) = split(";", $code->[2]);
2628                    print STDERR "$id: $cd, $ss\n";
2629                    if ($cd =~ /ilit|dlit/){
2630                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2631                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2632                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2633                    }
2634                    $ss =~ s/_/ /g;
2635                    $pretty_code = $cd;# . " in " . $ss;
2636                }
2637                push(@ev_codes, $pretty_code);
2638            }
2639    
2640            if (scalar(@ev_codes) && $ev_codes[0]) {
2641                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2642                $ev_codes = $cgi->a(
2643                                    {
2644                                        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));
2645            }
2646    
2647            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2648            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2649        }
2650        return $column;
2651    }
2652    
2653    sub get_attrb_column{
2654        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2655    
2656        my ($column, %code_attributes, %attribute_locations);
2657        my $dbmaster = DBMaster->new(-database =>'Ontology',
2658                                     -host     => $WebConfig::DBHOST,
2659                                     -user     => $WebConfig::DBUSER,
2660                                     -password => $WebConfig::DBPWD);
2661    
2662        if ($colName eq "pfam"){
2663            if (! defined $attributes) {
2664                my @attributes_array = $fig->get_attributes($ids);
2665                $attributes = \@attributes_array;
2666            }
2667    
2668            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2669            foreach my $key (@codes){
2670                my $name = $key->[1];
2671                if ($name =~ /_/){
2672                    ($name) = ($key->[1]) =~ /(.*?)_/;
2673                }
2674                push (@{$code_attributes{$key->[0]}}, $name);
2675                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2676            }
2677    
2678            foreach my $id (@$ids){
2679                # add pfam code
2680                my $pfam_codes=" &nbsp; ";
2681                my @pfam_codes = "";
2682                my %description_codes;
2683    
2684                if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2685                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2686                    @pfam_codes = ();
2687    
2688                    # get only unique values
2689                    my %saw;
2690                    foreach my $key (@ncodes) {$saw{$key}=1;}
2691                    @ncodes = keys %saw;
2692    
2693                    foreach my $code (@ncodes) {
2694                        my @parts = split("::",$code);
2695                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2696    
2697                        # get the locations for the domain
2698                        my @locs;
2699                        foreach my $part (@{$attribute_location{$id}{$code}}){
2700                            my ($loc) = ($part) =~ /\;(.*)/;
2701                            push (@locs,$loc);
2702                        }
2703                        my %locsaw;
2704                        foreach my $key (@locs) {$locsaw{$key}=1;}
2705                        @locs = keys %locsaw;
2706    
2707                        my $locations = join (", ", @locs);
2708    
2709                        if (defined ($description_codes{$parts[1]})){
2710                            push(@pfam_codes, "$parts[1] ($locations)");
2711                        }
2712                        else {
2713                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2714                            $description_codes{$parts[1]} = $description->[0]->{term};
2715                            push(@pfam_codes, "$pfam_link ($locations)");
2716                        }
2717                    }
2718    
2719                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2720                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2721                }
2722            }
2723        }
2724        elsif ($colName eq 'cellular_location'){
2725            if (! defined $attributes) {
2726                my @attributes_array = $fig->get_attributes($ids);
2727                $attributes = \@attributes_array;
2728            }
2729    
2730            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2731            foreach my $key (@codes){
2732                my ($loc) = ($key->[1]) =~ /::(.*)/;
2733                my ($new_loc, @all);
2734                @all = split (//, $loc);
2735                my $count = 0;
2736                foreach my $i (@all){
2737                    if ( ($i eq uc($i)) && ($count > 0) ){
2738                        $new_loc .= " " . $i;
2739                    }
2740                    else{
2741                        $new_loc .= $i;
2742                    }
2743                    $count++;
2744                }
2745                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2746            }
2747    
2748            foreach my $id (@$ids){
2749                my (@values, $entry);
2750                #@values = (" ");
2751                if (defined @{$code_attributes{$id}}){
2752                    my @ncodes = @{$code_attributes{$id}};
2753                    foreach my $code (@ncodes){
2754                        push (@values, $code->[0] . ", " . $code->[1]);
2755                    }
2756                }
2757                else{
2758                    @values = ("Not available");
2759                }
2760    
2761                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2762                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2763            }
2764        }
2765        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2766                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2767            if (! defined $attributes) {
2768                my @attributes_array = $fig->get_attributes($ids);
2769                $attributes = \@attributes_array;
2770            }
2771    
2772            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2773            foreach my $key (@codes){
2774                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2775            }
2776    
2777            foreach my $id (@$ids){
2778                my (@values, $entry);
2779                #@values = (" ");
2780                if (defined @{$code_attributes{$id}}){
2781                    my @ncodes = @{$code_attributes{$id}};
2782                    foreach my $code (@ncodes){
2783                        push (@values, $code);
2784                    }
2785                }
2786                else{
2787                    @values = ("Not available");
2788                }
2789    
2790                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2791                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2792            }
2793        }
2794        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2795                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2796                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2797                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2798                ($colName eq 'gc_content') ) {
2799            if (! defined $attributes) {
2800                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2801                $attributes = \@attributes_array;
2802            }
2803    
2804            my $genomes_with_phenotype;
2805            foreach my $attribute (@$attributes){
2806                my $genome = $attribute->[0];
2807                $genomes_with_phenotype->{$genome} = $attribute->[2];
2808            }
2809    
2810            foreach my $id (@$ids){
2811                my $genome = $fig->genome_of($id);
2812                my @values = (' ');
2813                if (defined $genomes_with_phenotype->{$genome}){
2814                    push (@values, $genomes_with_phenotype->{$genome});
2815                }
2816                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2817                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2818            }
2819        }
2820    
2821        return $column;
2822    }
2823    
2824    
2825    sub get_db_aliases {
2826        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2827    
2828        my $db_array;
2829        my $all_aliases = $fig->feature_aliases_bulk($ids);
2830        foreach my $id (@$ids){
2831            foreach my $alias (@{$$all_aliases{$id}}){
2832                my $id_db = &Observation::get_database($alias);
2833                next if ( ($id_db ne $db) && ($db ne 'all') );
2834                next if ($aliases->{$id}->{$db});
2835                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2836            }
2837            if (!defined( $aliases->{$id}->{$db})){
2838                $aliases->{$id}->{$db} = " ";
2839            }
2840            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2841            push (@$db_array, $aliases->{$id}->{$db});
2842        }
2843    
2844        if ($returnType eq 'hash') { return $aliases; }
2845        elsif ($returnType eq 'array') { return $db_array; }
2846    }
2847    
2848    
2849    
2850    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2851    
2852    sub color {
2853        my ($evalue) = @_;
2854        my $palette = WebColors::get_palette('vitamins');
2855        my $color;
2856        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2857        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2858        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2859        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2860        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2861        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2862        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2863        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2864        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2865        else{        $color = $palette->[9];    }
2866        return ($color);
2867    }
2868    
2869    
2870    ############################
2871    package Observation::Cluster;
2872    
2873    use base qw(Observation);
2874    
2875    sub new {
2876    
2877        my ($class,$dataset) = @_;
2878        my $self = $class->SUPER::new($dataset);
2879        $self->{context} = $dataset->{'context'};
2880        bless($self,$class);
2881        return $self;
2882    }
2883    
2884    sub display {
2885        my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2886    
2887        $taxes = $fig->taxonomy_list();
2888    
2889        my $fid = $self->fig_id;
2890        my $compare_or_coupling = $self->context;
2891        my $gd_window_size = $gd->window_size;
2892        my $range = $gd_window_size;
2893        my $all_regions = [];
2894        my $gene_associations={};
2895    
2896        #get the organism genome
2897        my $target_genome = $fig->genome_of($fid);
2898        $gene_associations->{$fid}->{"organism"} = $target_genome;
2899        $gene_associations->{$fid}->{"main_gene"} = $fid;
2900        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2901    
2902        # get location of the gene
2903        my $data = $fig->feature_location($fid);
2904        my ($contig, $beg, $end);
2905        my %reverse_flag;
2906    
2907        if ($data =~ /(.*)_(\d+)_(\d+)$/){
2908            $contig = $1;
2909            $beg = $2;
2910            $end = $3;
2911        }
2912    
2913        my $offset;
2914        my ($region_start, $region_end);
2915        if ($beg < $end)
2916        {
2917            $region_start = $beg - ($range);
2918            $region_end = $end+ ($range);
2919            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2920        }
2921        else
2922        {
2923            $region_start = $end-($range);
2924            $region_end = $beg+($range);
2925            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2926            $reverse_flag{$target_genome} = $fid;
2927            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2928        }
2929    
2930        # call genes in region
2931        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2932        #foreach my $feat (@$target_gene_features){
2933        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2934        #}
2935        push(@$all_regions,$target_gene_features);
2936        my (@start_array_region);
2937        push (@start_array_region, $offset);
2938    
2939        my %all_genes;
2940        my %all_genomes;
2941        foreach my $feature (@$target_gene_features){
2942            #if ($feature =~ /peg/){
2943                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2944            #}
2945        }
2946    
2947        my @selected_sims;
2948    
2949        if ($compare_or_coupling eq "sims"){
2950            # get the selected boxes
2951            my @selected_taxonomy = @$selected_taxonomies;
2952    
2953            # get the similarities and store only the ones that match the lineages selected
2954            if (@selected_taxonomy > 0){
2955                foreach my $sim (@$sims_array){
2956                    next if ($sim->class ne "SIM");
2957                    next if ($sim->acc !~ /fig\|/);
2958    
2959                    #my $genome = $fig->genome_of($sim->[1]);
2960                    my $genome = $fig->genome_of($sim->acc);
2961                    #my ($genome1) = ($genome) =~ /(.*)\./;
2962                    my $lineage = $taxes->{$genome};
2963                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2964                    foreach my $taxon(@selected_taxonomy){
2965                        if ($lineage =~ /$taxon/){
2966                            #push (@selected_sims, $sim->[1]);
2967                            push (@selected_sims, $sim->acc);
2968                        }
2969                    }
2970                }
2971            }
2972            else{
2973                my $simcount = 0;
2974                foreach my $sim (@$sims_array){
2975                    next if ($sim->class ne "SIM");
2976                    next if ($sim->acc !~ /fig\|/);
2977    
2978                    push (@selected_sims, $sim->acc);
2979                    $simcount++;
2980                    last if ($simcount > 4);
2981                }
2982            }
2983    
2984            my %saw;
2985            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2986    
2987            # get the gene context for the sorted matches
2988            foreach my $sim_fid(@selected_sims){
2989                #get the organism genome
2990                my $sim_genome = $fig->genome_of($sim_fid);
2991                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2992                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2993                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2994    
2995                # get location of the gene
2996                my $data = $fig->feature_location($sim_fid);
2997                my ($contig, $beg, $end);
2998    
2999                if ($data =~ /(.*)_(\d+)_(\d+)$/){
3000                    $contig = $1;
3001                    $beg = $2;
3002                    $end = $3;
3003                }
3004    
3005                my $offset;
3006                my ($region_start, $region_end);
3007                if ($beg < $end)
3008                {
3009                    $region_start = $beg - ($range/2);
3010                    $region_end = $end+($range/2);
3011                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
3012                }
3013                else
3014                {
3015                    $region_start = $end-($range/2);
3016                    $region_end = $beg+($range/2);
3017                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3018                    $reverse_flag{$sim_genome} = $sim_fid;
3019                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
3020                }
3021    
3022                # call genes in region
3023                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
3024                push(@$all_regions,$sim_gene_features);
3025                push (@start_array_region, $offset);
3026                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
3027                $all_genomes{$sim_genome} = 1;
3028            }
3029    
3030        }
3031    
3032        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3033        # cluster the genes
3034        my @all_pegs = keys %all_genes;
3035        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3036        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3037        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
3038    
3039        foreach my $region (@$all_regions){
3040            my $sample_peg = @$region[0];
3041            my $region_genome = $fig->genome_of($sample_peg);
3042            my $region_gs = $fig->genus_species($region_genome);
3043            my $abbrev_name = $fig->abbrev($region_gs);
3044            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3045            my $lineage = $taxes->{$region_genome};
3046            #my $lineage = $fig->taxonomy_of($region_genome);
3047            #$region_gs .= "Lineage:$lineage";
3048            my $line_config = { 'title' => $region_gs,
3049                                'short_title' => $abbrev_name,
3050                                'basepair_offset' => '0'
3051                                };
3052    
3053            my $offsetting = shift @start_array_region;
3054    
3055            my $second_line_config = { 'title' => "$lineage",
3056                                       'short_title' => "",
3057                                       'basepair_offset' => '0',
3058                                       'no_middle_line' => '1'
3059                                       };
3060    
3061            my $line_data = [];
3062            my $second_line_data = [];
3063    
3064            # initialize variables to check for overlap in genes
3065            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
3066            my $major_line_flag = 0;
3067            my $prev_second_flag = 0;
3068    
3069            foreach my $fid1 (@$region){
3070                $second_line_flag = 0;
3071                my $element_hash;
3072                my $links_list = [];
3073                my $descriptions = [];
3074    
3075                my $color = $color_sets->{$fid1};
3076    
3077                # get subsystem information
3078                my $function = $fig->function_of($fid1);
3079                my $url_link = "?page=Annotation&feature=".$fid1;
3080    
3081                my $link;
3082                $link = {"link_title" => $fid1,
3083                         "link" => $url_link};
3084                push(@$links_list,$link);
3085    
3086                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3087                my @subsystems;
3088                foreach my $array (@subs){
3089                    my $subsystem = $$array[0];
3090                    my $ss = $subsystem;
3091                    $ss =~ s/_/ /ig;
3092                    push (@subsystems, $ss);
3093                    my $link;
3094                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3095                             "link_title" => $ss};
3096                    push(@$links_list,$link);
3097                }
3098    
3099                if ($fid1 eq $fid){
3100                    my $link;
3101                    $link = {"link_title" => "Annotate this sequence",
3102                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3103                    push (@$links_list,$link);
3104                }
3105    
3106                my $description_function;
3107                $description_function = {"title" => "function",
3108                                         "value" => $function};
3109                push(@$descriptions,$description_function);
3110    
3111                my $description_ss;
3112                my $ss_string = join (", ", @subsystems);
3113                $description_ss = {"title" => "subsystems",
3114                                   "value" => $ss_string};
3115                push(@$descriptions,$description_ss);
3116    
3117    
3118                my $fid_location = $fig->feature_location($fid1);
3119                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
3120                    my($start,$stop);
3121                    $start = $2 - $offsetting;
3122                    $stop = $3 - $offsetting;
3123    
3124                    if ( (($prev_start) && ($prev_stop) ) &&
3125                         ( ($start < $prev_start) || ($start < $prev_stop) ||
3126                           ($stop < $prev_start) || ($stop < $prev_stop) )){
3127                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
3128                            $second_line_flag = 1;
3129                            $major_line_flag = 1;
3130                        }
3131                    }
3132                    $prev_start = $start;
3133                    $prev_stop = $stop;
3134                    $prev_fig = $fid1;
3135    
3136                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3137                        $start = $gd_window_size - $start;
3138                        $stop = $gd_window_size - $stop;
3139                    }
3140    
3141                    my $title = $fid1;
3142                    if ($fid1 eq $fid){
3143                        $title = "My query gene: $fid1";
3144                    }
3145    
3146                    $element_hash = {
3147                        "title" => $title,
3148                        "start" => $start,
3149                        "end" =>  $stop,
3150                        "type"=> 'arrow',
3151                        "color"=> $color,
3152                        "zlayer" => "2",
3153                        "links_list" => $links_list,
3154                        "description" => $descriptions
3155                    };
3156    
3157                    # if there is an overlap, put into second line
3158                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3159                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3160    
3161                    if ($fid1 eq $fid){
3162                        $element_hash = {
3163                            "title" => 'Query',
3164                            "start" => $start,
3165                            "end" =>  $stop,
3166                            "type"=> 'bigbox',
3167                            "color"=> $color,
3168                            "zlayer" => "1"
3169                            };
3170    
3171                        # if there is an overlap, put into second line
3172                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3173                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3174                    }
3175                }
3176            }
3177            $gd->add_line($line_data, $line_config);
3178            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3179        }
3180        return ($gd, \@selected_sims);
3181    }
3182    
3183    sub cluster_genes {
3184        my($fig,$all_pegs,$peg) = @_;
3185        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3186    
3187        my @color_sets = ();
3188    
3189        $conn = &get_connections_by_similarity($fig,$all_pegs);
3190    
3191        for ($i=0; ($i < @$all_pegs); $i++) {
3192            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3193            if (! $seen{$i}) {
3194                $cluster = [$i];
3195                $seen{$i} = 1;
3196                for ($j=0; ($j < @$cluster); $j++) {
3197                    $x = $conn->{$cluster->[$j]};
3198                    foreach $k (@$x) {
3199                        if (! $seen{$k}) {
3200                            push(@$cluster,$k);
3201                            $seen{$k} = 1;
3202                        }
3203                    }
3204                }
3205    
3206                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3207                    push(@color_sets,$cluster);
3208                }
3209            }
3210        }
3211        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3212        $red_set = $color_sets[$i];
3213        splice(@color_sets,$i,1);
3214        @color_sets = sort { @$b <=> @$a } @color_sets;
3215        unshift(@color_sets,$red_set);
3216    
3217        my $color_sets = {};
3218        for ($i=0; ($i < @color_sets); $i++) {
3219            foreach $x (@{$color_sets[$i]}) {
3220                $color_sets->{$all_pegs->[$x]} = $i;
3221            }
3222        }
3223        return $color_sets;
3224    }
3225    
3226    sub get_connections_by_similarity {
3227        my($fig,$all_pegs) = @_;
3228        my($i,$j,$tmp,$peg,%pos_of);
3229        my($sim,%conn,$x,$y);
3230    
3231        for ($i=0; ($i < @$all_pegs); $i++) {
3232            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3233            push(@{$pos_of{$tmp}},$i);
3234            if ($tmp ne $all_pegs->[$i]) {
3235                push(@{$pos_of{$all_pegs->[$i]}},$i);
3236            }
3237        }
3238    
3239        foreach $y (keys(%pos_of)) {
3240            $x = $pos_of{$y};
3241            for ($i=0; ($i < @$x); $i++) {
3242                for ($j=$i+1; ($j < @$x); $j++) {
3243                    push(@{$conn{$x->[$i]}},$x->[$j]);
3244                    push(@{$conn{$x->[$j]}},$x->[$i]);
3245                }
3246            }
3247        }
3248    
3249        for ($i=0; ($i < @$all_pegs); $i++) {
3250            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3251                if (defined($x = $pos_of{$sim->id2})) {
3252                    foreach $y (@$x) {
3253                        push(@{$conn{$i}},$y);
3254                    }
3255                }
3256            }
3257        }
3258        return \%conn;
3259    }
3260    
3261    sub in {
3262        my($x,$xL) = @_;
3263        my($i);
3264    
3265        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3266        return ($i < @$xL);
3267    }
3268    
3269    #############################################
3270    #############################################
3271    package Observation::Commentary;
3272    
3273    use base qw(Observation);
3274    
3275    =head3 display_protein_commentary()
3276    
3277    =cut
3278    
3279    sub display_protein_commentary {
3280        my ($self,$dataset,$mypeg,$fig) = @_;
3281    
3282        my $all_rows = [];
3283        my $content;
3284        #my $fig = new FIG;
3285        my $cgi = new CGI;
3286        my $count = 0;
3287        my $peg_array = [];
3288        my ($evidence_column, $subsystems_column,  %e_identical);
3289    
3290        if (@$dataset != 1){
3291            foreach my $thing (@$dataset){
3292                if ($thing->class eq "SIM"){
3293                    push (@$peg_array, $thing->acc);
3294                }
3295            }
3296            # get the column for the evidence codes
3297            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3298    
3299            # get the column for the subsystems
3300            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3301    
3302            # get essentially identical seqs
3303            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3304        }
3305        else{
3306            push (@$peg_array, @$dataset);
3307        }
3308    
3309        my $selected_sims = [];
3310        foreach my $id (@$peg_array){
3311            last if ($count > 10);
3312            my $row_data = [];
3313            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3314            if ($fig->org_of($id)){
3315                $org = $fig->org_of($id);
3316            }
3317            else{
3318                $org = "Data not available";
3319            }
3320            $function = $fig->function_of($id);
3321            if ($mypeg ne $id){
3322                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3323                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3324                if (defined($e_identical{$id})) { $id_cell .= "*";}
3325            }
3326            else{
3327                $function_cell = "&nbsp;&nbsp;$function";
3328                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3329                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3330            }
3331    
3332            push(@$row_data,$id_cell);
3333            push(@$row_data,$org);
3334            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3335            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3336            push(@$row_data, $fig->translation_length($id));
3337            push(@$row_data,$function_cell);
3338            push(@$all_rows,$row_data);
3339            push (@$selected_sims, $id);
3340            $count++;
3341        }
3342    
3343        if ($count >0){
3344            $content = $all_rows;
3345        }
3346        else{
3347            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3348        }
3349        return ($content,$selected_sims);
3350    }
3351    
3352    sub display_protein_history {
3353        my ($self, $id,$fig) = @_;
3354        my $all_rows = [];
3355        my $content;
3356    
3357        my $cgi = new CGI;
3358        my $count = 0;
3359        foreach my $feat ($fig->feature_annotations($id)){
3360            my $row = [];
3361            my $col1 = $feat->[2];
3362            my $col2 = $feat->[1];
3363            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3364            my $text = $feat->[3];
3365    
3366            push (@$row, $col1);
3367            push (@$row, $col2);
3368            push (@$row, $text);
3369            push (@$all_rows, $row);
3370            $count++;
3371        }
3372        if ($count > 0){
3373            $content = $all_rows;
3374        }
3375        else {
3376            $content = "There is no history for this PEG";
3377        }
3378    
3379        return($content);
3380    }
3381    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.68

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3