[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.56, Mon Mar 24 18:25:30 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3    #use lib '/vol/ontologies';
4    use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10  use strict;  use WebColors;
11  use warnings;  use WebConfig;
12    
13  1;  use FIG_Config;
14    #use strict;
15    #use warnings;
16    use HTML;
17    use FFs;
18    
19  # $Id$  1;
20    
21  =head1 NAME  =head1 NAME
22    
# Line 21  Line 29 
29    
30  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).
31    
 Example:  
   
 use FIG;  
 use Observation;  
   
 my $fig = new FIG;  
 my $fid = "fig|83333.1.peg.3";  
   
 my $observations = Observation::get_objects($fid);  
 foreach my $observation (@$observations) {  
     print "ID: " . $fid . "\n";  
     print "Start: " . $observation->start() . "\n";  
     ...  
 }  
   
 B<return an array of objects>  
   
   
 print "$Observation->acc\n" prints the Accession number if present for the Observation  
   
32  =cut  =cut
33    
34  =head1 BACKGROUND  =head1 BACKGROUND
# Line 64  Line 52 
52    
53  The public methods this package provides are listed below:  The public methods this package provides are listed below:
54    
55    
56    =head3 context()
57    
58    Returns close or diverse for purposes of displaying genomic context
59    
60    =cut
61    
62    sub context {
63      my ($self) = @_;
64    
65      return $self->{context};
66    }
67    
68    =head3 rows()
69    
70    each row in a displayed table
71    
72    =cut
73    
74    sub rows {
75      my ($self) = @_;
76    
77      return $self->{rows};
78    }
79    
80  =head3 acc()  =head3 acc()
81    
82  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.
# Line 72  Line 85 
85    
86  sub acc {  sub acc {
87    my ($self) = @_;    my ($self) = @_;
   
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91  =head3 description()  =head3 query()
   
 The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  
92    
93  B<Please note:>  The query id
 Either remoteid or description is required.  
94    
95  =cut  =cut
96    
97  sub description {  sub query {
98    my ($self) = @_;    my ($self) = @_;
99        return $self->{query};
   return $self->{acc};  
100  }  }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 100  Line 109 
109    
110  =over 9  =over 9
111    
112  =item sim (seq)  =item IDENTICAL (seq)
113    
114    =item SIM (seq)
115    
116  =item bbh (seq)  =item BBH (seq)
117    
118  =item pch (fc)  =item PCH (fc)
119    
120  =item figfam (seq)  =item FIGFAM (seq)
121    
122  =item ipr (dom)  =item IPR (dom)
123    
124  =item cdd (dom)  =item CDD (dom)
125    
126  =item pfam (dom)  =item PFAM (dom)
127    
128  =item signalp (dom)  =item SIGNALP_CELLO_TMPRED (loc)
129    
130  =item cello (loc)  =item PDB (seq)
131    
132  =item tmhmm (loc)  =item TMHMM (loc)
133    
134  =item hmmtop (loc)  =item HMMTOP (loc)
135    
136  =back  =back
137    
# Line 155  Line 166 
166  sub type {  sub type {
167    my ($self) = @_;    my ($self) = @_;
168    
169    return $self->{acc};    return $self->{type};
170  }  }
171    
172  =head3 start()  =head3 start()
# Line 182  Line 193 
193    return $self->{stop};    return $self->{stop};
194  }  }
195    
196  =head3 evalue()  =head3 start()
197    
198  E-value or P-Value if present.  Start of hit in query sequence.
199    
200  =cut  =cut
201    
202  sub evalue {  sub qstart {
203    my ($self) = @_;    my ($self) = @_;
204    
205    return $self->{evalue};      return $self->{qstart};
206  }  }
207    
208  =head3 score()  =head3 qstop()
   
 Score if present.  
209    
210  B<Please note: >  End of the hit in query sequence.
 Either score or eval are required.  
211    
212  =cut  =cut
213    
214  sub score {  sub qstop {
215    my ($self) = @_;    my ($self) = @_;
216    
217    return $self->{score};      return $self->{qstop};
218  }  }
219    
220    =head3 hstart()
221    
222  =head3 display_method()  Start of hit in hit sequence.
223    
224  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".  
225    
226  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 {
227        my ($self) = @_;
228    
229        return $self->{hstart};
230    }
231    
232    =head3 end()
233    
234    End of the hit in hit sequence.
235    
236  =cut  =cut
237    
238  sub display_method {  sub hstop {
239    my ($self) = @_;    my ($self) = @_;
240    
241    # add code here      return $self->{hstop};
   
   return $self->{display_method};  
242  }  }
243    
244  =head3 rank()  =head3 qlength()
   
 Returns an integer from 1 - 10 indicating the importance of this observations.  
245    
246  Currently always returns 1.  length of the query sequence in similarities
247    
248  =cut  =cut
249    
250  sub rank {  sub qlength {
251    my ($self) = @_;    my ($self) = @_;
252    
253  #  return $self->{rank};      return $self->{qlength};
   
   return 1;  
254  }  }
255    
256  =head3 supports_annotation()  =head3 hlength()
   
 Does a this observation support the annotation of its feature?  
257    
258  Returns  length of the hit sequence in similarities
259    
260  =over 3  =cut
261    
262  =item 10, if feature annotation is identical to $self->description  sub hlength {
263        my ($self) = @_;
264    
265  =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()      return $self->{hlength};
266    }
267    
268  =item undef  =head3 evalue()
269    
270  =back  E-value or P-Value if present.
271    
272  =cut  =cut
273    
274  sub supports_annotation {  sub evalue {
275    my ($self) = @_;    my ($self) = @_;
276    
277    # no code here so far    return $self->{evalue};
   
   return $self->{supports_annotation};  
278  }  }
279    
280  =head3 url()  =head3 score()
281    
282  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.
283    
284  =cut  =cut
285    
286  sub url {  sub score {
287    my ($self) = @_;    my ($self) = @_;
288      return $self->{score};
289    }
290    
291    =head3 display()
292    
293    will be different for each type
294    
295    my $url = get_url($self->type, $self->acc);  =cut
296    
297    sub display {
298    
299      die "Abstract Method Called\n";
300    
   return $url;  
301  }  }
302    
303  =head3 get_objects()  =head3 display_table()
304    
305  This is the B<REAL WORKHORSE> method of this Package.  will be different for each type
306    
307    =cut
308    
309    sub display_table {
310    
311  It will probably have to:    die "Abstract Table Method Called\n";
312    
 - 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;  
313   }   }
314    
315  It will invoke the required calls to the SEED API to retrieve the information required.  =head3 get_objects()
316    
317    This is the B<REAL WORKHORSE> method of this Package.
318    
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325    my @matched_datasets=();    my @matched_datasets=();
326    
327    # call function that fetches attribut based observations      # call function that fetches attribute based observations
328    # returns an array of arrays of hashes    # returns an array of arrays of hashes
   #  
   get_attribute_based_observations($fid,\@matched_datasets);  
