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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3