[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.6, Mon Jun 18 16:20:45 2007 UTC revision 1.7, Tue Jun 19 21:55:39 2007 UTC
# Line 206  Line 206 
206    
207  sub score {  sub score {
208    my ($self) = @_;    my ($self) = @_;
   
209    return $self->{score};    return $self->{score};
210  }  }
211    
# Line 221  Line 220 
220    
221  =cut  =cut
222    
223  sub display_method {  sub display {
   my ($self) = @_;  
224    
225    # add code here    die "Abstract Method Called\n";
226    
   return $self->{display_method};  
227  }  }
228    
229    
230  =head3 rank()  =head3 rank()
231    
232  Returns an integer from 1 - 10 indicating the importance of this observations.  Returns an integer from 1 - 10 indicating the importance of this observations.
# Line 298  Line 296 
296  - get attributes (there is code for this that in get_attribute_based_observations  - get attributes (there is code for this that in get_attribute_based_observations
297  - get_attributes_based_observations returns an array of arrays of hashes like this"  - get_attributes_based_observations returns an array of arrays of hashes like this"
298    
299    my $datasets =    my $dataset
300       [       [
301         [ { name => 'acc', value => '1234' },         [ { name => 'acc', value => '1234' },
302          { name => 'from', value => '4' },          { name => 'from', value => '4' },
# Line 320  Line 318 
318  =cut  =cut
319    
320  sub get_objects {  sub get_objects {
321      my ($self,$fid) = @_;      my ($self,$fid,$classes) = @_;
322    
323    
324    my $objects = [];    my $objects = [];
325    my @matched_datasets=();    my @matched_datasets=();
326    
327    # call function that fetches attribute based observations    # call function that fetches attribute based observations
328    # returns an array of arrays of hashes    # returns an array of arrays of hashes
   #  
   get_attribute_based_observations($fid,\@matched_datasets);  
329    
330    # read sims      if(scalar(@$classes) < 1){
331            get_attribute_based_observations($fid,\@matched_datasets);
332    get_sims_observations($fid,\@matched_datasets);    get_sims_observations($fid,\@matched_datasets);
   
   # read identical proteins list of sequences  
333    get_identical_proteins($fid,\@matched_datasets);    get_identical_proteins($fid,\@matched_datasets);
   
   # read functional coupling  
334    get_functional_coupling($fid,\@matched_datasets);    get_functional_coupling($fid,\@matched_datasets);
335        }
336        else{
337            #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based
338            my %domain_classes;
339            foreach my $class (@$classes){
340                if($class =~/(IPR|CDD|PFAM)/){
341                    $domain_classes{$class} = 1;
342    
343    # read sims + bbh (enrich BBHs with sims coordindates etc)              }
344    # read pchs          }
345    # read figfam match data from 48hr directory (BobO knows how do do this!)          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
346    # what sources of evidence did I miss?  
347            #add CELLO and SignalP later
348        }
349    
350    foreach my $dataset (@matched_datasets) {    foreach my $dataset (@matched_datasets) {
351      my $object = $self->new();          my $object;
352      foreach my $attribute (@$dataset) {          if($dataset->{'type'} eq "dom"){
353        $object->{$attribute->{'name'}} = $attribute->{'value'};              $object = Observation::Domain->new($dataset);
354      }      }
 #    $object->{$attribute->{'feature_id'}} = $attribute->{$fid};  
355      push (@$objects, $object);      push (@$objects, $object);
356      }      }
357    
   
358    return $objects;    return $objects;
359    
360  }  }
361    
362  =head1 Internal Methods  =head1 Internal Methods
# Line 425  Line 427 
427       return undef;       return undef;
428  }  }
429    
430    
431    sub get_attribute_based_domain_observations{
432    
433        # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
434        my ($fid,$domain_classes,$datasets_ref) = (@_);
435    
436        my $fig = new FIG;
437    
438        foreach my $attr_ref ($fig->get_attributes($fid)) {
439            my $key = @$attr_ref[1];
440            my @parts = split("::",$key);
441            my $class = $parts[0];
442    
443            if($domain_classes->{$parts[0]}){
444                my $val = @$attr_ref[2];
445                if($val =~/^(\d+\.\d+);(\d+)-(\d+)/){
446                    my $raw_evalue = $1;
447                    my $evalue;
448                    if($raw_evalue =~/(\d+)\.(\d+)/){
449                        my $part2 = 1000 - $1;
450                        my $part1 = $2/100;
451                        $evalue = $part1."e-".$part2;
452                    }
453                    else{
454                        $evalue = "0";
455                    }
456    
457                    my $from = $2;
458                    my $to = $3;
459                    my $dataset = {'class' => $class,
460                                   'acc' => $key,
461                                   'type' => "dom" ,
462                                   'evalue' => $evalue,
463                                   'start' => $from,
464                                   'stop' => $to
465                                   };
466    
467                    push (@{$datasets_ref} ,$dataset);
468                }
469            }
470        }
471    }
472    
473  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
474    
475  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 666  Line 711 
711  =cut  =cut
712    
713  sub new {  sub new {
714    my ($self) = @_;    my ($class,$dataset) = @_;
715    
716    
717    $self = { acc => '',    #$self = { acc => '',
718              description => '',  #           description => '',
719              class => '',  #           class => '',
720              type => '',  #           type => '',
721              start => '',  #           start => '',
722              stop => '',  #           stop => '',
723              evalue => '',  #           evalue => '',
724              score => '',  #           score => '',
725              display_method => '',  #           display_method => '',
726              feature_id => '',  #           feature_id => '',
727              rank => '',  #           rank => '',
728              supports_annotation => '',  #           supports_annotation => '',
729              id => '',  #           id => '',
730              organism => '',  #            organism => '',
731              who => ''  #            who => ''
732    #         };
733    
734      my $self = { class => $dataset->{'class'},
735                   type => $dataset->{'type'}
736            };            };
737    
738    bless($self, 'Observation');    bless($self,$class);
739    
740    return $self;    return $self;
741  }  }
742    
743  =head3 feature_id (internal)  =head3 feature_id (internal)
744    
 Returns the ID  of the feature these Observations belong to.  
745    
746  =cut  =cut
747    
# Line 795  Line 844 
844      }      }
845      return ($content);      return ($content);
846  }  }
847    
848    package Observation::Domain;
849    
850    use base qw(Observation);
851    
852    sub new {
853    
854        my ($class,$dataset) = @_;
855        my $self = $class->SUPER::new($dataset);
856        $self->{evalue} = $dataset->{'evalue'};
857        $self->{acc} = $dataset->{'acc'};
858        $self->{start} = $dataset->{'start'};
859        $self->{stop} = $dataset->{'stop'};
860    
861        bless($self,$class);
862        return $self;
863    }
864    
865    sub display {
866        my ($thing,$gd) = @_;
867        my $lines = [];
868        my $line_config = { 'title' => $thing->acc,
869                            'short_title' => $thing->type,
870                            'basepair_offset' => '1' };
871        my $color = "4";
872    
873        my $line_data = [];
874        my $links_list = [];
875        my $descriptions = [];
876    
877        my $description_function;
878        $description_function = {"title" => $thing->class,
879                                 "value" => $thing->acc};
880    
881        push(@$descriptions,$description_function);
882    
883        my $score;
884        $score = {"title" => "score",
885                  "value" => $thing->evalue};
886        push(@$descriptions,$score);
887    
888        my $link_id;
889        if ($thing->acc =~/CDD::(\d+)/){
890            $link_id = $1;
891        }
892    
893        my $link;
894        $link = {"link_title" => $thing->acc,
895                 "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};
896        push(@$links_list,$link);
897    
898        my $element_hash = {
899            "title" => $thing->type,
900            "start" => $thing->start,
901            "end" =>  $thing->stop,
902            "color"=> $color,
903            "zlayer" => '2',
904            "links_list" => $links_list,
905            "description" => $descriptions};
906    
907        push(@$line_data,$element_hash);
908        $gd->add_line($line_data, $line_config);
909    
910        return $gd;
911    
912    }
913    

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3