[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3