[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.10, Wed Jun 20 20:55:36 2007 UTC revision 1.36, Thu Aug 30 02:42: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 warnings;
13  use HTML;  use HTML;
14    
15  1;  1;
# 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 66  Line 50 
50    
51  The public methods this package provides are listed below:  The public methods this package provides are listed below:
52    
 =head3 acc()  
53    
54  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.  =head3 context()
55    
56    Returns close or diverse for purposes of displaying genomic context
57    
58  =cut  =cut
59    
60  sub acc {  sub context {
61    my ($self) = @_;    my ($self) = @_;
62    
63    return $self->{acc};    return $self->{context};
64  }  }
65    
66  =head3 description()  =head3 rows()
67    
68  The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  each row in a displayed table
   
 B<Please note:>  
 Either remoteid or description is required.  
69    
70  =cut  =cut
71    
72  sub description {  sub rows {
73    my ($self) = @_;    my ($self) = @_;
74    
75    return $self->{description};    return $self->{rows};
76    }
77    
78    =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.
81    
82    =cut
83    
84    sub acc {
85      my ($self) = @_;
86      return $self->{acc};
87  }  }
88    
89  =head3 class()  =head3 class()
# Line 118  Line 111 
111    
112  =item PFAM (dom)  =item PFAM (dom)
113    
114  =item SIGNALP (dom)  =item SIGNALP_CELLO_TMPRED (loc)
115    
116  =item  CELLO(loc)  =item PDB (seq)
117    
118  =item TMHMM (loc)  =item TMHMM (loc)
119    
# Line 159  Line 152 
152  sub type {  sub type {
153    my ($self) = @_;    my ($self) = @_;
154    
155    return $self->{acc};    return $self->{type};
156  }  }
157    
158  =head3 start()  =head3 start()
# Line 186  Line 179 
179    return $self->{stop};    return $self->{stop};
180  }  }
181    
182  =head3 evalue()  =head3 start()
183    
184  E-value or P-Value if present.  Start of hit in query sequence.
185    
186  =cut  =cut
187    
188  sub evalue {  sub qstart {
189    my ($self) = @_;    my ($self) = @_;
190    
191    return $self->{evalue};      return $self->{qstart};
192  }  }
193    
194  =head3 score()  =head3 qstop()
   
 Score if present.  
195    
196  B<Please note: >  End of the hit in query sequence.
 Either score or eval are required.  
197    
198  =cut  =cut
199    
200  sub score {  sub qstop {
201    my ($self) = @_;    my ($self) = @_;
202    return $self->{score};  
203        return $self->{qstop};
204  }  }
205    
206    =head3 hstart()
207    
208  =head3 display_method()  Start of hit in hit sequence.
209    
210  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".  
211    
212  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 {
213        my ($self) = @_;
214    
215  =cut      return $self->{hstart};
216    }
217    
218  sub display {  =head3 end()
219    
220    die "Abstract Method Called\n";  End of the hit in hit sequence.
221    
222  }  =cut
223    
224    sub hstop {
225        my ($self) = @_;
226    
227  =head3 rank()      return $self->{hstop};
228    }
229    
230  Returns an integer from 1 - 10 indicating the importance of this observations.  =head3 qlength()
231    
232  Currently always returns 1.  length of the query sequence in similarities
233    
234  =cut  =cut
235    
236  sub rank {  sub qlength {
237    my ($self) = @_;    my ($self) = @_;
238    
239  #  return $self->{rank};      return $self->{qlength};
   
   return 1;  
240  }  }
241    
242  =head3 supports_annotation()  =head3 hlength()
243    
244  Does a this observation support the annotation of its feature?  length of the hit sequence in similarities
245    
246  Returns  =cut
   
 =over 3  
247    
248  =item 10, if feature annotation is identical to $self->description  sub hlength {
249        my ($self) = @_;
250    
251  =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()      return $self->{hlength};
252    }
253    
254  =item undef  =head3 evalue()
255    
256  =back  E-value or P-Value if present.
257    
258  =cut  =cut
259    
260  sub supports_annotation {  sub evalue {
261    my ($self) = @_;    my ($self) = @_;
262    
263    # no code here so far    return $self->{evalue};
   
   return $self->{supports_annotation};  
264  }  }
265    
266  =head3 url()  =head3 score()
267    
268  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.
269    
270  =cut  =cut
271    
272  sub url {  sub score {
273    my ($self) = @_;    my ($self) = @_;
274      return $self->{score};
275    }
276    
277    =head3 display()
278    
279    will be different for each type
280    
281    =cut
282    
283    my $url = get_url($self->type, $self->acc);  sub display {
284    
285      die "Abstract Method Called\n";
286    
   return $url;  
287  }  }
288    
289  =head3 get_objects()  =head3 display_table()
290    
291  This is the B<REAL WORKHORSE> method of this Package.  will be different for each type
292    
293    =cut
294    
295    sub display_table {
296    
297  It will probably have to:    die "Abstract Table Method Called\n";
298    
 - 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;  
299   }   }
300    
301  It will invoke the required calls to the SEED API to retrieve the information required.  =head3 get_objects()
302    
303    This is the B<REAL WORKHORSE> method of this Package.
304    
305  =cut  =cut
306    
307  sub get_objects {  sub get_objects {
308      my ($self,$fid,$classes) = @_;      my ($self,$fid,$scope) = @_;
   
309    
310      my $objects = [];      my $objects = [];
311      my @matched_datasets=();      my @matched_datasets=();
312        my $fig = new FIG;
313    
314      # call function that fetches attribute based observations      # call function that fetches attribute based observations
315      # returns an array of arrays of hashes      # returns an array of arrays of hashes
316    
317      if(scalar(@$classes) < 1){      if($scope){
318          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);  
319      }      }
320      else{      else{
         #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based  
321          my %domain_classes;          my %domain_classes;
322          my $identical_flag=0;          my @attributes = $fig->get_attributes($fid);
323          my $pch_flag=0;          $domain_classes{'CDD'} = 1;
         my $sims_flag=0;  
         foreach my $class (@$classes){  
             if($class =~ /(IPR|CDD|PFAM)/){  
                 $domain_classes{$class} = 1;  
             }  
             elsif ($class eq "IDENTICAL")  
             {  
                 $identical_flag = 1;  
             }  
             elsif ($class eq "PCH")  
             {  
                 $pch_flag = 1;  
             }  
             elsif ($class eq "SIM")  
             {  
                 $sims_flag = 1;  
             }  
         }  
   
         if ($identical_flag ==1)  
         {  
324              get_identical_proteins($fid,\@matched_datasets);              get_identical_proteins($fid,\@matched_datasets);
325          }          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);
         if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {  
             get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);  
         }  
         if ($pch_flag == 1)  
         {  
             get_functional_coupling($fid,\@matched_datasets);  
         }  
         if ($sims_flag == 1)  
         {  
326              get_sims_observations($fid,\@matched_datasets);              get_sims_observations($fid,\@matched_datasets);
327          }          get_functional_coupling($fid,\@matched_datasets);
328            get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);
329          #add CELLO and SignalP later          get_pdb_observations($fid,\@matched_datasets,\@attributes);
330      }      }
331    
332      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 390  Line 340 
340          if ($dataset->{'class'} eq "IDENTICAL"){          if ($dataset->{'class'} eq "IDENTICAL"){
341              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
342          }          }
343            if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
344                $object = Observation::Location->new($dataset);
345            }
346          if ($dataset->{'class'} eq "SIM"){          if ($dataset->{'class'} eq "SIM"){
347              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
348          }          }
349            if ($dataset->{'class'} eq "CLUSTER"){
350                $object = Observation::Cluster->new($dataset);
351            }
352            if ($dataset->{'class'} eq "PDB"){
353                $object = Observation::PDB->new($dataset);
354            }
355    
356          push (@$objects, $object);          push (@$objects, $object);
357      }      }
358    
# Line 400  Line 360 
360    
361  }  }
362    
363  =head1 Internal Methods  =head3 display_housekeeping
364    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!>  
365    
366  =cut  =cut
367    sub display_housekeeping {
368        my ($self,$fid) = @_;
369        my $fig = new FIG;
370        my $content;
371    
372        my $org_name = $fig->org_of($fid);
373        my $org_id   = $fig->orgid_of_orgname($org_name);
374        my $loc      = $fig->feature_location($fid);
375        my($contig, $beg, $end) = $fig->boundaries_of($loc);
376        my $strand   = ($beg <= $end)? '+' : '-';
377        my @subsystems = $fig->subsystems_for_peg($fid);
378        my $function = $fig->function_of($fid);
379        my @aliases  = $fig->feature_aliases($fid);
380        my $taxonomy = $fig->taxonomy_of($org_id);
381        my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);
382    
383  =head3 get_url (internal)      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);
384        $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
385  get_url() return a valid URL or undef for any observation.      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);
386        $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
387  URLs are constructed by looking at the Accession acc()  and  name()      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);
388        $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;
389  Info from both attributes is combined with a table of base URLs stored in this function.      $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
390        if ( @ecs ) {
391            $content .= qq(<tr><td>EC:</td><td>);
392            foreach my $ec ( @ecs ) {
393                my $ec_name = $fig->ec_name($ec);
394                $content .= join(" -- ", $ec, $ec_name) . "<br>\n";
395            }
396            $content .= qq(</td></tr>\n);
397        }
398    
399  =cut      if ( @subsystems ) {
400            $content .= qq(<tr><td>Subsystems</td><td>);
401            foreach my $subsystem ( @subsystems ) {
402                $content .= join(" -- ", @$subsystem) . "<br>\n";
403            }
404        }
405    
406  sub get_url {      my %groups;
407        if ( @aliases ) {
408            # get the db for each alias
409            foreach my $alias (@aliases){
410                $groups{$alias} = &get_database($alias);
411            }
412    
413   my ($self) = @_;          # group ids by aliases
414   my $url='';          my %db_aliases;
415            foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){
416                push (@{$db_aliases{$groups{$key}}}, $key);
417            }
418    
 # 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}) {          $content .= qq(<tr><td>Aliases</td><td><table border="0">);
421  #     $url = $URL{$self->name}.$self->acc;          foreach my $key (sort keys %db_aliases){
422  #     return $url;              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);
423  # }          }
424  # else          $content .= qq(</td></tr></table>\n);
      return undef;  
425  }  }
426    
427  =head3 get_display_method (internal)      $content .= qq(</table><p>\n);
428    
429  get_display_method() return a valid URL or undef for any observation.      return ($content);
430    }
431    
432  URLs are constructed by looking at the Accession acc()  and  name()  =head3 get_sims_summary
433  and Info from both attributes is combined with a table of base URLs stored in this function.  This method uses as input the similarities of a peg and creates a tree view of their taxonomy
434    
435  =cut  =cut
436    
437  sub get_display_method {  sub get_sims_summary {
438        my ($observation, $fid) = @_;
439        my $fig = new FIG;
440        my %families;
441        my @sims= $fig->nsims($fid,20000,10,"all");
442    
443   my ($self) = @_;      foreach my $sim (@sims){
444            next if ($sim->[1] !~ /fig\|/);
445            my $genome = $fig->genome_of($sim->[1]);
446            my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));
447            my $parent_tax = "Root";
448            foreach my $tax (split(/\; /, $taxonomy)){
449                push (@{$families{children}{$parent_tax}}, $tax);
450                $families{parent}{$tax} = $parent_tax;
451                $parent_tax = $tax;
452            }
453        }
454    
455  # a hash with a URL for each observation; identified by name()      foreach my $key (keys %{$families{children}}){
456  #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\          $families{count}{$key} = @{$families{children}{$key}};
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
457    
458  #if (defined $URL{$self->name}) {          my %saw;
459  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
460  #     return $url;          $families{children}{$key} = \@out;
461  # }      }
462  # else      return (\%families);
      return undef;  
