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

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.41

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3