329    
330    # read sims + bbh (enrich BBHs with sims coordindates etc)      if($scope){
331    # read pchs          get_cluster_observations($fid,\@matched_datasets,$scope);
332    # read figfam match data from 48hr directory (BobO knows how do do this!)      }
333    # what sources of evidence did I miss?      else{
334            my %domain_classes;
335            my @attributes = $fig->get_attributes($fid);
336            $domain_classes{'CDD'} = 1;
337            $domain_classes{'PFAM'} = 1;
338            get_identical_proteins($fid,\@matched_datasets,$fig);
339            get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340            get_sims_observations($fid,\@matched_datasets,$fig);
341            get_functional_coupling($fid,\@matched_datasets,$fig);
342            get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344        }
345    
346    foreach my $dataset (@matched_datasets) {    foreach my $dataset (@matched_datasets) {
347      my $object = $self->new();          my $object;
348      foreach my $attribute (@$dataset) {          if($dataset->{'type'} eq "dom"){
349        $object->{$attribute->{'name'}} = $attribute->{'value'};              $object = Observation::Domain->new($dataset);
350      }      }
351  #    $object->{$attribute->{'feature_id'}} = $attribute->{$fid};          elsif($dataset->{'class'} eq "PCH"){
352      push (@$objects, $object);              $object = Observation::FC->new($dataset);
353            }
354            elsif ($dataset->{'class'} eq "IDENTICAL"){
355                $object = Observation::Identical->new($dataset);
356            }
357            elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358                $object = Observation::Location->new($dataset);
359            }
360            elsif ($dataset->{'class'} eq "SIM"){
361                $object = Observation::Sims->new($dataset);
362            }
363            elsif ($dataset->{'class'} eq "CLUSTER"){
364                $object = Observation::Cluster->new($dataset);
365            }
366            elsif ($dataset->{'class'} eq "PDB"){
367                $object = Observation::PDB->new($dataset);
368      }      }
369    
370            push (@$objects, $object);
371        }
372    
373    return $objects;    return $objects;
374    
375    }
376    
377    =head3 display_housekeeping
378    This method returns the housekeeping data for a given peg in a table format
379    
380    =cut
381    sub display_housekeeping {
382        my ($self,$fid,$fig) = @_;
383        my $content = [];
384        my $row = [];
385    
386        my $org_name = $fig->org_of($fid);
387        my $org_id = $fig->genome_of($fid);
388        my $function = $fig->function_of($fid);
389        #my $taxonomy = $fig->taxonomy_of($org_id);
390        my $length = $fig->translation_length($fid);
391    
392        push (@$row, $org_name);
393        push (@$row, $fid);
394        push (@$row, $length);
395        push (@$row, $function);
396    
397        # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404        #$content .= qq(</table><p>\n);
405    
406        push(@$content, $row);
407    
408        return ($content);
409    }
410    
411    =head3 get_sims_summary
412    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
413    
414    =cut
415    
416    sub get_sims_summary {
417        my ($observation, $dataset, $fig) = @_;
418        my %families;
419        my $taxes = $fig->taxonomy_list();
420    
421        foreach my $thing (@$dataset) {
422            my ($id, $evalue);
423            if ($thing =~ /fig\|/){
424                $id = $thing;
425                $evalue = -1;
426            }
427            else{
428                next if ($thing->class ne "SIM");
429                $id      = $thing->acc;
430                $evalue  = $thing->evalue;
431            }
432            next if ($id !~ /fig\|/);
433            next if ($fig->is_deleted_fid($id));
434    
435            my $genome = $fig->genome_of($id);
436            #my ($genome1) = ($genome) =~ /(.*)\./;
437            my $taxonomy = $taxes->{$genome};
438            my $parent_tax = "Root";
439            my @currLineage = ($parent_tax);
440            push (@{$families{figs}{$parent_tax}}, $id);
441            my $level = 2;
442            foreach my $tax (split(/\; /, $taxonomy)){
443                push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
444                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
445                $families{level}{$tax} = $level;
446                push (@currLineage, $tax);
447                $families{parent}{$tax} = $parent_tax;
448                $families{lineage}{$tax} = join(";", @currLineage);
449                if (defined ($families{evalue}{$tax})){
450                    if ($evalue < $families{evalue}{$tax}){
451                        $families{evalue}{$tax} = $evalue;
452                        $families{color}{$tax} = &get_taxcolor($evalue);
453                    }
454                }
455                else{
456                    $families{evalue}{$tax} = $evalue;
457                    $families{color}{$tax} = &get_taxcolor($evalue);
458                }
459    
460                $parent_tax = $tax;
461                $level++;
462            }
463        }
464    
465        foreach my $key (keys %{$families{children}}){
466            $families{count}{$key} = @{$families{children}{$key}};
467    
468            my %saw;
469            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
470            $families{children}{$key} = \@out;
471        }
472    
473        return \%families;
474  }  }
475    
476  =head1 Internal Methods  =head1 Internal Methods
# Line 355  Line 481 
481    
482  =cut  =cut
483    
484    sub get_taxcolor{
485        my ($evalue) = @_;
486        my $color;
487        if ($evalue == -1){            $color = "black";      }
488        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
489        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
490        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
491        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
492        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
493        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
494        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
495        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
496        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
497        else{        $color = "#6666FF";    }
498        return ($color);
499    }
500    
501    
502  =head3 get_url (internal)  sub get_attribute_based_domain_observations{
503    
504  get_url() return a valid URL or undef for any observation.      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
505        my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
506    
507  URLs are constructed by looking at the Accession acc()  and  name()      foreach my $attr_ref (@$attributes_ref) {
508            my $key = @$attr_ref[1];
509            my @parts = split("::",$key);
510            my $class = $parts[0];
511            my $name = $parts[1];
512            #next if (($class eq "PFAM") && ($name !~ /interpro/));
513    
514            if($domain_classes->{$parts[0]}){
515                my $val = @$attr_ref[2];
516                if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
517                    my $raw_evalue = $1;
518                    my $from = $2;
519                    my $to = $3;
520                    my $evalue;
521                    if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
522                        my $part2 = 1000 - $1;
523                        my $part1 = $2/100;
524                        $evalue = $part1."e-".$part2;
525                    }
526                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
527                        $evalue=$raw_evalue;
528                    }
529                    else{
530                        $evalue = "0.0";
531                    }
532    
533                    my $dataset = {'class' => $class,
534                                   'acc' => $key,
535                                   'type' => "dom" ,
536                                   'evalue' => $evalue,
537                                   'start' => $from,
538                                   'stop' => $to,
539                                   'fig_id' => $fid,
540                                   'score' => $raw_evalue
541                                   };
542    
543  Info from both attributes is combined with a table of base URLs stored in this function.                  push (@{$datasets_ref} ,$dataset);
544                }
545            }
546        }
547    }
548    
549  =cut  sub get_attribute_based_location_observations{
550    
551  sub get_url {      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
552        #my $fig = new FIG;
553    
554   my ($self) = @_;      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
  my $url='';  
555    
556  # a hash with a URL for each observation; identified by name()      my $dataset = {'type' => "loc",
557  #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\                     'class' => 'SIGNALP_CELLO_TMPRED',
558  #                       'IPR'    => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\                     'fig_id' => $fid
559  #                          '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="  
 #};  
560    
561  # if (defined $URL{$self->name}) {      foreach my $attr_ref (@$attributes_ref){
562  #     $url = $URL{$self->name}.$self->acc;          my $key = @$attr_ref[1];
563  #     return $url;          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
564  # }          my @parts = split("::",$key);
565  # else          my $sub_class = $parts[0];
566       return undef;          my $sub_key = $parts[1];
567            my $value = @$attr_ref[2];
568            if($sub_class eq "SignalP"){
569                if($sub_key eq "cleavage_site"){
570                    my @value_parts = split(";",$value);
571                    $dataset->{'cleavage_prob'} = $value_parts[0];
572                    $dataset->{'cleavage_loc'} = $value_parts[1];
573                }
574                elsif($sub_key eq "signal_peptide"){
575                    $dataset->{'signal_peptide_score'} = $value;
576                }
577            }
578    
579            elsif($sub_class eq "CELLO"){
580                $dataset->{'cello_location'} = $sub_key;
581                $dataset->{'cello_score'} = $value;
582            }
583    
584            elsif($sub_class eq "Phobius"){
585                if($sub_key eq "transmembrane"){
586                    $dataset->{'phobius_tm_locations'} = $value;
587                }
588                elsif($sub_key eq "signal"){
589                    $dataset->{'phobius_signal_location'} = $value;
590                }
591            }
592    
593            elsif($sub_class eq "TMPRED"){
594                my @value_parts = split(/\;/,$value);
595                $dataset->{'tmpred_score'} = $value_parts[0];
596                $dataset->{'tmpred_locations'} = $value_parts[1];
597            }
598  }  }
599    
600  =head3 get_display_method (internal)      push (@{$datasets_ref} ,$dataset);
601    
602    }
603    
604  get_display_method() return a valid URL or undef for any observation.  =head3 get_pdb_observations() (internal)
605    
606  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.  
607    
608  =cut  =cut
609    
610  sub get_display_method {  sub get_pdb_observations{
611        my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
612    
613   my ($self) = @_;      #my $fig = new FIG;
614    
615  # a hash with a URL for each observation; identified by name()      foreach my $attr_ref (@$attributes_ref){
616  #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\          my $key = @$attr_ref[1];
617  #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="          next if ( ($key !~ /PDB/));
618  # };          my($key1,$key2) =split("::",$key);
619            my $value = @$attr_ref[2];
620            my ($evalue,$location) = split(";",$value);
621    
622  #if (defined $URL{$self->name}) {          if($evalue =~/(\d+)\.(\d+)/){
623  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;              my $part2 = 1000 - $1;
624  #     return $url;              my $part1 = $2/100;
625  # }              $evalue = $part1."e-".$part2;
626  # else          }
627       return undef;  
628            my($start,$stop) =split("-",$location);
629    
630            my $url = @$attr_ref[3];
631            my $dataset = {'class' => 'PDB',
632                           'type' => 'seq' ,
633                           'acc' => $key2,
634                           'evalue' => $evalue,
635                           'start' => $start,
636                           'stop' => $stop,
637                           'fig_id' => $fid
638                           };
639    
640            push (@{$datasets_ref} ,$dataset);
641        }
642  }  }
643    
644  =head3 get_attribute_based_evidence (internal)  =head3 get_cluster_observations() (internal)
645    
646  This method retrieves evidence from the attribute server  This methods sets the type and class for cluster observations
647    
648  =cut  =cut
649    
650  sub get_attribute_based_observations{  sub get_cluster_observations{
651        my ($fid,$datasets_ref,$scope) = (@_);
652    
653      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      my $dataset = {'class' => 'CLUSTER',
654      my ($fid,$datasets_ref) = (@_);                     'type' => 'fc',
655                       'context' => $scope,
656                       'fig_id' => $fid
657                       };
658        push (@{$datasets_ref} ,$dataset);
659    }
660    
661    
662    =head3 get_sims_observations() (internal)
663    
664      my $_myfig = new FIG;  This methods retrieves sims fills the internal data structures.
665    
666      foreach my $attr_ref ($_myfig->get_attributes($fid)) {  =cut
667    
668    sub get_sims_observations{
669    
670        my ($fid,$datasets_ref,$fig) = (@_);
671        #my $fig = new FIG;
672        my @sims= $fig->sims($fid,500,10,"fig");
673        my ($dataset);
674    
675        foreach my $sim (@sims){
676            next if ($fig->is_deleted_fid($sim->[1]));
677            my $hit = $sim->[1];
678            my $percent = $sim->[2];
679            my $evalue = $sim->[10];
680            my $qfrom = $sim->[6];
681            my $qto = $sim->[7];
682            my $hfrom = $sim->[8];
683            my $hto = $sim->[9];
684            my $qlength = $sim->[12];
685            my $hlength = $sim->[13];
686            my $db = get_database($hit);
687            my $func = $fig->function_of($hit);
688            my $organism = $fig->org_of($hit);
689    
690            $dataset = {'class' => 'SIM',
691                        'query' => $sim->[0],
692                        'acc' => $hit,
693                        'identity' => $percent,
694                        'type' => 'seq',
695                        'evalue' => $evalue,
696                        'qstart' => $qfrom,
697                        'qstop' => $qto,
698                        'hstart' => $hfrom,
699                        'hstop' => $hto,
700                        'database' => $db,
701                        'organism' => $organism,
702                        'function' => $func,
703                        'qlength' => $qlength,
704                        'hlength' => $hlength,
705                        'fig_id' => $fid
706                        };
707    
708            push (@{$datasets_ref} ,$dataset);
709        }
710    }
711    
712          # convert the ref into a string for easier handling  =head3 get_database (internal)
713          my ($string) = "@$attr_ref";  This method gets the database association from the sequence id
714    
715  #       print "S:$string\n";  =cut
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
716    
717          # THIS SHOULD BE DONE ANOTHER WAY FM->TD  sub get_database{
718          # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc      my ($id) = (@_);
         # as fas as possible this should be configured so that the type of observation and the regexp are  
         # stored somewhere for easy expansion  
         #  
719    
720          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {      my ($db);
721        if ($id =~ /^fig\|/)              { $db = "FIG" }
722        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
723        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
724        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
725        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
726        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
727        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
728        elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
729        elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
730        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
731        elsif ($id =~ /^img\|/)           { $db = "JGI" }
732    
733              # some keys are composite CDD::1233244 or PFAM:PF1233      return ($db);
734    
             if ( $key =~ /::/ ) {  
                 my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);  
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
735              }              }
736    
             my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );  
