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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3