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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3