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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3