463  }  }
464    
465    =head1 Internal Methods
466    
467    These methods are not meant to be used outside of this package.
468    
469    B<Please do not use them outside of this package!>
470    
471    =cut
472    
473  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
474    
475      # 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)
476      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);
477    
478      my $fig = new FIG;      my $fig = new FIG;
479    
480      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
481    #    foreach my $attr_ref ($fig->get_attributes($fid)) {
482          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
483          my @parts = split("::",$key);          my @parts = split("::",$key);
484          my $class = $parts[0];          my $class = $parts[0];
# Line 502  Line 504 
504                                 'type' => "dom" ,                                 'type' => "dom" ,
505                                 'evalue' => $evalue,                                 'evalue' => $evalue,
506                                 'start' => $from,                                 'start' => $from,
507                                 'stop' => $to                                 'stop' => $to,
508                                   'fig_id' => $fid,
509                                   'score' => $raw_evalue
510                                 };                                 };
511    
512                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 511  Line 515 
515      }      }
516  }  }
517    
518  =head3 get_attribute_based_evidence (internal)  sub get_attribute_based_location_observations{
   
 This method retrieves evidence from the attribute server  
519    
520  =cut      my ($fid,$datasets_ref, $attributes_ref) = (@_);
521        my $fig = new FIG;
522    
523  sub get_attribute_based_observations{      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
524    
525      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      my $dataset = {'type' => "loc",
526      my ($fid,$datasets_ref) = (@_);                     'class' => 'SIGNALP_CELLO_TMPRED',
527                       'fig_id' => $fid
528                       };
529    
530      my $_myfig = new FIG;      foreach my $attr_ref (@$attributes_ref){
531    #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
532            my $key = @$attr_ref[1];
533            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
534            my @parts = split("::",$key);
535            my $sub_class = $parts[0];
536            my $sub_key = $parts[1];
537            my $value = @$attr_ref[2];
538            if($sub_class eq "SignalP"){
539                if($sub_key eq "cleavage_site"){
540                    my @value_parts = split(";",$value);
541                    $dataset->{'cleavage_prob'} = $value_parts[0];
542                    $dataset->{'cleavage_loc'} = $value_parts[1];
543    #               print STDERR "LOC: $value_parts[1]";
544                }
545                elsif($sub_key eq "signal_peptide"){
546                    $dataset->{'signal_peptide_score'} = $value;
547                }
548            }
549    
550      foreach my $attr_ref ($_myfig->get_attributes($fid)) {          elsif($sub_class eq "CELLO"){
551                $dataset->{'cello_location'} = $sub_key;
552                $dataset->{'cello_score'} = $value;
553            }
554    
555          # convert the ref into a string for easier handling          elsif($sub_class eq "Phobius"){
556          my ($string) = "@$attr_ref";              if($sub_key eq "transmembrane"){
557                    $dataset->{'phobius_tm_locations'} = $value;
558                }
559                elsif($sub_key eq "signal"){
560                    $dataset->{'phobius_signal_location'} = $value;
561                }
562            }
563    
564  #       print "S:$string\n";          elsif($sub_class eq "TMPRED"){
565          my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);              my @value_parts = split(/\;/,$value);
566                $dataset->{'tmpred_score'} = $value_parts[0];
567                $dataset->{'tmpred_locations'} = $value_parts[1];
568            }
569        }
570    
571          # THIS SHOULD BE DONE ANOTHER WAY FM->TD      push (@{$datasets_ref} ,$dataset);
         # 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  
         #  
572    
573          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  }
574    
575              # some keys are composite CDD::1233244 or PFAM:PF1233  =head3 get_pdb_observations() (internal)
576    
577              if ( $key =~ /::/ ) {  This methods sets the type and class for pdb observations
                 my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);  
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
             }  
