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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3