737    
738              my $evalue= 255;  =head3 get_identical_proteins() (internal)
739              if (defined $raw_evalue) { # some of the tool do not give us an evalue  
740    This methods retrieves sims fills the internal data structures.
741    
742                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);  =cut
                 my ($new_k, $new_exp);  
743    
744                  #  sub get_identical_proteins{
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
745    
746  #                   $new_exp = (1000+$expo);      my ($fid,$datasets_ref,$fig) = (@_);
747          #           $new_k = $k / 100;      #my $fig = new FIG;
748        my $funcs_ref;
749    
750        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
751        foreach my $id (@maps_to) {
752            my ($tmp, $who);
753            if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
754                $who = &get_database($id);
755                push(@$funcs_ref, [$id,$who,$tmp]);
756                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
757              }              }
758    
759              # unroll it all into an array of hashes      my $dataset = {'class' => 'IDENTICAL',
760              # this needs to be done differently for different types of observations                     'type' => 'seq',
761              my $dataset = [ { name => 'class', value => $key },                     'fig_id' => $fid,
762                              { name => 'acc' , value => $acc},                     'rows' => $funcs_ref
763                              { 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}  
                             ];  
764    
765              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
766          }  
767      }  
768  }  }
769    
770  =head3 get_sims_and_bbhs() (internal)  =head3 get_functional_coupling() (internal)
771    
772  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
773    
774  =cut  =cut
775    
776  #     sub get_sims_and_bbhs{  sub get_functional_coupling{
777    
778  #       # blast m8 output format      my ($fid,$datasets_ref,$fig) = (@_);
779  #       # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit      #my $fig = new FIG;
780        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";  
 #       }  
781    
782  #       # BBHs      # initialize some variables
783  #       my $BBHs=();      my($sc,$neigh);
784    
785  #       @bbhs_src = $fig->bbhs($fid,1.0e-10);      # set default parameters for coupling and evidence
786  #       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";  
 #       }  
787    
788  #     }      # get the fc data
789        my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
790    
791        # retrieve data
792        my @rows = map { ($sc,$neigh) = @$_;
793                         [$sc,$neigh,scalar $fig->function_of($neigh)]
794                      } @fc_data;
795    
796        my $dataset = {'class' => 'PCH',
797                       'type' => 'fc',
798                       'fig_id' => $fid,
799                       'rows' => \@rows
800                       };
801    
802        push (@{$datasets_ref} ,$dataset);
803    
804    }
805    
806  =head3 new (internal)  =head3 new (internal)
807    
# Line 539  Line 810 
810  =cut  =cut
811    
812  sub new {  sub new {
813    my ($self) = @_;    my ($class,$dataset) = @_;
814    
815    $self = { acc => '',    my $self = { class => $dataset->{'class'},
816              description => '',                 type => $dataset->{'type'},
817              class => '',                 fig_id => $dataset->{'fig_id'},
818              type => '',                 score => $dataset->{'score'},
             start => '',  
             stop => '',  
             evalue => '',  
             score => '',  
             display_method => '',  
             feature_id => '',  
             rank => '',  
             supports_annotation => ''  
819            };            };
820    
821    bless($self, 'Observation');    bless($self,$class);
822    
823    return $self;    return $self;
824  }  }
825    
826    =head3 identity (internal)
827    
828    Returns the % identity of the similar sequence
829    
830    =cut
831    
832    sub identity {
833        my ($self) = @_;
834    
835        return $self->{identity};
836    }
837    
838    =head3 fig_id (internal)
839    
840    =cut
841    
842    sub fig_id {
843      my ($self) = @_;
844      return $self->{fig_id};
845    }
846    
847  =head3 feature_id (internal)  =head3 feature_id (internal)
848    
 Returns the ID  of the feature these Observations belong to.  
