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

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.75

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3