578    
579              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );  =cut
580    
581              my $evalue= 255;  sub get_pdb_observations{
582              if (defined $raw_evalue) { # some of the tool do not give us an evalue      my ($fid,$datasets_ref, $attributes_ref) = (@_);
583    
584                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);      my $fig = new FIG;
                 my ($new_k, $new_exp);  
585    
586                  #      foreach my $attr_ref (@$attributes_ref){
587                  #  THIS DOES NOT WORK PROPERLY      #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
588    
589  #                   $new_exp = (1000+$expo);          my $key = @$attr_ref[1];
590          #           $new_k = $k / 100;          next if ( ($key !~ /PDB/));
591            my($key1,$key2) =split("::",$key);
592            my $value = @$attr_ref[2];
593            my ($evalue,$location) = split(";",$value);
594    
595            if($evalue =~/(\d+)\.(\d+)/){
596                my $part2 = 1000 - $1;
597                my $part1 = $2/100;
598                $evalue = $part1."e-".$part2;
599                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
             }  
600    
601              # unroll it all into an array of hashes          my($start,$stop) =split("-",$location);
602              # this needs to be done differently for different types of observations  
603              my $dataset = [ { name => 'class', value => $key },          my $url = @$attr_ref[3];
604                              { name => 'acc' , value => $acc},          my $dataset = {'class' => 'PDB',
605                              { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD                         'type' => 'seq' ,
606                              { name => 'evalue', value => $evalue },                         'acc' => $key2,
607                              { name => 'start', value => $from},                         'evalue' => $evalue,
608                              { name => 'stop' , value => $to}                         'start' => $start,
609                              ];                         'stop' => $stop,
610                           'fig_id' => $fid
611                           };
612    
613              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
614          }          }
615      }      }
616    
617    =head3 get_cluster_observations() (internal)
618    
619    This methods sets the type and class for cluster observations
620    
621    =cut
622    
623    sub get_cluster_observations{
624        my ($fid,$datasets_ref,$scope) = (@_);
625    
626        my $dataset = {'class' => 'CLUSTER',
627                       'type' => 'fc',
628                       'context' => $scope,
629                       'fig_id' => $fid
630                       };
631        push (@{$datasets_ref} ,$dataset);
632  }  }
633    
634    
635  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
636    
637  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 593  Line 642 
642    
643      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
644      my $fig = new FIG;      my $fig = new FIG;
645      my @sims= $fig->nsims($fid,100,1e-20,"fig");      my @sims= $fig->nsims($fid,500,1e-20,"all");
646      my ($dataset);      my ($dataset);
647    
648        my %id_list;
649        foreach my $sim (@sims){
650            my $hit = $sim->[1];
651    
652            next if ($hit !~ /^fig\|/);
653            my @aliases = $fig->feature_aliases($hit);
654            foreach my $alias (@aliases){
655                $id_list{$alias} = 1;
656            }
657        }
658    
659        my %already;
660        my (@new_sims, @uniprot);
661      foreach my $sim (@sims){      foreach my $sim (@sims){
662          my $hit = $sim->[1];          my $hit = $sim->[1];
663            my ($id) = ($hit) =~ /\|(.*)/;
664            next if (defined($already{$id}));
665            next if (defined($id_list{$hit}));
666            push (@new_sims, $sim);
667            $already{$id} = 1;
668        }
669    
670        foreach my $sim (@new_sims){
671            my $hit = $sim->[1];
672            my $percent = $sim->[2];
673          my $evalue = $sim->[10];          my $evalue = $sim->[10];
674          my $from = $sim->[8];          my $qfrom = $sim->[6];
675          my $to = $sim->[9];          my $qto = $sim->[7];
676            my $hfrom = $sim->[8];
677            my $hto = $sim->[9];
678            my $qlength = $sim->[12];
679            my $hlength = $sim->[13];
680            my $db = get_database($hit);
681            my $func = $fig->function_of($hit);
682            my $organism = $fig->org_of($hit);
683    
684          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
685                      'acc' => $hit,                      'acc' => $hit,
686                        'identity' => $percent,
687                      'type' => 'seq',                      'type' => 'seq',
688                      'evalue' => $evalue,                      'evalue' => $evalue,
689                      'start' => $from,                      'qstart' => $qfrom,
690                      'stop' => $to                      'qstop' => $qto,
691                        'hstart' => $hfrom,
692                        'hstop' => $hto,
693                        'database' => $db,
694                        'organism' => $organism,
695                        'function' => $func,
696                        'qlength' => $qlength,
697                        'hlength' => $hlength,
698                        'fig_id' => $fid
699                      };                      };
700    
701          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
702      }      }
703  }  }
704    
705    =head3 get_database (internal)
706    This method gets the database association from the sequence id
707    
708    =cut
709    
710    sub get_database{
711        my ($id) = (@_);
712    
713        my ($db);
714        if ($id =~ /^fig\|/)              { $db = "FIG" }
715        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
716        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
717        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
718        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
719        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
720        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
721        elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
722        elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
723        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
724        elsif ($id =~ /^img\|/)           { $db = "JGI" }
725    
726        return ($db);
727    
728    }
729    
730    
731  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
732    
733  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 622  Line 738 
738    
739      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
740      my $fig = new FIG;      my $fig = new FIG;
741      my @funcs = ();      my $funcs_ref;
742    
743    #    my %id_list;
744      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);
745    #    my @aliases = $fig->feature_aliases($fid);
746    #    foreach my $alias (@aliases){
747    #       $id_list{$alias} = 1;
748    #    }
749    
750      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
751          my ($tmp, $who);          my ($tmp, $who);
752          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
753              if ($id =~ /^fig\|/)           { $who = "FIG" }  #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
754              elsif ($id =~ /^gi\|/)            { $who = "NCBI" }              $who = &get_database($id);
755              elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }              push(@$funcs_ref, [$id,$who,$tmp]);
             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]);  
756          }          }
757      }      }
758    
759      my ($dataset);      my ($dataset);
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
760          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
761                         'type' => 'seq',                         'type' => 'seq',
762                         'database' => $who,                     'fig_id' => $fid,
763                         'function' => $assignment                     'rows' => $funcs_ref
764                         };                         };
765    
766          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
767      }  
768    
769  }  }
770    
# Line 691  Line 795 
795                    } @fc_data;                    } @fc_data;
796    
797      my ($dataset);      my ($dataset);
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
798          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
799                         'type' => 'fc',                         'type' => 'fc',
800                         'function' => $description                     'fig_id' => $fid,
801                       'rows' => \@rows
802                         };                         };
803    
804          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
     }  
 }  
   
 =head3 get_sims_and_bbhs() (internal)  
   
 This methods retrieves sims and also BBHs and fills the internal data structures.  
   
 =cut  
   
 #     sub get_sims_and_bbhs{  
   
 #       # 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";  
 #       }  
   
 #     }  
   
805    
806    }
807    
808  =head3 new (internal)  =head3 new (internal)
809    
# Line 760  Line 814 
814  sub new {  sub new {
815    my ($class,$dataset) = @_;    my ($class,$dataset) = @_;
816    
   
   #$self = { acc => '',  
 #           description => '',  
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
   
817    my $self = { class => $dataset->{'class'},    my $self = { class => $dataset->{'class'},
818                 type => $dataset->{'type'}                 type => $dataset->{'type'},
819                   fig_id => $dataset->{'fig_id'},
820                   score => $dataset->{'score'},
821             };             };
822    
823    bless($self,$class);    bless($self,$class);
# Line 787  Line 825 
825    return $self;    return $self;
826  }  }
827    
828  =head3 feature_id (internal)  =head3 identity (internal)
829    
830    Returns the % identity of the similar sequence
831    
832  =cut  =cut
833    
834  sub feature_id {  sub identity {
835    my ($self) = @_;    my ($self) = @_;
836    
837    return $self->{feature_id};      return $self->{identity};
838  }  }
839    
840  =head3 id (internal)  =head3 fig_id (internal)
   
 Returns the ID  of the identical sequence  
841    
842  =cut  =cut
843    
844  sub id {  sub fig_id {
845      my ($self) = @_;
846      return $self->{fig_id};
847    }
848    
849    =head3 feature_id (internal)
850    
851    
852    =cut
853    
854    sub feature_id {
855      my ($self) = @_;
856    
857      return $self->{feature_id};
858    }
859    
860    =head3 id (internal)
861    
862    Returns the ID  of the identical sequence
863    
864    =cut
865    
866    sub id {
867      my ($self) = @_;      my ($self) = @_;
868    
869      return $self->{id};      return $self->{id};
# Line 846  Line 905 
905      return $self->{database};      return $self->{database};
906  }  }
907    
908    sub score {
909      my ($self) = @_;
910    
911      return $self->{score};
912    }
913    
914    ############################################################
915    ############################################################
916    package Observation::PDB;
917    
918    use base qw(Observation);
919    
920    sub new {
921    
922        my ($class,$dataset) = @_;
923        my $self = $class->SUPER::new($dataset);
924        $self->{acc} = $dataset->{'acc'};
925        $self->{evalue} = $dataset->{'evalue'};
926        $self->{start} = $dataset->{'start'};
927        $self->{stop} = $dataset->{'stop'};
928        bless($self,$class);
929        return $self;
930    }
931    
932    =head3 display()
933    
934    displays data stored in best_PDB attribute and in Ontology server for given PDB id
935    
936    =cut
937    
938    sub display{
939        my ($self,$gd) = @_;
940    
941        my $fid = $self->fig_id;
942        my $dbmaster = DBMaster->new(-database =>'Ontology');
943    
944        my $acc = $self->acc;
945    
946        my ($pdb_description,$pdb_source,$pdb_ligand);
947        my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
948        if(!scalar(@$pdb_objs)){
949            $pdb_description = "not available";
950            $pdb_source = "not available";
951            $pdb_ligand = "not available";
952        }
953        else{
954            my $pdb_obj = $pdb_objs->[0];
955            $pdb_description = $pdb_obj->description;
956            $pdb_source = $pdb_obj->source;
957            $pdb_ligand = $pdb_obj->ligand;
958        }
959    
960        my $lines = [];
961        my $line_data = [];
962        my $line_config = { 'title' => "PDB hit for $fid",
963                            'short_title' => "best PDB",
964                            'basepair_offset' => '1' };
965    
966        my $fig = new FIG;
967        my $seq = $fig->get_translation($fid);
968        my $fid_stop = length($seq);
969    
970        my $fid_element_hash = {
971            "title" => $fid,
972            "start" => '1',
973            "end" =>  $fid_stop,
974            "color"=> '1',
975            "zlayer" => '1'
976            };
977    
978        push(@$line_data,$fid_element_hash);
979    
980        my $links_list = [];
981        my $descriptions = [];
982    
983        my $name;
984        $name = {"title" => 'id',
985                 "value" => $acc};
986        push(@$descriptions,$name);
987    
988        my $description;
989        $description = {"title" => 'pdb description',
990                        "value" => $pdb_description};
991        push(@$descriptions,$description);
992    
993        my $score;
994        $score = {"title" => "score",
995                  "value" => $self->evalue};
996        push(@$descriptions,$score);
997    
998        my $start_stop;
999        my $start_stop_value = $self->start."_".$self->stop;
1000        $start_stop = {"title" => "start-stop",
1001                       "value" => $start_stop_value};
1002        push(@$descriptions,$start_stop);
1003    
1004        my $source;
1005        $source = {"title" => "source",
1006                  "value" => $pdb_source};
1007        push(@$descriptions,$source);
1008    
1009        my $ligand;
1010        $ligand = {"title" => "pdb ligand",
1011                   "value" => $pdb_ligand};
1012        push(@$descriptions,$ligand);
1013    
1014        my $link;
1015        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
1016    
1017        $link = {"link_title" => $acc,
1018                 "link" => $link_url};
1019        push(@$links_list,$link);
1020    
1021        my $pdb_element_hash = {
1022            "title" => "PDB homology",
1023            "start" => $self->start,
1024            "end" =>  $self->stop,
1025            "color"=> '6',
1026            "zlayer" => '3',
1027            "links_list" => $links_list,
1028            "description" => $descriptions};
1029    
1030        push(@$line_data,$pdb_element_hash);
1031        $gd->add_line($line_data, $line_config);
1032    
1033        return $gd;
1034    }
1035    
1036    1;
1037    
1038  ############################################################  ############################################################
1039  ############################################################  ############################################################
# Line 857  Line 1045 
1045    
1046      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1047      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1048      $self->{id} = $dataset->{'id'};      $self->{rows} = $dataset->{'rows'};
     $self->{organism} = $dataset->{'organism'};  
     $self->{function} = $dataset->{'function'};  
     $self->{database} = $dataset->{'database'};  