849    
850  =cut  =cut
851    
# Line 571  Line 854 
854    
855    return $self->{feature_id};    return $self->{feature_id};
856  }  }
857    
858    =head3 id (internal)
859    
860    Returns the ID  of the identical sequence
861    
862    =cut
863    
864    sub id {
865        my ($self) = @_;
866    
867        return $self->{id};
868    }
869    
870    =head3 organism (internal)
871    
872    Returns the organism  of the identical sequence
873    
874    =cut
875    
876    sub organism {
877        my ($self) = @_;
878    
879        return $self->{organism};
880    }
881    
882    =head3 function (internal)
883    
884    Returns the function of the identical sequence
885    
886    =cut
887    
888    sub function {
889        my ($self) = @_;
890    
891        return $self->{function};
892    }
893    
894    =head3 database (internal)
895    
896    Returns the database of the identical sequence
897    
898    =cut
899    
900    sub database {
901        my ($self) = @_;
902    
903        return $self->{database};
904    }
905    
906    ############################################################
907    ############################################################
908    package Observation::PDB;
909    
910    use base qw(Observation);
911    
912    sub new {
913    
914        my ($class,$dataset) = @_;
915        my $self = $class->SUPER::new($dataset);
916        $self->{acc} = $dataset->{'acc'};
917        $self->{evalue} = $dataset->{'evalue'};
918        $self->{start} = $dataset->{'start'};
919        $self->{stop} = $dataset->{'stop'};
920        bless($self,$class);
921        return $self;
922    }
923    
924    =head3 display()
925    
926    displays data stored in best_PDB attribute and in Ontology server for given PDB id
927    
928    =cut
929    
930    sub display{
931        my ($self,$gd,$fig) = @_;
932    
933        my $fid = $self->fig_id;
934        my $dbmaster = DBMaster->new(-database =>'Ontology',
935                                    -host     => $WebConfig::DBHOST,
936                                    -user     => $WebConfig::DBUSER,
937                                    -password => $WebConfig::DBPWD);
938    
939        my $acc = $self->acc;
940    
941        my ($pdb_description,$pdb_source,$pdb_ligand);
942        my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
943        if(!scalar(@$pdb_objs)){
944            $pdb_description = "not available";
945            $pdb_source = "not available";
946            $pdb_ligand = "not available";
947        }
948        else{
949            my $pdb_obj = $pdb_objs->[0];
950            $pdb_description = $pdb_obj->description;
951            $pdb_source = $pdb_obj->source;
952            $pdb_ligand = $pdb_obj->ligand;
953        }
954    
955        my $lines = [];
956        my $line_data = [];
957        my $line_config = { 'title' => "PDB hit for $fid",
958                            'hover_title' => 'PDB',
959                            'short_title' => "best PDB",
960                            'basepair_offset' => '1' };
961    
962        #my $fig = new FIG;
963        my $seq = $fig->get_translation($fid);
964        my $fid_stop = length($seq);
965    
966        my $fid_element_hash = {
967            "title" => $fid,
968            "start" => '1',
969            "end" =>  $fid_stop,
970            "color"=> '1',
971            "zlayer" => '1'
972            };
973    
974        push(@$line_data,$fid_element_hash);
975    
976        my $links_list = [];
977        my $descriptions = [];
978    
979        my $name;
980        $name = {"title" => 'id',
981                 "value" => $acc};
982        push(@$descriptions,$name);
983    
984        my $description;
985        $description = {"title" => 'pdb description',
986                        "value" => $pdb_description};
987        push(@$descriptions,$description);
988    
989        my $score;
990        $score = {"title" => "score",
991                  "value" => $self->evalue};
992        push(@$descriptions,$score);
993    
994        my $start_stop;
995        my $start_stop_value = $self->start."_".$self->stop;
996        $start_stop = {"title" => "start-stop",
997                       "value" => $start_stop_value};
998        push(@$descriptions,$start_stop);
999    
1000        my $source;
1001        $source = {"title" => "source",
1002                  "value" => $pdb_source};
1003        push(@$descriptions,$source);
1004    
1005        my $ligand;
1006        $ligand = {"title" => "pdb ligand",
1007                   "value" => $pdb_ligand};
1008        push(@$descriptions,$ligand);
1009    
1010        my $link;
1011        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
1012    
1013        $link = {"link_title" => $acc,
1014                 "link" => $link_url};
1015        push(@$links_list,$link);
1016    
1017        my $pdb_element_hash = {
1018            "title" => "PDB homology",
1019            "start" => $self->start,
1020            "end" =>  $self->stop,
1021            "color"=> '6',
1022            "zlayer" => '3',
1023            "links_list" => $links_list,
1024            "description" => $descriptions};
1025    
1026        push(@$line_data,$pdb_element_hash);
1027        $gd->add_line($line_data, $line_config);
1028    
1029        return $gd;
1030    }
1031    
1032    1;
1033    
1034    ############################################################
1035    ############################################################
1036    package Observation::Identical;
1037    
1038    use base qw(Observation);
1039    
1040    sub new {
1041    
1042        my ($class,$dataset) = @_;
1043        my $self = $class->SUPER::new($dataset);
1044        $self->{rows} = $dataset->{'rows'};
1045    
1046        bless($self,$class);
1047        return $self;
1048    }
1049    
1050    =head3 display_table()
1051    
1052    If available use the function specified here to display the "raw" observation.
1053    This code will display a table for the identical protein
1054    
1055    
1056    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
1057    dence.
1058    
1059    =cut
1060    
1061    
1062    sub display_table{
1063        my ($self,$fig) = @_;
1064    
1065        #my $fig = new FIG;
1066        my $fid = $self->fig_id;
1067        my $rows = $self->rows;
1068        my $cgi = new CGI;
1069        my $all_domains = [];
1070        my $count_identical = 0;
1071        my $content;
1072        foreach my $row (@$rows) {
1073            my $id = $row->[0];
1074            my $who = $row->[1];
1075            my $assignment = $row->[2];
1076            my $organism = $fig->org_of($id);
1077            my $single_domain = [];
1078            push(@$single_domain,$who);
1079            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1080            push(@$single_domain,$organism);
1081            push(@$single_domain,$assignment);
1082            push(@$all_domains,$single_domain);
1083            $count_identical++;
1084        }
1085    
1086        if ($count_identical >0){
1087            $content = $all_domains;
1088        }
1089        else{
1090            $content = "<p>This PEG does not have any essentially identical proteins</p>";
1091        }
1092        return ($content);
1093    }
1094    
1095    1;
1096    
1097    #########################################
1098    #########################################
1099    package Observation::FC;
1100    1;
1101    
1102    use base qw(Observation);
1103    
1104    sub new {
1105    
1106        my ($class,$dataset) = @_;
1107        my $self = $class->SUPER::new($dataset);
1108        $self->{rows} = $dataset->{'rows'};
1109    
1110        bless($self,$class);
1111        return $self;
1112    }
1113    
1114    =head3 display_table()
1115    
1116    If available use the function specified here to display the "raw" observation.
1117    This code will display a table for the identical protein
1118    
1119    
1120    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
1121    dence.
1122    
1123    =cut
1124    
1125    sub display_table {
1126    
1127        my ($self,$dataset,$fig) = @_;
1128        my $fid = $self->fig_id;
1129        my $rows = $self->rows;
1130        my $cgi = new CGI;
1131        my $functional_data = [];
1132        my $count = 0;
1133        my $content;
1134    
1135        foreach my $row (@$rows) {
1136            my $single_domain = [];
1137            $count++;
1138    
1139            # construct the score link
1140            my $score = $row->[0];
1141            my $toid = $row->[1];
1142            my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1143            my $sc_link = "<a href='$link'>$score</a>";
1144    
1145            push(@$single_domain,$sc_link);
1146            push(@$single_domain,$row->[1]);
1147            push(@$single_domain,$row->[2]);
1148            push(@$functional_data,$single_domain);
1149        }
1150    
1151        if ($count >0){
1152            $content = $functional_data;
1153        }
1154        else
1155        {
1156            $content = "<p>This PEG does not have any functional coupling</p>";
1157        }
1158        return ($content);
1159    }
1160    
1161    
1162    #########################################
1163    #########################################
1164    package Observation::Domain;
1165    
1166    use base qw(Observation);
1167    
1168    sub new {
1169    
1170        my ($class,$dataset) = @_;
1171        my $self = $class->SUPER::new($dataset);
1172        $self->{evalue} = $dataset->{'evalue'};
1173        $self->{acc} = $dataset->{'acc'};
1174        $self->{start} = $dataset->{'start'};
1175        $self->{stop} = $dataset->{'stop'};
1176    
1177        bless($self,$class);
1178        return $self;
1179    }
1180    
1181    sub display {
1182        my ($thing,$gd) = @_;
1183        my $lines = [];
1184    #    my $line_config = { 'title' => $thing->acc,
1185    #                       'short_title' => $thing->type,
1186    #                       'basepair_offset' => '1' };
1187        my $color = "4";
1188    
1189        my $line_data = [];
1190        my $links_list = [];
1191        my $descriptions = [];
1192    
1193        my $db_and_id = $thing->acc;
1194        my ($db,$id) = split("::",$db_and_id);
1195    
1196        my $dbmaster = DBMaster->new(-database =>'Ontology',
1197                                    -host     => $WebConfig::DBHOST,
1198                                    -user     => $WebConfig::DBUSER,
1199                                    -password => $WebConfig::DBPWD);
1200    
1201        my ($name_title,$name_value,$description_title,$description_value);
1202        if($db eq "CDD"){
1203            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1204            if(!scalar(@$cdd_objs)){
1205                $name_title = "name";
1206                $name_value = "not available";
1207                $description_title = "description";
1208                $description_value = "not available";
1209            }
1210            else{
1211                my $cdd_obj = $cdd_objs->[0];
1212                $name_title = "name";
1213                $name_value = $cdd_obj->term;
1214                $description_title = "description";
1215                $description_value = $cdd_obj->description;
1216            }
1217        }
1218        elsif($db =~ /PFAM/){
1219            my ($new_id) = ($id) =~ /(.*?)_/;
1220            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1221            if(!scalar(@$pfam_objs)){
1222                $name_title = "name";
1223                $name_value = "not available";
1224                $description_title = "description";
1225                $description_value = "not available";
1226            }
1227            else{
1228                my $pfam_obj = $pfam_objs->[0];
1229                $name_title = "name";
1230                $name_value = $pfam_obj->term;
1231                #$description_title = "description";
1232                #$description_value = $pfam_obj->description;
1233            }
1234        }
1235    
1236        my $short_title = $thing->acc;
1237        $short_title =~ s/::/ - /ig;
1238        my $new_short_title=$short_title;
1239        if ($short_title =~ /interpro/){
1240            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1241        }
1242        my $line_config = { 'title' => $name_value,
1243                            'hover_title', => 'Domain',
1244                            'short_title' => $new_short_title,
1245                            'basepair_offset' => '1' };
1246    
1247        my $name;
1248        my ($new_id) = ($id) =~ /(.*?)_/;
1249        $name = {"title" => $db,
1250                 "value" => $new_id};
1251        push(@$descriptions,$name);
1252    
1253    #    my $description;
1254    #    $description = {"title" => $description_title,
1255    #                   "value" => $description_value};
1256    #    push(@$descriptions,$description);
1257    
1258        my $score;
1259        $score = {"title" => "score",
1260                  "value" => $thing->evalue};
1261        push(@$descriptions,$score);
1262    
1263        my $location;
1264        $location = {"title" => "location",
1265                     "value" => $thing->start . " - " . $thing->stop};
1266        push(@$descriptions,$location);
1267    
1268        my $link_id;
1269        if ($thing->acc =~/::(.*)/){
1270            $link_id = $1;
1271        }
1272    
1273        my $link;
1274        my $link_url;
1275        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"}
1276        elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1277        else{$link_url = "NO_URL"}
1278    
1279        $link = {"link_title" => $thing->acc,
1280                 "link" => $link_url};
1281        push(@$links_list,$link);
1282    
1283        my $element_hash = {
1284            "title" => $name_value,
1285            "start" => $thing->start,
1286            "end" =>  $thing->stop,
1287            "color"=> $color,
1288            "zlayer" => '2',
1289            "links_list" => $links_list,
1290            "description" => $descriptions};
1291    
1292        push(@$line_data,$element_hash);
1293        $gd->add_line($line_data, $line_config);
1294    
1295        return $gd;
1296    
1297    }
1298    
1299    sub display_table {
1300        my ($self,$dataset) = @_;
1301        my $cgi = new CGI;
1302        my $data = [];
1303        my $count = 0;
1304        my $content;
1305    
1306        foreach my $thing (@$dataset) {
1307            next if ($thing->type !~ /dom/);
1308            my $single_domain = [];
1309            $count++;
1310    
1311            my $db_and_id = $thing->acc;
1312            my ($db,$id) = split("::",$db_and_id);
1313    
1314            my $dbmaster = DBMaster->new(-database =>'Ontology',
1315                                    -host     => $WebConfig::DBHOST,
1316                                    -user     => $WebConfig::DBUSER,
1317                                    -password => $WebConfig::DBPWD);
1318    
1319            my ($name_title,$name_value,$description_title,$description_value);
1320            if($db eq "CDD"){
1321                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1322                if(!scalar(@$cdd_objs)){
1323                    $name_title = "name";
1324                    $name_value = "not available";
1325                    $description_title = "description";
1326                    $description_value = "not available";
1327                }
1328                else{
1329                    my $cdd_obj = $cdd_objs->[0];
1330                    $name_title = "name";
1331                    $name_value = $cdd_obj->term;
1332                    $description_title = "description";
1333                    $description_value = $cdd_obj->description;
1334                }
1335            }
1336            elsif($db =~ /PFAM/){
1337                my ($new_id) = ($id) =~ /(.*?)_/;
1338                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1339                if(!scalar(@$pfam_objs)){
1340                    $name_title = "name";
1341                    $name_value = "not available";
1342                    $description_title = "description";
1343                    $description_value = "not available";
1344                }
1345                else{
1346                    my $pfam_obj = $pfam_objs->[0];
1347                    $name_title = "name";
1348                    $name_value = $pfam_obj->term;
1349                    #$description_title = "description";
1350                    #$description_value = $pfam_obj->description;
1351                }
1352            }
1353    
1354            my $location =  $thing->start . " - " . $thing->stop;
1355    
1356            push(@$single_domain,$db);
1357            push(@$single_domain,$thing->acc);
1358            push(@$single_domain,$name_value);
1359            push(@$single_domain,$location);
1360            push(@$single_domain,$thing->evalue);
1361            push(@$single_domain,$description_value);
1362            push(@$data,$single_domain);
1363        }
1364    
1365        if ($count >0){
1366            $content = $data;
1367        }
1368        else
1369        {
1370            $content = "<p>This PEG does not have any similarities to domains</p>";
1371        }
1372    }
1373    
1374    
1375    #########################################
1376    #########################################
1377    package Observation::Location;
1378    
1379    use base qw(Observation);
1380    
1381    sub new {
1382    
1383        my ($class,$dataset) = @_;
1384        my $self = $class->SUPER::new($dataset);
1385        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1386        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1387        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1388        $self->{cello_location} = $dataset->{'cello_location'};
1389        $self->{cello_score} = $dataset->{'cello_score'};
1390        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1391        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1392        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1393        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1394    
1395        bless($self,$class);
1396        return $self;
1397    }
1398    
1399    sub display_cello {
1400        my ($thing) = @_;
1401        my $html;
1402        my $cello_location = $thing->cello_location;
1403        my $cello_score = $thing->cello_score;
1404        if($cello_location){
1405            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1406            #$html .= "<p>CELLO score: $cello_score </p>";
1407        }
1408        return ($html);
1409    }
1410    
1411    sub display {
1412        my ($thing,$gd,$fig) = @_;
1413    
1414        my $fid = $thing->fig_id;
1415        #my $fig= new FIG;
1416        my $length = length($fig->get_translation($fid));
1417    
1418        my $cleavage_prob;
1419        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1420        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1421        my $signal_peptide_score = $thing->signal_peptide_score;
1422        my $cello_location = $thing->cello_location;
1423        my $cello_score = $thing->cello_score;
1424        my $tmpred_score = $thing->tmpred_score;
1425        my @tmpred_locations = split(",",$thing->tmpred_locations);
1426    
1427        my $phobius_signal_location = $thing->phobius_signal_location;
1428        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1429    
1430        my $lines = [];
1431    
1432        #color is
1433        my $color = "6";
1434    
1435    =pod=
1436    
1437        if($cello_location){
1438            my $cello_descriptions = [];
1439            my $line_data =[];
1440    
1441            my $line_config = { 'title' => 'Localization Evidence',
1442                                'short_title' => 'CELLO',
1443                                'hover_title' => 'Localization',
1444                                'basepair_offset' => '1' };
1445    
1446            my $description_cello_location = {"title" => 'Best Cello Location',
1447                                              "value" => $cello_location};
1448    
1449            push(@$cello_descriptions,$description_cello_location);
1450    
1451            my $description_cello_score = {"title" => 'Cello Score',
1452                                           "value" => $cello_score};
1453    
1454            push(@$cello_descriptions,$description_cello_score);
1455    
1456            my $element_hash = {
1457                "title" => "CELLO",
1458                "color"=> $color,
1459                "start" => "1",
1460                "end" =>  $length + 1,
1461                "zlayer" => '1',
1462                "description" => $cello_descriptions};
1463    
1464            push(@$line_data,$element_hash);
1465            $gd->add_line($line_data, $line_config);
1466        }
1467    
1468        $color = "2";
1469        if($tmpred_score){
1470            my $line_data =[];
1471            my $line_config = { 'title' => 'Localization Evidence',
1472                                'short_title' => 'Transmembrane',
1473                                'basepair_offset' => '1' };
1474    
1475            foreach my $tmpred (@tmpred_locations){
1476                my $descriptions = [];
1477                my ($begin,$end) =split("-",$tmpred);
1478                my $description_tmpred_score = {"title" => 'TMPRED score',
1479                                 "value" => $tmpred_score};
1480    
1481                push(@$descriptions,$description_tmpred_score);
1482    
1483                my $element_hash = {
1484                "title" => "transmembrane location",
1485                "start" => $begin + 1,
1486                "end" =>  $end + 1,
1487                "color"=> $color,
1488                "zlayer" => '5',
1489                "type" => 'box',
1490                "description" => $descriptions};
1491    
1492                push(@$line_data,$element_hash);
1493    
1494            }
1495            $gd->add_line($line_data, $line_config);
1496        }
1497    =cut
1498    
1499        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1500            my $line_data =[];
1501            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1502                                'short_title' => 'TM and SP',
1503                                'hover_title' => 'Localization',
1504                                'basepair_offset' => '1' };
1505    
1506            foreach my $tm_loc (@phobius_tm_locations){
1507                my $descriptions = [];
1508                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1509                                 "value" => $tm_loc};
1510                push(@$descriptions,$description_phobius_tm_locations);
1511    
1512                my ($begin,$end) =split("-",$tm_loc);
1513    
1514                my $element_hash = {
1515                "title" => "Phobius",
1516                "start" => $begin + 1,
1517                "end" =>  $end + 1,
1518                "color"=> '6',
1519                "zlayer" => '4',
1520                "type" => 'bigbox',
1521                "description" => $descriptions};
1522    
1523                push(@$line_data,$element_hash);
1524    
1525            }
1526    
1527            if($phobius_signal_location){
1528                my $descriptions = [];
1529                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1530                                 "value" => $phobius_signal_location};
1531                push(@$descriptions,$description_phobius_signal_location);
1532    
1533    
1534                my ($begin,$end) =split("-",$phobius_signal_location);
1535                my $element_hash = {
1536                "title" => "phobius signal locations",
1537                "start" => $begin + 1,
1538                "end" =>  $end + 1,
1539                "color"=> '1',
1540                "zlayer" => '5',
1541                "type" => 'box',
1542                "description" => $descriptions};
1543                push(@$line_data,$element_hash);
1544            }
1545    
1546            $gd->add_line($line_data, $line_config);
1547        }
1548    
1549    =head3
1550        $color = "1";
1551        if($signal_peptide_score){
1552            my $line_data = [];
1553            my $descriptions = [];
1554    
1555            my $line_config = { 'title' => 'Localization Evidence',
1556                                'short_title' => 'SignalP',
1557                                'hover_title' => 'Localization',
1558                                'basepair_offset' => '1' };
1559    
1560            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1561                                                    "value" => $signal_peptide_score};
1562    
1563            push(@$descriptions,$description_signal_peptide_score);
1564    
1565            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1566                                             "value" => $cleavage_prob};
1567    
1568            push(@$descriptions,$description_cleavage_prob);
1569    
1570            my $element_hash = {
1571                "title" => "SignalP",
1572                "start" => $cleavage_loc_begin - 2,
1573                "end" =>  $cleavage_loc_end + 1,
1574                "type" => 'bigbox',
1575                "color"=> $color,
1576                "zlayer" => '10',
1577                "description" => $descriptions};
1578    
1579            push(@$line_data,$element_hash);
1580            $gd->add_line($line_data, $line_config);
1581        }
1582    =cut
1583    
1584        return ($gd);
1585    
1586    }
1587    
1588    sub cleavage_loc {
1589      my ($self) = @_;
1590    
1591      return $self->{cleavage_loc};
1592    }
1593    
1594    sub cleavage_prob {
1595      my ($self) = @_;
1596    
1597      return $self->{cleavage_prob};
1598    }
1599    
1600    sub signal_peptide_score {
1601      my ($self) = @_;
1602    
1603      return $self->{signal_peptide_score};
1604    }
1605    
1606    sub tmpred_score {
1607      my ($self) = @_;
1608    
1609      return $self->{tmpred_score};
1610    }
1611    
1612    sub tmpred_locations {
1613      my ($self) = @_;
1614    
1615      return $self->{tmpred_locations};
1616    }
1617    
1618    sub cello_location {
1619      my ($self) = @_;
1620    
1621      return $self->{cello_location};
1622    }
1623    
1624    sub cello_score {
1625      my ($self) = @_;
1626    
1627      return $self->{cello_score};
1628    }
1629    
1630    sub phobius_signal_location {
1631      my ($self) = @_;
1632      return $self->{phobius_signal_location};
1633    }
1634    
1635    sub phobius_tm_locations {
1636      my ($self) = @_;
1637      return $self->{phobius_tm_locations};
1638    }
1639    
1640    
1641    
1642    #########################################
1643    #########################################
1644    package Observation::Sims;
1645    
1646    use base qw(Observation);
1647    
1648    sub new {
1649    
1650        my ($class,$dataset) = @_;
1651        my $self = $class->SUPER::new($dataset);
1652        $self->{identity} = $dataset->{'identity'};
1653        $self->{acc} = $dataset->{'acc'};
1654        $self->{query} = $dataset->{'query'};
1655        $self->{evalue} = $dataset->{'evalue'};
1656        $self->{qstart} = $dataset->{'qstart'};
1657        $self->{qstop} = $dataset->{'qstop'};
1658        $self->{hstart} = $dataset->{'hstart'};
1659        $self->{hstop} = $dataset->{'hstop'};
1660        $self->{database} = $dataset->{'database'};
1661        $self->{organism} = $dataset->{'organism'};
1662        $self->{function} = $dataset->{'function'};
1663        $self->{qlength} = $dataset->{'qlength'};
1664        $self->{hlength} = $dataset->{'hlength'};
1665    
1666        bless($self,$class);
1667        return $self;
1668    }
1669    
1670    =head3 display()
1671    
1672    If available use the function specified here to display a graphical observation.
1673    This code will display a graphical view of the similarities using the genome drawer object
1674    
1675    =cut
1676    
1677    sub display {
1678        my ($self,$gd,$array,$fig) = @_;
1679        #my $fig = new FIG;
1680    
1681        my @ids;
1682        foreach my $thing(@$array){
1683            next if ($thing->class ne "SIM");
1684            push (@ids, $thing->acc);
1685        }
1686    
1687        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1688    
1689        my %sims_objects_evalue;
1690        my $count = 0;
1691        foreach my $thing (@$array){
1692            if ($thing->class eq "SIM"){
1693                $sims_objects_evalue{$count} = $thing->evalue;
1694            }
1695            $count++;
1696        }
1697    
1698        foreach my $index (sort {$sims_objects_evalue{$a}<=>$sims_objects_evalue{$b}} keys %sims_objects_evalue){
1699    #    foreach my $thing ( @$array){
1700            my $thing = $array->[$index];
1701            if ($thing->class eq "SIM"){
1702                my $peg = $thing->acc;
1703                my $query = $thing->query;
1704    
1705                my $organism = $thing->organism;
1706                my $genome = $fig->genome_of($peg);
1707                my ($org_tax) = ($genome) =~ /(.*)\./;
1708                my $function = $thing->function;
1709                my $abbrev_name = $fig->abbrev($organism);
1710                my $align_start = $thing->qstart;
1711                my $align_stop = $thing->qstop;
1712                my $hit_start = $thing->hstart;
1713                my $hit_stop = $thing->hstop;
1714    
1715                my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1716    
1717                my $line_config = { 'title' => "$organism [$org_tax]",
1718                                    'short_title' => "$abbrev_name",
1719                                    'title_link' => '$tax_link',
1720                                    'basepair_offset' => '0'
1721                                    };
1722    
1723                my $line_data = [];
1724    
1725                my $element_hash;
1726                my $links_list = [];
1727                my $descriptions = [];
1728    
1729                # get subsystem information
1730                my $url_link = "?page=Annotation&feature=".$peg;
1731                my $link;
1732                $link = {"link_title" => $peg,
1733                         "link" => $url_link};
1734                push(@$links_list,$link);
1735    
1736                #my @subsystems = $fig->peg_to_subsystems($peg);
1737                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1738                my @subsystems;
1739    
1740                foreach my $array (@subs){
1741                    my $subsystem = $$array[0];
1742                    push(@subsystems,$subsystem);
1743                    my $link;
1744                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1745                             "link_title" => $subsystem};
1746                    push(@$links_list,$link);
1747                }
1748    
1749                $link = {"link_title" => "view blast alignment",
1750                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1751                push (@$links_list,$link);
1752    
1753                my $description_function;
1754                $description_function = {"title" => "function",
1755                                         "value" => $function};
1756                push(@$descriptions,$description_function);
1757    
1758                my ($description_ss, $ss_string);
1759                $ss_string = join (",", @subsystems);
1760                $description_ss = {"title" => "subsystems",
1761                                   "value" => $ss_string};
1762                push(@$descriptions,$description_ss);
1763    
1764                my $description_loc;
1765                $description_loc = {"title" => "location start",
1766                                    "value" => $hit_start};
1767                push(@$descriptions, $description_loc);
1768    
1769                $description_loc = {"title" => "location stop",
1770                                    "value" => $hit_stop};
1771                push(@$descriptions, $description_loc);
1772    
1773                my $evalue = $thing->evalue;
1774                while ($evalue =~ /-0/)
1775                {
1776                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1777                    $chunk2 = substr($chunk2,1);
1778                    $evalue = $chunk1 . "-" . $chunk2;
1779                }
1780    
1781                my $color = &color($evalue);
1782    
1783                my $description_eval = {"title" => "E-Value",
1784                                        "value" => $evalue};
1785                push(@$descriptions, $description_eval);
1786    
1787                my $identity = $self->identity;
1788                my $description_identity = {"title" => "Identity",
1789                                            "value" => $identity};
1790                push(@$descriptions, $description_identity);
1791    
1792                $element_hash = {
1793                    "title" => $peg,
1794                    "start" => $align_start,
1795                    "end" =>  $align_stop,
1796                    "type"=> 'box',
1797                    "color"=> $color,
1798                    "zlayer" => "2",
1799                    "links_list" => $links_list,
1800                    "description" => $descriptions
1801                    };
1802                push(@$line_data,$element_hash);
1803                $gd->add_line($line_data, $line_config);
1804            }
1805        }
1806        return ($gd);
1807    }
1808    
1809    =head3 display_domain_composition()
1810    
1811    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
1812    
1813    =cut
1814    
1815    sub display_domain_composition {
1816        my ($self,$gd,$fig) = @_;
1817    
1818        #$fig = new FIG;
1819        my $peg = $self->acc;
1820    
1821        my $line_data = [];
1822        my $links_list = [];
1823        my $descriptions = [];
1824    
1825        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1826        #my @domain_query_results = ();
1827        foreach $dqr (@domain_query_results){
1828            my $key = @$dqr[1];
1829            my @parts = split("::",$key);
1830            my $db = $parts[0];
1831            my $id = $parts[1];
1832            my $val = @$dqr[2];
1833            my $from;
1834            my $to;
1835            my $evalue;
1836    
1837            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1838                my $raw_evalue = $1;
1839                $from = $2;
1840                $to = $3;
1841                if($raw_evalue =~/(\d+)\.(\d+)/){
1842                    my $part2 = 1000 - $1;
1843                    my $part1 = $2/100;
1844                    $evalue = $part1."e-".$part2;
1845                }
1846                else{
1847                    $evalue = "0.0";
1848                }
1849            }
1850    
1851            my $dbmaster = DBMaster->new(-database =>'Ontology',
1852                                    -host     => $WebConfig::DBHOST,
1853                                    -user     => $WebConfig::DBUSER,
1854                                    -password => $WebConfig::DBPWD);
1855            my ($name_value,$description_value);
1856    
1857            if($db eq "CDD"){
1858                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1859                if(!scalar(@$cdd_objs)){
1860                    $name_title = "name";
1861                    $name_value = "not available";
1862                    $description_title = "description";
1863                    $description_value = "not available";
1864                }
1865                else{
1866                    my $cdd_obj = $cdd_objs->[0];
1867                    $name_value = $cdd_obj->term;
1868                    $description_value = $cdd_obj->description;
1869                }
1870            }
1871    
1872            my $domain_name;
1873            $domain_name = {"title" => "name",
1874                            "value" => $name_value};
1875            push(@$descriptions,$domain_name);
1876    
1877            my $description;
1878            $description = {"title" => "description",
1879                            "value" => $description_value};
1880            push(@$descriptions,$description);
1881    
1882            my $score;
1883            $score = {"title" => "score",
1884                      "value" => $evalue};
1885            push(@$descriptions,$score);
1886    
1887            my $link_id = $id;
1888            my $link;
1889            my $link_url;
1890            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"}
1891            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1892            else{$link_url = "NO_URL"}
1893    
1894            $link = {"link_title" => $name_value,
1895                     "link" => $link_url};
1896            push(@$links_list,$link);
1897    
1898            my $domain_element_hash = {
1899                "title" => $peg,
1900                "start" => $from,
1901                "end" =>  $to,
1902                "type"=> 'box',
1903                "zlayer" => '4',
1904                "links_list" => $links_list,
1905                "description" => $descriptions
1906                };
1907    
1908            push(@$line_data,$domain_element_hash);
1909    
1910            #just one CDD domain for now, later will add option for multiple domains from selected DB
1911            last;
1912        }
1913    
1914        my $line_config = { 'title' => $peg,
1915                            'hover_title' => 'Domain',
1916                            'short_title' => $peg,
1917                            'basepair_offset' => '1' };
1918    
1919        $gd->add_line($line_data, $line_config);
1920    
1921        return ($gd);
1922    
1923    }
1924    
1925    =head3 display_table()
1926    
1927    If available use the function specified here to display the "raw" observation.
1928    This code will display a table for the similarities protein
1929    
1930    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.
1931    
1932    =cut
1933    
1934    sub display_table {
1935        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1936    
1937        my $data = [];
1938        my $count = 0;
1939        my $content;
1940        #my $fig = new FIG;
1941        my $cgi = new CGI;
1942        my @ids;
1943        $lineages = $fig->taxonomy_list();
1944    
1945        foreach my $thing (@$dataset) {
1946            next if ($thing->class ne "SIM");
1947            push (@ids, $thing->acc);
1948        }
1949    
1950        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1951        my @attributes = $fig->get_attributes(\@ids);
1952    
1953        # get the column for the subsystems
1954        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1955    
1956        # get the column for the evidence codes
1957        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1958    
1959        # get the column for pfam_domain
1960        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1961    
1962        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1963        my $alias_col = &get_aliases(\@ids,$fig);
1964        #my $alias_col = {};
1965    
1966        my $figfam_data = "$FIG_Config::FigfamsData";
1967        my $figfams = new FFs($figfam_data);
1968    #    my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1969    
1970        my %sims_objects_evalue;
1971        my $simcount = 0;
1972        foreach my $thing (@$dataset){
1973            if ($thing->class eq "SIM"){
1974                $sims_objects_evalue{$simcount} = $thing->evalue;
1975            }
1976            $simcount++;
1977        }
1978    
1979        foreach my $index (sort {$sims_objects_evalue{$a}<=>$sims_objects_evalue{$b}} keys %sims_objects_evalue){
1980    #    foreach my $thing ( @$dataset){
1981            my $thing = $dataset->[$index];
1982    
1983            next if ($thing->class ne "SIM");
1984            my $single_domain = [];
1985            $count++;
1986    
1987            my $id      = $thing->acc;
1988            my $taxid   = $fig->genome_of($id);
1989            my $iden    = $thing->identity;
1990            my $ln1     = $thing->qlength;
1991            my $ln2     = $thing->hlength;
1992            my $b1      = $thing->qstart;
1993            my $e1      = $thing->qstop;
1994            my $b2      = $thing->hstart;
1995            my $e2      = $thing->hstop;
1996            my $d1      = abs($e1 - $b1) + 1;
1997            my $d2      = abs($e2 - $b2) + 1;
1998            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1999            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
2000    
2001            # checkbox column
2002            my $field_name = "tables_" . $id;
2003            my $pair_name = "visual_" . $id;
2004            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2005            my ($tax) = ($id) =~ /fig\|(.*?)\./;
2006    
2007            # get the linked fig id
2008            my $fig_col;
2009            if (defined ($e_identical{$id})){
2010                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
2011            }
2012            else{
2013                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
2014            }
2015    
2016            push (@$single_domain, $box_col, $fig_col, $thing->evalue,
2017                  "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
2018    
2019            my ($ff) = $figfams->families_containing_peg($id);
2020    
2021            foreach my $col (sort keys %$scroll_list){
2022                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
2023                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2024                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2025                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
2026                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
2027                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
2028                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
2029                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
2030                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
2031                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
2032                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
2033                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
2034                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
2035                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2036                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2037                #elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2038                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");}
2039            }
2040            push(@$data,$single_domain);
2041        }
2042        if ($count >0 ){
2043            $content = $data;
2044        }
2045        else{
2046            $content = "<p>This PEG does not have any similarities</p>";
2047        }
2048        return ($content);
2049    }
2050    
2051    sub get_box_column{
2052        my ($ids) = @_;
2053        my %column;
2054        foreach my $id (@$ids){
2055            my $field_name = "tables_" . $id;
2056            my $pair_name = "visual_" . $id;
2057            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2058        }
2059        return (%column);
2060    }
2061    
2062    sub get_subsystems_column{
2063        my ($ids,$fig) = @_;
2064    
2065        #my $fig = new FIG;
2066        my $cgi = new CGI;
2067        my %in_subs  = $fig->subsystems_for_pegs($ids);
2068        my %column;
2069        foreach my $id (@$ids){
2070            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2071            my @subsystems;
2072    
2073            if (@in_sub > 0) {
2074                foreach my $array(@in_sub){
2075                    my $ss = $$array[0];
2076                    $ss =~ s/_/ /ig;
2077                    push (@subsystems, "-" . $ss);
2078                }
2079                my $in_sub_line = join ("<br>", @subsystems);
2080                $column{$id} = $in_sub_line;
2081            } else {
2082                $column{$id} = "&nbsp;";
2083            }
2084        }
2085        return (%column);
2086    }
2087    
2088    sub get_essentially_identical{
2089        my ($fid,$dataset,$fig) = @_;
2090        #my $fig = new FIG;
2091    
2092        my %id_list;
2093        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2094    
2095        foreach my $thing (@$dataset){
2096            if($thing->class eq "IDENTICAL"){
2097                my $rows = $thing->rows;
2098                my $count_identical = 0;
2099                foreach my $row (@$rows) {
2100                    my $id = $row->[0];
2101                    if (($id ne $fid) && ($fig->function_of($id))) {
2102                        $id_list{$id} = 1;
2103                    }
2104                }
2105            }
2106        }
2107    
2108    #    foreach my $id (@maps_to) {
2109    #        if (($id ne $fid) && ($fig->function_of($id))) {
2110    #           $id_list{$id} = 1;
2111    #        }
2112    #    }
2113        return(%id_list);
2114    }
2115    
2116    
2117    sub get_evidence_column{
2118        my ($ids, $attributes,$fig) = @_;
2119        #my $fig = new FIG;
2120        my $cgi = new CGI;
2121        my (%column, %code_attributes);
2122    
2123        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2124        foreach my $key (@codes){
2125            push (@{$code_attributes{$$key[0]}}, $key);
2126        }
2127    
2128        foreach my $id (@$ids){
2129            # add evidence code with tool tip
2130            my $ev_codes=" &nbsp; ";
2131    
2132            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2133            my @ev_codes = ();
2134            foreach my $code (@codes) {
2135                my $pretty_code = $code->[2];
2136                if ($pretty_code =~ /;/) {
2137                    my ($cd, $ss) = split(";", $code->[2]);
2138                    $ss =~ s/_/ /g;
2139                    $pretty_code = $cd;# . " in " . $ss;
2140                }
2141                push(@ev_codes, $pretty_code);
2142            }
2143    
2144            if (scalar(@ev_codes) && $ev_codes[0]) {
2145                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2146                $ev_codes = $cgi->a(
2147                                    {
2148                                        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));
2149            }
2150            $column{$id}=$ev_codes;
2151        }
2152        return (%column);
2153    }
2154    
2155    sub get_pfam_column{
2156        my ($ids, $attributes,$fig) = @_;
2157        #my $fig = new FIG;
2158        my $cgi = new CGI;
2159        my (%column, %code_attributes, %attribute_locations);
2160        my $dbmaster = DBMaster->new(-database =>'Ontology',
2161                                    -host     => $WebConfig::DBHOST,
2162                                    -user     => $WebConfig::DBUSER,
2163                                    -password => $WebConfig::DBPWD);
2164    
2165        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2166        foreach my $key (@codes){
2167            my $name = $key->[1];
2168            if ($name =~ /_/){
2169                ($name) = ($key->[1]) =~ /(.*?)_/;
2170            }
2171            push (@{$code_attributes{$key->[0]}}, $name);
2172            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2173        }
2174    
2175        foreach my $id (@$ids){
2176            # add evidence code
2177            my $pfam_codes=" &nbsp; ";
2178            my @pfam_codes = "";
2179            my %description_codes;
2180    
2181            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2182                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2183                @pfam_codes = ();
2184    
2185                # get only unique values
2186                my %saw;
2187                foreach my $key (@ncodes) {$saw{$key}=1;}
2188                @ncodes = keys %saw;
2189    
2190                foreach my $code (@ncodes) {
2191                    my @parts = split("::",$code);
2192                    my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2193    
2194                    # get the locations for the domain
2195                    my @locs;
2196                    foreach my $part (@{$attribute_location{$id}{$code}}){
2197                        my ($loc) = ($part) =~ /\;(.*)/;
2198                        push (@locs,$loc);
2199                    }
2200                    my %locsaw;
2201                    foreach my $key (@locs) {$locsaw{$key}=1;}
2202                    @locs = keys %locsaw;
2203    
2204                    my $locations = join (", ", @locs);
2205    
2206                    if (defined ($description_codes{$parts[1]})){
2207                        push(@pfam_codes, "$parts[1] ($locations)");
2208                    }
2209                    else {
2210                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2211                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2212                        push(@pfam_codes, "$pfam_link ($locations)");
2213                    }
2214                }
2215            }
2216    
2217            $column{$id}=join("<br><br>", @pfam_codes);
2218        }
2219        return (%column);
2220    
2221    }
2222    
2223    sub get_aliases {
2224        my ($ids,$fig) = @_;
2225    
2226        my $all_aliases = $fig->feature_aliases_bulk($ids);
2227        foreach my $id (@$ids){
2228            foreach my $alias (@{$$all_aliases{$id}}){
2229                my $id_db = &Observation::get_database($alias);
2230                next if ($aliases->{$id}->{$id_db});
2231                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2232            }
2233        }
2234        return ($aliases);
2235    }
2236    
2237    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2238    
2239    sub color {
2240        my ($evalue) = @_;
2241        my $palette = WebColors::get_palette('vitamins');
2242        my $color;
2243        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2244        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2245        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2246        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2247        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2248        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2249        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2250        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2251        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2252        else{        $color = $palette->[9];    }
2253        return ($color);
2254    }
2255    
2256    
2257    ############################
2258    package Observation::Cluster;
2259    
2260    use base qw(Observation);
2261    
2262    sub new {
2263    
2264        my ($class,$dataset) = @_;
2265        my $self = $class->SUPER::new($dataset);
2266        $self->{context} = $dataset->{'context'};
2267        bless($self,$class);
2268        return $self;
2269    }
2270    
2271    sub display {
2272        my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2273    
2274        $taxes = $fig->taxonomy_list();
2275    
2276        my $fid = $self->fig_id;
2277        my $compare_or_coupling = $self->context;
2278        my $gd_window_size = $gd->window_size;
2279        my $range = $gd_window_size;
2280        my $all_regions = [];
2281        my $gene_associations={};
2282    
2283        #get the organism genome
2284        my $target_genome = $fig->genome_of($fid);
2285        $gene_associations->{$fid}->{"organism"} = $target_genome;
2286        $gene_associations->{$fid}->{"main_gene"} = $fid;
2287        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2288    
2289        # get location of the gene
2290        my $data = $fig->feature_location($fid);
2291        my ($contig, $beg, $end);
2292        my %reverse_flag;
2293    
2294        if ($data =~ /(.*)_(\d+)_(\d+)$/){
2295            $contig = $1;
2296            $beg = $2;
2297            $end = $3;
2298        }
2299    
2300        my $offset;
2301        my ($region_start, $region_end);
2302        if ($beg < $end)
2303        {
2304            $region_start = $beg - ($range);
2305            $region_end = $end+ ($range);
2306            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2307        }
2308        else
2309        {
2310            $region_start = $end-($range);
2311            $region_end = $beg+($range);
2312            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2313            $reverse_flag{$target_genome} = $fid;
2314            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2315        }
2316    
2317        # call genes in region
2318        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2319        #foreach my $feat (@$target_gene_features){
2320        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2321        #}
2322        push(@$all_regions,$target_gene_features);
2323        my (@start_array_region);
2324        push (@start_array_region, $offset);
2325    
2326        my %all_genes;
2327        my %all_genomes;
2328        foreach my $feature (@$target_gene_features){
2329            #if ($feature =~ /peg/){
2330                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2331            #}
2332        }
2333    
2334        my @selected_sims;
2335    
2336        if ($compare_or_coupling eq "sims"){
2337            # get the selected boxes
2338            my @selected_taxonomy = @$selected_taxonomies;
2339    
2340            # get the similarities and store only the ones that match the lineages selected
2341            if (@selected_taxonomy > 0){
2342                foreach my $sim (@$sims_array){
2343                    next if ($sim->class ne "SIM");
2344                    next if ($sim->acc !~ /fig\|/);
2345    
2346                    #my $genome = $fig->genome_of($sim->[1]);
2347                    my $genome = $fig->genome_of($sim->acc);
2348                    #my ($genome1) = ($genome) =~ /(.*)\./;
2349                    my $lineage = $taxes->{$genome};
2350                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2351                    foreach my $taxon(@selected_taxonomy){
2352                        if ($lineage =~ /$taxon/){
2353                            #push (@selected_sims, $sim->[1]);
2354                            push (@selected_sims, $sim->acc);
2355                        }
2356                    }
2357                }
2358            }
2359            else{
2360                my $simcount = 0;
2361                foreach my $sim (@$sims_array){
2362                    next if ($sim->class ne "SIM");
2363                    next if ($sim->acc !~ /fig\|/);
2364    
2365                    push (@selected_sims, $sim->acc);
2366                    $simcount++;
2367                    last if ($simcount > 4);
2368                }
2369            }
2370    
2371            my %saw;
2372            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2373    
2374            # get the gene context for the sorted matches
2375            foreach my $sim_fid(@selected_sims){
2376                #get the organism genome
2377                my $sim_genome = $fig->genome_of($sim_fid);
2378                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2379                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2380                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2381    
2382                # get location of the gene
2383                my $data = $fig->feature_location($sim_fid);
2384                my ($contig, $beg, $end);
2385    
2386                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2387                    $contig = $1;
2388                    $beg = $2;
2389                    $end = $3;
2390                }
2391    
2392                my $offset;
2393                my ($region_start, $region_end);
2394                if ($beg < $end)
2395                {
2396                    $region_start = $beg - ($range/2);
2397                    $region_end = $end+($range/2);
2398                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2399                }
2400                else
2401                {
2402                    $region_start = $end-($range/2);
2403                    $region_end = $beg+($range/2);
2404                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2405                    $reverse_flag{$sim_genome} = $sim_fid;
2406                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2407                }
2408    
2409                # call genes in region
2410                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2411                push(@$all_regions,$sim_gene_features);
2412                push (@start_array_region, $offset);
2413                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2414                $all_genomes{$sim_genome} = 1;
2415            }
2416    
2417        }
2418    
2419        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2420        # cluster the genes
2421        my @all_pegs = keys %all_genes;
2422        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2423        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2424        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2425    
2426        foreach my $region (@$all_regions){
2427            my $sample_peg = @$region[0];
2428            my $region_genome = $fig->genome_of($sample_peg);
2429            my $region_gs = $fig->genus_species($region_genome);
2430            my $abbrev_name = $fig->abbrev($region_gs);
2431            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2432            my $lineage = $taxes->{$region_genome};
2433            #my $lineage = $fig->taxonomy_of($region_genome);
2434            #$region_gs .= "Lineage:$lineage";
2435            my $line_config = { 'title' => $region_gs,
2436                                'short_title' => $abbrev_name,
2437                                'basepair_offset' => '0'
2438                                };
2439    
2440            my $offsetting = shift @start_array_region;
2441    
2442            my $second_line_config = { 'title' => "$lineage",
2443                                       'short_title' => "",
2444                                       'basepair_offset' => '0',
2445                                       'no_middle_line' => '1'
2446                                       };
2447    
2448            my $line_data = [];
2449            my $second_line_data = [];
2450    
2451            # initialize variables to check for overlap in genes
2452            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2453            my $major_line_flag = 0;
2454            my $prev_second_flag = 0;
2455    
2456            foreach my $fid1 (@$region){
2457                $second_line_flag = 0;
2458                my $element_hash;
2459                my $links_list = [];
2460                my $descriptions = [];
2461    
2462                my $color = $color_sets->{$fid1};
2463    
2464                # get subsystem information
2465                my $function = $fig->function_of($fid1);
2466                my $url_link = "?page=Annotation&feature=".$fid1;
2467    
2468                my $link;
2469                $link = {"link_title" => $fid1,
2470                         "link" => $url_link};
2471                push(@$links_list,$link);
2472    
2473                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2474                my @subsystems;
2475                foreach my $array (@subs){
2476                    my $subsystem = $$array[0];
2477                    my $ss = $subsystem;
2478                    $ss =~ s/_/ /ig;
2479                    push (@subsystems, $ss);
2480                    my $link;
2481                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2482                             "link_title" => $ss};
2483                    push(@$links_list,$link);
2484                }
2485    
2486                if ($fid1 eq $fid){
2487                    my $link;
2488                    $link = {"link_title" => "Annotate this sequence",
2489                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2490                    push (@$links_list,$link);
2491                }
2492    
2493                my $description_function;
2494                $description_function = {"title" => "function",
2495                                         "value" => $function};
2496                push(@$descriptions,$description_function);
2497    
2498                my $description_ss;
2499                my $ss_string = join (", ", @subsystems);
2500                $description_ss = {"title" => "subsystems",
2501                                   "value" => $ss_string};
2502                push(@$descriptions,$description_ss);
2503    
2504    
2505                my $fid_location = $fig->feature_location($fid1);
2506                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2507                    my($start,$stop);
2508                    $start = $2 - $offsetting;
2509                    $stop = $3 - $offsetting;
2510    
2511                    if ( (($prev_start) && ($prev_stop) ) &&
2512                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2513                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2514                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2515                            $second_line_flag = 1;
2516                            $major_line_flag = 1;
2517                        }
2518                    }
2519                    $prev_start = $start;
2520                    $prev_stop = $stop;
2521                    $prev_fig = $fid1;
2522    
2523                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2524                        $start = $gd_window_size - $start;
2525                        $stop = $gd_window_size - $stop;
2526                    }
2527    
2528                    my $title = $fid1;
2529                    if ($fid1 eq $fid){
2530                        $title = "My query gene: $fid1";
2531                    }
2532    
2533                    $element_hash = {
2534                        "title" => $title,
2535                        "start" => $start,
2536                        "end" =>  $stop,
2537                        "type"=> 'arrow',
2538                        "color"=> $color,
2539                        "zlayer" => "2",
2540                        "links_list" => $links_list,
2541                        "description" => $descriptions
2542                    };
2543    
2544                    # if there is an overlap, put into second line
2545                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2546                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2547    
2548                    if ($fid1 eq $fid){
2549                        $element_hash = {
2550                            "title" => 'Query',
2551                            "start" => $start,
2552                            "end" =>  $stop,
2553                            "type"=> 'bigbox',
2554                            "color"=> $color,
2555                            "zlayer" => "1"
2556                            };
2557    
2558                        # if there is an overlap, put into second line
2559                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2560                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2561                    }
2562                }
2563            }
2564            $gd->add_line($line_data, $line_config);
2565            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2566        }
2567        return ($gd, \@selected_sims);
2568    }
2569    
2570    sub cluster_genes {
2571        my($fig,$all_pegs,$peg) = @_;
2572        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2573    
2574        my @color_sets = ();
2575    
2576        $conn = &get_connections_by_similarity($fig,$all_pegs);
2577    
2578        for ($i=0; ($i < @$all_pegs); $i++) {
2579            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2580            if (! $seen{$i}) {
2581                $cluster = [$i];
2582                $seen{$i} = 1;
2583                for ($j=0; ($j < @$cluster); $j++) {
2584                    $x = $conn->{$cluster->[$j]};
2585                    foreach $k (@$x) {
2586                        if (! $seen{$k}) {
2587                            push(@$cluster,$k);
2588                            $seen{$k} = 1;
2589                        }
2590                    }
2591                }
2592    
2593                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2594                    push(@color_sets,$cluster);
2595                }
2596            }
2597        }
2598        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2599        $red_set = $color_sets[$i];
2600        splice(@color_sets,$i,1);
2601        @color_sets = sort { @$b <=> @$a } @color_sets;
2602        unshift(@color_sets,$red_set);
2603    
2604        my $color_sets = {};
2605        for ($i=0; ($i < @color_sets); $i++) {
2606            foreach $x (@{$color_sets[$i]}) {
2607                $color_sets->{$all_pegs->[$x]} = $i;
2608            }
2609        }
2610        return $color_sets;
2611    }
2612    
2613    sub get_connections_by_similarity {
2614        my($fig,$all_pegs) = @_;
2615        my($i,$j,$tmp,$peg,%pos_of);
2616        my($sim,%conn,$x,$y);
2617    
2618        for ($i=0; ($i < @$all_pegs); $i++) {
2619            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2620            push(@{$pos_of{$tmp}},$i);
2621            if ($tmp ne $all_pegs->[$i]) {
2622                push(@{$pos_of{$all_pegs->[$i]}},$i);
2623            }
2624        }
2625    
2626        foreach $y (keys(%pos_of)) {
2627            $x = $pos_of{$y};
2628            for ($i=0; ($i < @$x); $i++) {
2629                for ($j=$i+1; ($j < @$x); $j++) {
2630                    push(@{$conn{$x->[$i]}},$x->[$j]);
2631                    push(@{$conn{$x->[$j]}},$x->[$i]);
2632                }
2633            }
2634        }
2635    
2636        for ($i=0; ($i < @$all_pegs); $i++) {
2637            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2638                if (defined($x = $pos_of{$sim->id2})) {
2639                    foreach $y (@$x) {
2640                        push(@{$conn{$i}},$y);
2641                    }
2642                }
2643            }
2644        }
2645        return \%conn;
2646    }
2647    
2648    sub in {
2649        my($x,$xL) = @_;
2650        my($i);
2651    
2652        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2653        return ($i < @$xL);
2654    }
2655    
2656    #############################################
2657    #############################################
2658    package Observation::Commentary;
2659    
2660    use base qw(Observation);
2661    
2662    =head3 display_protein_commentary()
2663    
2664    =cut
2665    
2666    sub display_protein_commentary {
2667        my ($self,$dataset,$mypeg,$fig) = @_;
2668    
2669        my $all_rows = [];
2670        my $content;
2671        #my $fig = new FIG;
2672        my $cgi = new CGI;
2673        my $count = 0;
2674        my $peg_array = [];
2675        my (%evidence_column, %subsystems_column,  %e_identical);
2676    
2677        if (@$dataset != 1){
2678            foreach my $thing (@$dataset){
2679                if ($thing->class eq "SIM"){
2680                    push (@$peg_array, $thing->acc);
2681                }
2682            }
2683            # get the column for the evidence codes
2684            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2685    
2686            # get the column for the subsystems
2687            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2688    
2689            # get essentially identical seqs
2690            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2691        }
2692        else{
2693            push (@$peg_array, @$dataset);
2694        }
2695    
2696        my $selected_sims = [];
2697        foreach my $id (@$peg_array){
2698            last if ($count > 10);
2699            my $row_data = [];
2700            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2701            $org = $fig->org_of($id);
2702            $function = $fig->function_of($id);
2703            if ($mypeg ne $id){
2704                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2705                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2706                if (defined($e_identical{$id})) { $id_cell .= "*";}
2707            }
2708            else{
2709                $function_cell = "&nbsp;&nbsp;$function";
2710                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2711                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2712            }
2713    
2714            push(@$row_data,$id_cell);
2715            push(@$row_data,$org);
2716            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2717            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2718            push(@$row_data, $fig->translation_length($id));
2719            push(@$row_data,$function_cell);
2720            push(@$all_rows,$row_data);
2721            push (@$selected_sims, $id);
2722            $count++;
2723        }
2724    
2725        if ($count >0){
2726            $content = $all_rows;
2727        }
2728        else{
2729            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2730        }
2731        return ($content,$selected_sims);
2732    }
2733    
2734    sub display_protein_history {
2735        my ($self, $id,$fig) = @_;
2736        my $all_rows = [];
2737        my $content;
2738    
2739        my $cgi = new CGI;
2740        my $count = 0;
2741        foreach my $feat ($fig->feature_annotations($id)){
2742            my $row = [];
2743            my $col1 = $feat->[2];
2744            my $col2 = $feat->[1];
2745            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2746            my $text = $feat->[3];
2747    
2748            push (@$row, $col1);
2749            push (@$row, $col2);
2750            push (@$row, $text);
2751            push (@$all_rows, $row);
2752            $count++;
2753        }
2754        if ($count > 0){
2755            $content = $all_rows;
2756        }
2757        else {
2758            $content = "There is no history for this PEG";
2759        }
2760    
2761        return($content);
2762    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3