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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3