1049    
1050      bless($self,$class);      bless($self,$class);
1051      return $self;      return $self;
1052  }  }
1053    
1054  =head3 display()  =head3 display_table()
1055    
1056  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1057  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 877  Line 1062 
1062    
1063  =cut  =cut
1064    
 sub display{  
     my ($self, $cgi, $dataset) = @_;  
1065    
1066    sub display_table{
1067        my ($self) = @_;
1068    
1069        my $fig = new FIG;
1070        my $fid = $self->fig_id;
1071        my $rows = $self->rows;
1072        my $cgi = new CGI;
1073      my $all_domains = [];      my $all_domains = [];
1074      my $count_identical = 0;      my $count_identical = 0;
1075      my $content;      my $content;
1076      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1077          next if ($thing->class ne "IDENTICAL");          my $id = $row->[0];
1078            my $who = $row->[1];
1079            my $assignment = $row->[2];
1080            my $organism = $fig->org_of($id);
1081          my $single_domain = [];          my $single_domain = [];
1082          push(@$single_domain,$thing->database);          push(@$single_domain,$who);
         my $id = $thing->id;  
         $count_identical++;  
1083          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1084          push(@$single_domain,$thing->organism);          push(@$single_domain,$organism);
1085          #push(@$single_domain,$thing->type);          push(@$single_domain,$assignment);
         push(@$single_domain,$thing->function);  
1086          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1087            $count_identical++;
1088      }      }
1089    
1090      if ($count_identical >0){      if ($count_identical >0){
# Line 907  Line 1098 
1098    
1099  1;  1;
1100    
   
1101  #########################################  #########################################
1102  #########################################  #########################################
1103  package Observation::FC;  package Observation::FC;
# Line 919  Line 1109 
1109    
1110      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1111      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1112      $self->{score} = $dataset->{'score'};      $self->{rows} = $dataset->{'rows'};
     $self->{id} = $dataset->{'id'};  
     $self->{function} = $dataset->{'function'};  
1113    
1114      bless($self,$class);      bless($self,$class);
1115      return $self;      return $self;
1116  }  }
1117    
1118  =head3 display()  =head3 display_table()
1119    
1120  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1121  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 938  Line 1126 
1126    
1127  =cut  =cut
1128    
1129  sub display {  sub display_table {
     my ($self,$cgi,$dataset, $fid) = @_;  
1130    
1131        my ($self,$dataset) = @_;
1132        my $fid = $self->fig_id;
1133        my $rows = $self->rows;
1134        my $cgi = new CGI;
1135      my $functional_data = [];      my $functional_data = [];
1136      my $count = 0;      my $count = 0;
1137      my $content;      my $content;
1138    
1139      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1140          my $single_domain = [];          my $single_domain = [];
         next if ($thing->class ne "PCH");  
1141          $count++;          $count++;
1142    
1143          # construct the score link          # construct the score link
1144          my $score = $thing->score;          my $score = $row->[0];
1145          my $toid = $thing->id;          my $toid = $row->[1];
1146          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1147          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href=$link>$score</a>";
1148    
1149          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1150          push(@$single_domain,$thing->id);          push(@$single_domain,$row->[1]);
1151          push(@$single_domain,$thing->function);          push(@$single_domain,$row->[2]);
1152          push(@$functional_data,$single_domain);          push(@$functional_data,$single_domain);
1153      }      }
1154    
# Line 995  Line 1185 
1185  sub display {  sub display {
1186      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1187      my $lines = [];      my $lines = [];
1188      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1189                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1190                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1191      my $color = "4";      my $color = "4";
1192    
1193      my $line_data = [];      my $line_data = [];
1194      my $links_list = [];      my $links_list = [];
1195      my $descriptions = [];      my $descriptions = [];
1196    
1197      my $description_function;      my $db_and_id = $thing->acc;
1198      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1199    
1200      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology');
1201    
1202        my ($name_title,$name_value,$description_title,$description_value);
1203        if($db eq "CDD"){
1204            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1205            if(!scalar(@$cdd_objs)){
1206                $name_title = "name";
1207                $name_value = "not available";
1208                $description_title = "description";
1209                $description_value = "not available";
1210            }
1211            else{
1212                my $cdd_obj = $cdd_objs->[0];
1213                $name_title = "name";
1214                $name_value = $cdd_obj->term;
1215                $description_title = "description";
1216                $description_value = $cdd_obj->description;
1217            }
1218        }
1219    
1220        my $line_config = { 'title' => $thing->acc,
1221                            'short_title' => $name_value,
1222                            'basepair_offset' => '1' };
1223    
1224        my $name;
1225        $name = {"title" => $name_title,
1226                 "value" => $name_value};
1227        push(@$descriptions,$name);
1228    
1229        my $description;
1230        $description = {"title" => $description_title,
1231                                 "value" => $description_value};
1232        push(@$descriptions,$description);
1233    
1234      my $score;      my $score;
1235      $score = {"title" => "score",      $score = {"title" => "score",
# Line 1016  Line 1237 
1237      push(@$descriptions,$score);      push(@$descriptions,$score);
1238    
1239      my $link_id;      my $link_id;
1240      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/\w+::(\d+)/){
1241          $link_id = $1;          $link_id = $1;
1242      }      }
1243    
1244      my $link;      my $link;
1245        my $link_url;
1246        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"}
1247        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1248        else{$link_url = "NO_URL"}
1249    
1250      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1251               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1252      push(@$links_list,$link);      push(@$links_list,$link);
1253    
1254      my $element_hash = {      my $element_hash = {
# Line 1041  Line 1267 
1267    
1268  }  }
1269    
1270    sub display_table {
1271        my ($self,$dataset) = @_;
1272        my $cgi = new CGI;
1273        my $data = [];
1274        my $count = 0;
1275        my $content;
1276    
1277        foreach my $thing (@$dataset) {
1278            next if ($thing->type !~ /dom/);
1279            my $single_domain = [];
1280            $count++;
1281    
1282            my $db_and_id = $thing->acc;
1283            my ($db,$id) = split("::",$db_and_id);
1284    
1285            my $dbmaster = DBMaster->new(-database =>'Ontology');
1286    
1287            my ($name_title,$name_value,$description_title,$description_value);
1288            if($db eq "CDD"){
1289                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1290                if(!scalar(@$cdd_objs)){
1291                    $name_title = "name";
1292                    $name_value = "not available";
1293                    $description_title = "description";
1294                    $description_value = "not available";
1295                }
1296                else{
1297                    my $cdd_obj = $cdd_objs->[0];
1298                    $name_title = "name";
1299                    $name_value = $cdd_obj->term;
1300                    $description_title = "description";
1301                    $description_value = $cdd_obj->description;
1302                }
1303            }
1304    
1305            my $location =  $thing->start . " - " . $thing->stop;
1306    
1307            push(@$single_domain,$db);
1308            push(@$single_domain,$thing->acc);
1309            push(@$single_domain,$name_value);
1310            push(@$single_domain,$location);
1311            push(@$single_domain,$thing->evalue);
1312            push(@$single_domain,$description_value);
1313            push(@$data,$single_domain);
1314        }
1315    
1316        if ($count >0){
1317            $content = $data;
1318        }
1319        else
1320        {
1321            $content = "<p>This PEG does not have any similarities to domains</p>";
1322        }
1323    }
1324    
1325    
1326  #########################################  #########################################
1327  #########################################  #########################################
1328  package Observation::Sims;  package Observation::Location;
1329    
1330  use base qw(Observation);  use base qw(Observation);
1331    
# Line 1051  Line 1333 
1333    
1334      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1335      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1336      $self->{acc} = $dataset->{'acc'};      $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1337      $self->{evalue} = $dataset->{'evalue'};      $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1338      $self->{start} = $dataset->{'start'};      $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1339      $self->{stop} = $dataset->{'stop'};      $self->{cello_location} = $dataset->{'cello_location'};
1340        $self->{cello_score} = $dataset->{'cello_score'};
1341        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1342        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1343        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1344        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1345    
1346      bless($self,$class);      bless($self,$class);
1347      return $self;      return $self;
1348  }  }
1349    
1350  =head3 display()  sub display_cello {
1351        my ($thing) = @_;
1352        my $html;
1353        my $cello_location = $thing->cello_location;
1354        my $cello_score = $thing->cello_score;
1355        if($cello_location){
1356            $html .= "<p>CELLO prediction: $cello_location </p>";
1357            $html .= "<p>CELLO score: $cello_score </p>";
1358        }
1359        return ($html);
1360    }
1361    
1362  If available use the function specified here to display the "raw" observation.  sub display {
1363  This code will display a table for the similarities protein      my ($thing,$gd) = @_;
1364    
1365  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.      my $fid = $thing->fig_id;
1366        my $fig= new FIG;
1367        my $length = length($fig->get_translation($fid));
1368    
1369        my $cleavage_prob;
1370        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1371        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1372        my $signal_peptide_score = $thing->signal_peptide_score;
1373        my $cello_location = $thing->cello_location;
1374        my $cello_score = $thing->cello_score;
1375        my $tmpred_score = $thing->tmpred_score;
1376        my @tmpred_locations = split(",",$thing->tmpred_locations);
1377    
1378        my $phobius_signal_location = $thing->phobius_signal_location;
1379        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1380    
1381        my $lines = [];
1382    
1383        #color is
1384        my $color = "6";
1385    
1386    =pod=
1387    
1388        if($cello_location){
1389            my $cello_descriptions = [];
1390            my $line_data =[];
1391    
1392            my $line_config = { 'title' => 'Localization Evidence',
1393                                'short_title' => 'CELLO',
1394                                'basepair_offset' => '1' };
1395    
1396            my $description_cello_location = {"title" => 'Best Cello Location',
1397                                              "value" => $cello_location};
1398    
1399            push(@$cello_descriptions,$description_cello_location);
1400    
1401            my $description_cello_score = {"title" => 'Cello Score',
1402                                           "value" => $cello_score};
1403    
1404            push(@$cello_descriptions,$description_cello_score);
1405    
1406            my $element_hash = {
1407                "title" => "CELLO",
1408                "color"=> $color,
1409                "start" => "1",
1410                "end" =>  $length + 1,
1411                "zlayer" => '1',
1412                "description" => $cello_descriptions};
1413    
1414            push(@$line_data,$element_hash);
1415            $gd->add_line($line_data, $line_config);
1416        }
1417    
1418  =cut  =cut
1419    
1420  sub display {      $color = "2";
1421      my ($self,$cgi,$dataset) = @_;      if($tmpred_score){
1422            my $line_data =[];
1423            my $line_config = { 'title' => 'Localization Evidence',
1424                                'short_title' => 'Transmembrane',
1425                                'basepair_offset' => '1' };
1426    
1427      my $data = [];          foreach my $tmpred (@tmpred_locations){
1428      my $count = 0;              my $descriptions = [];
1429      my $content;              my ($begin,$end) =split("-",$tmpred);
1430                my $description_tmpred_score = {"title" => 'TMPRED score',
1431                                 "value" => $tmpred_score};
1432    
1433      foreach my $thing (@$dataset) {              push(@$descriptions,$description_tmpred_score);
1434          my $single_domain = [];  
1435          next if ($thing->class ne "SIM");              my $element_hash = {
1436          $count++;              "title" => "transmembrane location",
1437                "start" => $begin + 1,
1438                "end" =>  $end + 1,
1439                "color"=> $color,
1440                "zlayer" => '5',
1441                "type" => 'box',
1442                "description" => $descriptions};
1443    
1444                push(@$line_data,$element_hash);
1445    
1446          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          }
1447          push(@$single_domain,$thing->start);          $gd->add_line($line_data, $line_config);
         push(@$single_domain,$thing->stop);  
         push(@$single_domain,$thing->evalue);  
         push(@$data,$single_domain);  
1448      }      }
1449    
1450      if ($count >0){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1451          $content = $data;          my $line_data =[];
1452            my $line_config = { 'title' => 'Localization Evidence',
1453                                'short_title' => 'Phobius',
1454                                'basepair_offset' => '1' };
1455    
1456            foreach my $tm_loc (@phobius_tm_locations){
1457                my $descriptions = [];
1458                my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',
1459                                 "value" => $tm_loc};
1460                push(@$descriptions,$description_phobius_tm_locations);
1461    
1462                my ($begin,$end) =split("-",$tm_loc);
1463    
1464                my $element_hash = {
1465                "title" => "phobius transmembrane location",
1466                "start" => $begin + 1,
1467                "end" =>  $end + 1,
1468                "color"=> '6',
1469                "zlayer" => '4',
1470                "type" => 'bigbox',
1471                "description" => $descriptions};
1472    
1473                push(@$line_data,$element_hash);
1474    
1475      }      }
1476      else  
1477      {          if($phobius_signal_location){
1478          $content = "<p>This PEG does not have any similarities</p>";              my $descriptions = [];
1479                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1480                                 "value" => $phobius_signal_location};
1481                push(@$descriptions,$description_phobius_signal_location);
1482    
1483    
1484                my ($begin,$end) =split("-",$phobius_signal_location);
1485                my $element_hash = {
1486                "title" => "phobius signal locations",
1487                "start" => $begin + 1,
1488                "end" =>  $end + 1,
1489                "color"=> '1',
1490                "zlayer" => '5',
1491                "type" => 'box',
1492                "description" => $descriptions};
1493                push(@$line_data,$element_hash);
1494      }      }
1495      return ($content);  
1496            $gd->add_line($line_data, $line_config);
1497        }
1498    
1499    
1500        $color = "1";
1501        if($signal_peptide_score){
1502            my $line_data = [];
1503            my $descriptions = [];
1504    
1505            my $line_config = { 'title' => 'Localization Evidence',
1506                                'short_title' => 'SignalP',
1507                                'basepair_offset' => '1' };
1508    
1509            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1510                                                    "value" => $signal_peptide_score};
1511    
1512            push(@$descriptions,$description_signal_peptide_score);
1513    
1514            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1515                                             "value" => $cleavage_prob};
1516    
1517            push(@$descriptions,$description_cleavage_prob);
1518    
1519            my $element_hash = {
1520                "title" => "SignalP",
1521                "start" => $cleavage_loc_begin - 2,
1522                "end" =>  $cleavage_loc_end + 1,
1523                "type" => 'bigbox',
1524                "color"=> $color,
1525                "zlayer" => '10',
1526                "description" => $descriptions};
1527    
1528            push(@$line_data,$element_hash);
1529            $gd->add_line($line_data, $line_config);
1530        }
1531    
1532        return ($gd);
1533    
1534  }  }
1535    
1536    sub cleavage_loc {
1537      my ($self) = @_;
1538    
1539      return $self->{cleavage_loc};
1540    }
1541    
1542    sub cleavage_prob {
1543      my ($self) = @_;
1544    
1545      return $self->{cleavage_prob};
1546    }
1547    
1548    sub signal_peptide_score {
1549      my ($self) = @_;
1550    
1551      return $self->{signal_peptide_score};
1552    }
1553    
1554    sub tmpred_score {
1555      my ($self) = @_;
1556    
1557      return $self->{tmpred_score};
1558    }
1559    
1560    sub tmpred_locations {
1561      my ($self) = @_;
1562    
1563      return $self->{tmpred_locations};
1564    }
1565    
1566    sub cello_location {
1567      my ($self) = @_;
1568    
1569      return $self->{cello_location};
1570    }
1571    
1572    sub cello_score {
1573      my ($self) = @_;
1574    
1575      return $self->{cello_score};
1576    }
1577    
1578    sub phobius_signal_location {
1579      my ($self) = @_;
1580      return $self->{phobius_signal_location};
1581    }
1582    
1583    sub phobius_tm_locations {
1584      my ($self) = @_;
1585      return $self->{phobius_tm_locations};
1586    }
1587    
1588    
1589    
1590    #########################################
1591    #########################################
1592    package Observation::Sims;
1593    
1594    use base qw(Observation);
1595    
1596    sub new {
1597    
1598        my ($class,$dataset) = @_;
1599        my $self = $class->SUPER::new($dataset);
1600        $self->{identity} = $dataset->{'identity'};
1601        $self->{acc} = $dataset->{'acc'};
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) = @_;
1626    
1627        my $fig = new FIG;
1628        my $peg = $self->acc;
1629    
1630        my $organism = $self->organism;
1631        my $genome = $fig->genome_of($peg);
1632        my ($org_tax) = ($genome) =~ /(.*)\./;
1633        my $function = $self->function;
1634        my $abbrev_name = $fig->abbrev($organism);
1635        my $align_start = $self->qstart;
1636        my $align_stop = $self->qstop;
1637        my $hit_start = $self->hstart;
1638        my $hit_stop = $self->hstop;
1639    
1640        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1641    
1642        my $line_config = { 'title' => "$organism [$org_tax]",
1643                            'short_title' => "$abbrev_name",
1644                            'title_link' => '$tax_link',
1645                            'basepair_offset' => '0'
1646                            };
1647    
1648        my $line_data = [];
1649    
1650        my $element_hash;
1651        my $links_list = [];
1652        my $descriptions = [];
1653    
1654        # get subsystem information
1655        my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
1656    
1657        my $link;
1658        $link = {"link_title" => $peg,
1659                 "link" => $url_link};
1660        push(@$links_list,$link);
1661    
1662        my @subsystems = $fig->peg_to_subsystems($peg);
1663        foreach my $subsystem (@subsystems){
1664            my $link;
1665            $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1666                     "link_title" => $subsystem};
1667            push(@$links_list,$link);
1668        }
1669    
1670        my $description_function;
1671        $description_function = {"title" => "function",
1672                                 "value" => $function};
1673        push(@$descriptions,$description_function);
1674    
1675        my ($description_ss, $ss_string);
1676        $ss_string = join (",", @subsystems);
1677        $description_ss = {"title" => "subsystems",
1678                           "value" => $ss_string};
1679        push(@$descriptions,$description_ss);
1680    
1681        my $description_loc;
1682        $description_loc = {"title" => "location start",
1683                            "value" => $hit_start};
1684        push(@$descriptions, $description_loc);
1685    
1686        $description_loc = {"title" => "location stop",
1687                            "value" => $hit_stop};
1688        push(@$descriptions, $description_loc);
1689    
1690        my $evalue = $self->evalue;
1691        while ($evalue =~ /-0/)
1692        {
1693            my ($chunk1, $chunk2) = split(/-/, $evalue);
1694            $chunk2 = substr($chunk2,1);
1695            $evalue = $chunk1 . "-" . $chunk2;
1696        }
1697    
1698        my $color = &color($evalue);
1699    
1700        my $description_eval = {"title" => "E-Value",
1701                                "value" => $evalue};
1702        push(@$descriptions, $description_eval);
1703    
1704        my $identity = $self->identity;
1705        my $description_identity = {"title" => "Identity",
1706                                    "value" => $identity};
1707        push(@$descriptions, $description_identity);
1708    
1709        $element_hash = {
1710            "title" => $peg,
1711            "start" => $align_start,
1712            "end" =>  $align_stop,
1713            "type"=> 'box',
1714            "color"=> $color,
1715            "zlayer" => "2",
1716            "links_list" => $links_list,
1717            "description" => $descriptions
1718            };
1719        push(@$line_data,$element_hash);
1720        $gd->add_line($line_data, $line_config);
1721    
1722        return ($gd);
1723    
1724    }
1725    
1726    =head3 display_domain_composition()
1727    
1728    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
1729    
1730    =cut
1731    
1732    sub display_domain_composition {
1733        my ($self,$gd) = @_;
1734    
1735        my $fig = new FIG;
1736        my $peg = $self->acc;
1737    
1738        my $line_data = [];
1739        my $links_list = [];
1740        my $descriptions = [];
1741    
1742        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1743    
1744        foreach $dqr (@domain_query_results){
1745            my $key = @$dqr[1];
1746            my @parts = split("::",$key);
1747            my $db = $parts[0];
1748            my $id = $parts[1];
1749            my $val = @$dqr[2];
1750            my $from;
1751            my $to;
1752            my $evalue;
1753    
1754            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1755                my $raw_evalue = $1;
1756                $from = $2;
1757                $to = $3;
1758                if($raw_evalue =~/(\d+)\.(\d+)/){
1759                    my $part2 = 1000 - $1;
1760                    my $part1 = $2/100;
1761                    $evalue = $part1."e-".$part2;
1762                }
1763                else{
1764                    $evalue = "0.0";
1765                }
1766            }
1767    
1768            my $dbmaster = DBMaster->new(-database =>'Ontology');
1769            my ($name_value,$description_value);
1770    
1771            if($db eq "CDD"){
1772                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1773                if(!scalar(@$cdd_objs)){
1774                    $name_title = "name";
1775                    $name_value = "not available";
1776                    $description_title = "description";
1777                    $description_value = "not available";
1778                }
1779                else{
1780                    my $cdd_obj = $cdd_objs->[0];
1781                    $name_value = $cdd_obj->term;
1782                    $description_value = $cdd_obj->description;
1783                }
1784            }
1785    
1786            my $domain_name;
1787            $domain_name = {"title" => "name",
1788                     "value" => $name_value};
1789            push(@$descriptions,$domain_name);
1790    
1791            my $description;
1792            $description = {"title" => "description",
1793                            "value" => $description_value};
1794            push(@$descriptions,$description);
1795    
1796            my $score;
1797            $score = {"title" => "score",
1798                      "value" => $evalue};
1799            push(@$descriptions,$score);
1800    
1801            my $link_id = $id;
1802            my $link;
1803            my $link_url;
1804            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"}
1805            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1806            else{$link_url = "NO_URL"}
1807    
1808            $link = {"link_title" => $name_value,
1809                     "link" => $link_url};
1810            push(@$links_list,$link);
1811    
1812            my $domain_element_hash = {
1813                "title" => $peg,
1814                "start" => $from,
1815                "end" =>  $to,
1816                "type"=> 'box',
1817                "zlayer" => '4',
1818                "links_list" => $links_list,
1819                "description" => $descriptions
1820                };
1821    
1822            push(@$line_data,$domain_element_hash);
1823    
1824            #just one CDD domain for now, later will add option for multiple domains from selected DB
1825            last;
1826        }
1827    
1828        my $line_config = { 'title' => $peg,
1829                            'short_title' => $peg,
1830                            'basepair_offset' => '1' };
1831    
1832        $gd->add_line($line_data, $line_config);
1833    
1834        return ($gd);
1835    
1836    }
1837    
1838    =head3 display_table()
1839    
1840    If available use the function specified here to display the "raw" observation.
1841    This code will display a table for the similarities protein
1842    
1843    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.
1844    
1845    =cut
1846    
1847    sub display_table {
1848        my ($self,$dataset, $scroll_list, $query_fid) = @_;
1849    
1850        my $data = [];
1851        my $count = 0;
1852        my $content;
1853        my $fig = new FIG;
1854        my $cgi = new CGI;
1855        my @ids;
1856        foreach my $thing (@$dataset) {
1857            next if ($thing->class ne "SIM");
1858            push (@ids, $thing->acc);
1859        }
1860    
1861        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1862    
1863        # get the column for the subsystems
1864        %subsystems_column = &get_subsystems_column(\@ids);
1865    
1866        # get the column for the evidence codes
1867        %evidence_column = &get_evidence_column(\@ids);
1868    
1869        # get the column for pfam_domain
1870        %pfam_column = &get_pfam_column(\@ids);
1871    
1872        my %e_identical = &get_essentially_identical($query_fid);
1873        my $all_aliases = $fig->feature_aliases_bulk(\@ids);
1874    
1875        foreach my $thing (@$dataset) {
1876            next if ($thing->class ne "SIM");
1877            my $single_domain = [];
1878            $count++;
1879    
1880            my $id = $thing->acc;
1881    
1882            my $iden    = $thing->identity;
1883            my $ln1     = $thing->qlength;
1884            my $ln2     = $thing->hlength;
1885            my $b1      = $thing->qstart;
1886            my $e1      = $thing->qstop;
1887            my $b2      = $thing->hstart;
1888            my $e2      = $thing->hstop;
1889            my $d1      = abs($e1 - $b1) + 1;
1890            my $d2      = abs($e2 - $b2) + 1;
1891            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1892            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1893    
1894            # checkbox column
1895            my $field_name = "tables_" . $id;
1896            my $pair_name = "visual_" . $id;
1897            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1898    
1899            # get the linked fig id
1900            my $fig_col;
1901            if (defined ($e_identical{$id})){
1902                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1903            }
1904            else{
1905                $fig_col = &HTML::set_prot_links($cgi,$id);
1906            }
1907    
1908            push(@$single_domain,$box_col);                        # permanent column
1909            push(@$single_domain,$fig_col);                        # permanent column
1910            push(@$single_domain,$thing->evalue);                  # permanent column
1911            push(@$single_domain,"$iden\%");                       # permanent column
1912            push(@$single_domain,$reg1);                           # permanent column
1913            push(@$single_domain,$reg2);                           # permanent column
1914            push(@$single_domain,$thing->organism);                # permanent column
1915            push(@$single_domain,$thing->function);                # permanent column
1916            foreach my $col (sort keys %$scroll_list){
1917                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1918                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1919                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1920                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}
1921                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}
1922                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}
1923                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}
1924                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}
1925                elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}
1926                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}
1927                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}
1928                elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}
1929                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}
1930            }
1931            push(@$data,$single_domain);
1932        }
1933    
1934        if ($count >0 ){
1935            $content = $data;
1936        }
1937        else{
1938            $content = "<p>This PEG does not have any similarities</p>";
1939        }
1940        return ($content);
1941    }
1942    
1943    sub get_box_column{
1944        my ($ids) = @_;
1945        my %column;
1946        foreach my $id (@$ids){
1947            my $field_name = "tables_" . $id;
1948            my $pair_name = "visual_" . $id;
1949            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1950        }
1951        return (%column);
1952    }
1953    
1954    sub get_subsystems_column{
1955        my ($ids) = @_;
1956    
1957        my $fig = new FIG;
1958        my $cgi = new CGI;
1959        my %in_subs  = $fig->subsystems_for_pegs($ids);
1960        my %column;
1961        foreach my $id (@$ids){
1962            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1963            my @subsystems;
1964    
1965            if (@in_sub > 0) {
1966                my $count = 1;
1967                foreach my $array(@in_sub){
1968                    push (@subsystems, $count . ". " . $$array[0]);
1969                    $count++;
1970                }
1971                my $in_sub_line = join ("<br>", @subsystems);
1972                $column{$id} = $in_sub_line;
1973            } else {
1974                $column{$id} = "&nbsp;";
1975            }
1976        }
1977        return (%column);
1978    }
1979    
1980    sub get_essentially_identical{
1981        my ($fid) = @_;
1982        my $fig = new FIG;
1983    
1984        my %id_list;
1985        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
1986    
1987        foreach my $id (@maps_to) {
1988            if (($id ne $fid) && ($fig->function_of($id))) {
1989                $id_list{$id} = 1;
1990            }
1991        }
1992        return(%id_list);
1993    }
1994    
1995    
1996    sub get_evidence_column{
1997        my ($ids) = @_;
1998        my $fig = new FIG;
1999        my $cgi = new CGI;
2000        my (%column, %code_attributes);
2001    
2002        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);
2003        foreach my $key (@codes){
2004            push (@{$code_attributes{$$key[0]}}, $key);
2005        }
2006    
2007        foreach my $id (@$ids){
2008            # add evidence code with tool tip
2009            my $ev_codes=" &nbsp; ";
2010            my @ev_codes = "";
2011    
2012            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2013                my @codes;
2014                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2015                @ev_codes = ();
2016                foreach my $code (@codes) {
2017                    my $pretty_code = $code->[2];
2018                    if ($pretty_code =~ /;/) {
2019                        my ($cd, $ss) = split(";", $code->[2]);
2020                        $ss =~ s/_/ /g;
2021                        $pretty_code = $cd;# . " in " . $ss;
2022                    }
2023                    push(@ev_codes, $pretty_code);
2024                }
2025            }
2026    
2027            if (scalar(@ev_codes) && $ev_codes[0]) {
2028                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2029                $ev_codes = $cgi->a(
2030                                    {
2031                                        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));
2032            }
2033            $column{$id}=$ev_codes;
2034        }
2035        return (%column);
2036    }
2037    
2038    sub get_pfam_column{
2039        my ($ids) = @_;
2040        my $fig = new FIG;
2041        my $cgi = new CGI;
2042        my (%column, %code_attributes);
2043        my $dbmaster = DBMaster->new(-database =>'Ontology');
2044    
2045        my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
2046        foreach my $key (@codes){
2047            push (@{$code_attributes{$$key[0]}}, $$key[1]);
2048        }
2049    
2050        foreach my $id (@$ids){
2051            # add evidence code with tool tip
2052            my $pfam_codes=" &nbsp; ";
2053            my @pfam_codes = "";
2054            my %description_codes;
2055    
2056            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2057                my @codes;
2058                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2059                @pfam_codes = ();
2060                foreach my $code (@codes) {
2061                    my @parts = split("::",$code);
2062                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2063                    if (defined ($description_codes{$parts[1]})){
2064                        push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");
2065                    }
2066                    else {
2067                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2068                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2069                        push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");
2070                    }
2071                }
2072            }
2073    
2074            $column{$id}=join("<br><br>", @pfam_codes);
2075        }
2076        return (%column);
2077    
2078    }
2079    
2080    sub get_prefer {
2081        my ($fid, $db, $all_aliases) = @_;
2082        my $fig = new FIG;
2083        my $cgi = new CGI;
2084    
2085        foreach my $alias (@{$$all_aliases{$fid}}){
2086            my $id_db = &Observation::get_database($alias);
2087            if ($id_db eq $db){
2088                my $acc_col .= &HTML::set_prot_links($cgi,$alias);
2089                return ($acc_col);
2090            }
2091        }
2092        return (" ");
2093    }
2094    
2095    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2096    
2097    sub color {
2098        my ($evalue) = @_;
2099    
2100        my $color;
2101        if ($evalue <= 1e-170){
2102            $color = 51;
2103        }
2104        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){
2105            $color = 52;
2106        }
2107        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){
2108            $color = 53;
2109        }
2110        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){
2111            $color = 54;
2112        }
2113        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){
2114            $color = 55;
2115        }
2116        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){
2117            $color = 56;
2118        }
2119        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){
2120            $color = 57;
2121        }
2122        elsif (($evalue <= 1) && ($evalue > 1e-5)){
2123            $color = 58;
2124        }
2125        elsif (($evalue <= 10) && ($evalue > 1)){
2126            $color = 59;
2127        }
2128        else{
2129            $color = 60;
2130        }
2131    
2132    
2133        return ($color);
2134    }
2135    
2136    
2137    ############################
2138    package Observation::Cluster;
2139    
2140    use base qw(Observation);
2141    
2142    sub new {
2143    
2144        my ($class,$dataset) = @_;
2145        my $self = $class->SUPER::new($dataset);
2146        $self->{context} = $dataset->{'context'};
2147        bless($self,$class);
2148        return $self;
2149    }
2150    
2151    sub display {
2152        my ($self,$gd) = @_;
2153    
2154        my $fid = $self->fig_id;
2155        my $compare_or_coupling = $self->context;
2156        my $gd_window_size = $gd->window_size;
2157        my $fig = new FIG;
2158        my $all_regions = [];
2159    
2160        #get the organism genome
2161        my $target_genome = $fig->genome_of($fid);
2162    
2163        # get location of the gene
2164        my $data = $fig->feature_location($fid);
2165        my ($contig, $beg, $end);
2166        my %reverse_flag;
2167    
2168        if ($data =~ /(.*)_(\d+)_(\d+)$/){
2169            $contig = $1;
2170            $beg = $2;
2171            $end = $3;
2172        }
2173    
2174        my $offset;
2175        my ($region_start, $region_end);
2176        if ($beg < $end)
2177        {
2178            $region_start = $beg - 4000;
2179            $region_end = $end+4000;
2180            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2181        }
2182        else
2183        {
2184            $region_start = $end-4000;
2185            $region_end = $beg+4000;
2186            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2187            $reverse_flag{$target_genome} = $fid;
2188        }
2189    
2190        # call genes in region
2191        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2192        push(@$all_regions,$target_gene_features);
2193        my (@start_array_region);
2194        push (@start_array_region, $offset);
2195    
2196        my %all_genes;
2197        my %all_genomes;
2198        foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}
2199    
2200        if ($compare_or_coupling eq "diverse")
2201        {
2202            my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
2203    
2204            my $coup_count = 0;
2205    
2206            foreach my $pair (@{$coup[0]->[2]}) {
2207                #   last if ($coup_count > 10);
2208                my ($peg1,$peg2) = @$pair;
2209    
2210                my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
2211                $pair_genome = $fig->genome_of($peg1);
2212    
2213                my $location = $fig->feature_location($peg1);
2214                if($location =~/(.*)_(\d+)_(\d+)$/){
2215                    $pair_contig = $1;
2216                    $pair_beg = $2;
2217                    $pair_end = $3;
2218                    if ($pair_beg < $pair_end)
2219                    {
2220                        $pair_region_start = $pair_beg - 4000;
2221                        $pair_region_stop = $pair_end+4000;
2222                        $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2223                    }
2224                    else
2225                    {
2226                        $pair_region_start = $pair_end-4000;
2227                        $pair_region_stop = $pair_beg+4000;
2228                        $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2229                        $reverse_flag{$pair_genome} = $peg1;
2230                    }
2231    
2232                    push (@start_array_region, $offset);
2233    
2234                    $all_genomes{$pair_genome} = 1;
2235                    my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
2236                    push(@$all_regions,$pair_features);
2237                    foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2238                }
2239                $coup_count++;
2240            }
2241        }
2242    
2243        elsif ($compare_or_coupling eq "close")
2244        {
2245            # make a hash of genomes that are phylogenetically close
2246            #my $close_threshold = ".26";
2247            #my @genomes = $fig->genomes('complete');
2248            #my %close_genomes = ();
2249            #foreach my $compared_genome (@genomes)
2250            #{
2251            #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);
2252            #    #$close_genomes{$compared_genome} = $dist;
2253            #    if ($dist <= $close_threshold)
2254            #    {
2255            #       $all_genomes{$compared_genome} = 1;
2256            #    }
2257            #}
2258            $all_genomes{"216592.1"} = 1;
2259            $all_genomes{"79967.1"} = 1;
2260            $all_genomes{"199310.1"} = 1;
2261            $all_genomes{"216593.1"} = 1;
2262            $all_genomes{"155864.1"} = 1;
2263            $all_genomes{"83334.1"} = 1;
2264            $all_genomes{"316407.3"} = 1;
2265    
2266            foreach my $comp_genome (keys %all_genomes){
2267                my $return = $fig->bbh_list($comp_genome,[$fid]);
2268                my $feature_list = $return->{$fid};
2269                foreach my $peg1 (@$feature_list){
2270                    my $location = $fig->feature_location($peg1);
2271                    my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
2272                    $pair_genome = $fig->genome_of($peg1);
2273    
2274                    if($location =~/(.*)_(\d+)_(\d+)$/){
2275                        $pair_contig = $1;
2276                        $pair_beg = $2;
2277                        $pair_end = $3;
2278                        if ($pair_beg < $pair_end)
2279                        {
2280                            $pair_region_start = $pair_beg - 4000;
2281                            $pair_region_stop = $pair_end + 4000;
2282                            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2283                        }
2284                        else
2285                        {
2286                            $pair_region_start = $pair_end-4000;
2287                            $pair_region_stop = $pair_beg+4000;
2288                            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2289                            $reverse_flag{$pair_genome} = $peg1;
2290                        }
2291    
2292                        push (@start_array_region, $offset);
2293                        $all_genomes{$pair_genome} = 1;
2294                        my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
2295                        push(@$all_regions,$pair_features);
2296                        foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2297                    }
2298                }
2299            }
2300        }
2301    
2302        # get the PCH to each of the genes
2303        my $pch_sets = [];
2304        my %pch_already;
2305        foreach my $gene_peg (keys %all_genes)
2306        {
2307            if ($pch_already{$gene_peg}){(next);};
2308            my $gene_set = [$gene_peg];
2309            foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {
2310                $pch_peg =~ s/,.*$//;
2311                my $pch_genome = $fig->genome_of($pch_peg);
2312                if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {
2313                    push(@$gene_set,$pch_peg);
2314                    $pch_already{$pch_peg}=1;
2315                }
2316                $pch_already{$gene_peg}=1;
2317            }
2318            push(@$pch_sets,$gene_set);
2319        }
2320    
2321        #create a rank of the pch's
2322        my %pch_set_rank;
2323        my $order = 0;
2324        foreach my $set (@$pch_sets){
2325            my $count = scalar(@$set);
2326            $pch_set_rank{$order} = $count;
2327            $order++;
2328        }
2329    
2330        my %peg_rank;
2331        my $counter =  1;
2332        foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){
2333            my $good_set = @$pch_sets[$pch_order];
2334            my $flag_set = 0;
2335            if (scalar (@$good_set) > 1)
2336            {
2337                foreach my $peg (@$good_set){
2338                    if ((!$peg_rank{$peg})){
2339                        $peg_rank{$peg} = $counter;
2340                        $flag_set = 1;
2341                    }
2342                }
2343                $counter++ if ($flag_set == 1);
2344            }
2345            else
2346            {
2347                foreach my $peg (@$good_set){
2348                    $peg_rank{$peg} = "20";
2349                }
2350            }
2351        }
2352    
2353    
2354    #    my $bbh_sets = [];
2355    #    my %already;
2356    #    foreach my $gene_key (keys(%all_genes)){
2357    #       if($already{$gene_key}){(next);}
2358    #       my $gene_set = [$gene_key];
2359    #
2360    #       my $gene_key_genome = $fig->genome_of($gene_key);
2361    #
2362    #       foreach my $genome_key (keys(%all_genomes)){
2363    #           #(next) if ($gene_key_genome eq $genome_key);
2364    #           my $return = $fig->bbh_list($genome_key,[$gene_key]);
2365    #
2366    #           my $feature_list = $return->{$gene_key};
2367    #           foreach my $fl (@$feature_list){
2368    #               push(@$gene_set,$fl);
2369    #           }
2370    #       }
2371    #       $already{$gene_key} = 1;
2372    #       push(@$bbh_sets,$gene_set);
2373    #    }
2374    #
2375    #    my %bbh_set_rank;
2376    #    my $order = 0;
2377    #    foreach my $set (@$bbh_sets){
2378    #       my $count = scalar(@$set);
2379    #       $bbh_set_rank{$order} = $count;
2380    #       $order++;
2381    #    }
2382    #
2383    #    my %peg_rank;
2384    #    my $counter =  1;
2385    #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){
2386    #       my $good_set = @$bbh_sets[$bbh_order];
2387    #       my $flag_set = 0;
2388    #       if (scalar (@$good_set) > 1)
2389    #       {
2390    #           foreach my $peg (@$good_set){
2391    #               if ((!$peg_rank{$peg})){
2392    #                   $peg_rank{$peg} = $counter;
2393    #                   $flag_set = 1;
2394    #               }
2395    #           }
2396    #           $counter++ if ($flag_set == 1);
2397    #       }
2398    #       else
2399    #       {
2400    #           foreach my $peg (@$good_set){
2401    #               $peg_rank{$peg} = "20";
2402    #           }
2403    #       }
2404    #    }
2405    
2406        foreach my $region (@$all_regions){
2407            my $sample_peg = @$region[0];
2408            my $region_genome = $fig->genome_of($sample_peg);
2409            my $region_gs = $fig->genus_species($region_genome);
2410            my $abbrev_name = $fig->abbrev($region_gs);
2411            my $line_config = { 'title' => $region_gs,
2412                                'short_title' => $abbrev_name,
2413                                'basepair_offset' => '0'
2414                                };
2415    
2416            my $offsetting = shift @start_array_region;
2417    
2418            my $second_line_config = { 'title' => "$region_gs",
2419                                       'short_title' => "",
2420                                       'basepair_offset' => '0'
2421                                       };
2422    
2423            my $line_data = [];
2424            my $second_line_data = [];
2425    
2426            # initialize variables to check for overlap in genes
2427            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2428            my $major_line_flag = 0;
2429            my $prev_second_flag = 0;
2430    
2431            foreach my $fid1 (@$region){
2432                $second_line_flag = 0;
2433                my $element_hash;
2434                my $links_list = [];
2435                my $descriptions = [];
2436    
2437                my $color = $peg_rank{$fid1};
2438    
2439                # get subsystem information
2440                my $function = $fig->function_of($fid1);
2441                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;
2442    
2443                my $link;
2444                $link = {"link_title" => $fid1,
2445                         "link" => $url_link};
2446                push(@$links_list,$link);
2447    
2448                my @subsystems = $fig->peg_to_subsystems($fid1);
2449                foreach my $subsystem (@subsystems){
2450                    my $link;
2451                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
2452                             "link_title" => $subsystem};
2453                    push(@$links_list,$link);
2454                }
2455    
2456                my $description_function;
2457                $description_function = {"title" => "function",
2458                                         "value" => $function};
2459                push(@$descriptions,$description_function);
2460    
2461                my $description_ss;
2462                my $ss_string = join (",", @subsystems);
2463                $description_ss = {"title" => "subsystems",
2464                                   "value" => $ss_string};
2465                push(@$descriptions,$description_ss);
2466    
2467    
2468                my $fid_location = $fig->feature_location($fid1);
2469                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2470                    my($start,$stop);
2471                    $start = $2 - $offsetting;
2472                    $stop = $3 - $offsetting;
2473    
2474                    if ( (($prev_start) && ($prev_stop) ) &&
2475                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2476                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2477                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2478                            $second_line_flag = 1;
2479                            $major_line_flag = 1;
2480                        }
2481                    }
2482                    $prev_start = $start;
2483                    $prev_stop = $stop;
2484                    $prev_fig = $fid1;
2485    
2486                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2487                        $start = $gd_window_size - $start;
2488                        $stop = $gd_window_size - $stop;
2489                    }
2490    
2491                    $element_hash = {
2492                        "title" => $fid1,
2493                        "start" => $start,
2494                        "end" =>  $stop,
2495                        "type"=> 'arrow',
2496                        "color"=> $color,
2497                        "zlayer" => "2",
2498                        "links_list" => $links_list,
2499                        "description" => $descriptions
2500                    };
2501    
2502                    # if there is an overlap, put into second line
2503                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2504                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2505    
2506                }
2507            }
2508            $gd->add_line($line_data, $line_config);
2509            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2510        }
2511        return $gd;
2512    }
2513    
2514    

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.36

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3