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

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.31

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3