[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.4, Wed Jun 13 16:40:25 2007 UTC revision 1.8, Tue Jun 19 22:11:25 2007 UTC
# Line 5  Line 5 
5    
6  use strict;  use strict;
7  use warnings;  use warnings;
8    use Table;
9    
10  1;  1;
11    
# Line 88  Line 89 
89  sub description {  sub description {
90    my ($self) = @_;    my ($self) = @_;
91    
92    return $self->{acc};    return $self->{description};
93  }  }
94    
95  =head3 class()  =head3 class()
# Line 205  Line 206 
206    
207  sub score {  sub score {
208    my ($self) = @_;    my ($self) = @_;
   
209    return $self->{score};    return $self->{score};
210  }  }
211    
# Line 220  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 297  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 319  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);
333            get_identical_proteins($fid,\@matched_datasets);
334            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                }
344            }
345            get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
346    
347    # read sims + bbh (enrich BBHs with sims coordindates etc)          #add CELLO and SignalP later
348    # read pchs      }
   # read figfam match data from 48hr directory (BobO knows how do do this!)  
   # what sources of evidence did I miss?  
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 418  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+|0\.0);(\d+)-(\d+)/){
446                    my $raw_evalue = $1;
447                    my $from = $2;
448                    my $to = $3;
449                    my $evalue;
450                    if($raw_evalue =~/(\d+)\.(\d+)/){
451                        my $part2 = 1000 - $1;
452                        my $part1 = $2/100;
453                        $evalue = $part1."e-".$part2;
454                    }
455                    else{
456                        $evalue = "0.0";
457                    }
458    
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 518  Line 570 
570      }      }
571  }  }
572    
573    =head3 get_identical_proteins() (internal)
574    
575    This methods retrieves sims fills the internal data structures.
576    
577    =cut
578    
579    sub get_identical_proteins{
580    
581        my ($fid,$datasets_ref) = (@_);
582        my $fig = new FIG;
583        my @funcs = ();
584    
585        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
586    
587        foreach my $id (@maps_to) {
588            my ($tmp, $who);
589            if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
590                if ($id =~ /^fig\|/)           { $who = "FIG" }
591                elsif ($id =~ /^gi\|/)            { $who = "NCBI" }
592                elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }
593                elsif ($id =~ /^sp\|/)            { $who = "SwissProt" }
594                elsif ($id =~ /^uni\|/)           { $who = "UniProt" }
595                elsif ($id =~ /^tigr\|/)          { $who = "TIGR" }
596                elsif ($id =~ /^pir\|/)           { $who = "PIR" }
597                elsif ($id =~ /^kegg\|/)          { $who = "KEGG" }
598                elsif ($id =~ /^tr\|/)            { $who = "TrEMBL" }
599                elsif ($id =~ /^eric\|/)          { $who = "ASAP" }
600    
601                push(@funcs, [$id,$who,$tmp]);
602            }
603        }
604    
605        my ($dataset);
606        foreach my $row (@funcs){
607            my $id = $row->[0];
608            my $organism = $fig->org_of($fid);
609            my $who = $row->[1];
610            my $assignment = $row->[2];
611            $dataset = [ { name => 'class', value => "IDENTICAL" },
612                         { name => 'id' , value => $id},
613                         { name => 'organism', value => "$organism"} ,
614                         { name => 'database', value => $who },
615                         { name => 'description' , value => $assignment}
616                         ];
617            push (@{$datasets_ref} ,$dataset);
618        }
619    
620    }
621    
622    =head3 get_functional_coupling() (internal)
623    
624    This methods retrieves the functional coupling of a protein given a peg ID
625    
626    =cut
627    
628    sub get_functional_coupling{
629    
630        my ($fid,$datasets_ref) = (@_);
631        my $fig = new FIG;
632        my @funcs = ();
633    
634        # initialize some variables
635        my($sc,$neigh);
636    
637        # set default parameters for coupling and evidence
638        my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
639    
640        # get the fc data
641        my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
642    
643        # retrieve data
644        my @rows = map { ($sc,$neigh) = @$_;
645                         [$sc,$neigh,scalar $fig->function_of($neigh)]
646                      } @fc_data;
647    
648        my ($dataset);
649        foreach my $row (@rows){
650            my $id = $row->[1];
651            my $score = $row->[0];
652            my $description = $row->[2];
653            $dataset = [ { name => 'class', value => "FC" },
654                         { name => 'score' , value => $score},
655                         { name => 'id', value => "$id"} ,
656                         { name => 'description' , value => $description}
657                         ];
658            push (@{$datasets_ref} ,$dataset);
659        }
660    }
661    
662  =head3 get_sims_and_bbhs() (internal)  =head3 get_sims_and_bbhs() (internal)
663    
664  This methods retrieves sims and also BBHs and fills the internal data structures.  This methods retrieves sims and also BBHs and fills the internal data structures.
# Line 570  Line 711 
711  =cut  =cut
712    
713  sub new {  sub new {
714    my ($self) = @_;    my ($class,$dataset) = @_;
715    
716    
717      #$self = { acc => '',
718    #           description => '',
719    #           class => '',
720    #           type => '',
721    #           start => '',
722    #           stop => '',
723    #           evalue => '',
724    #           score => '',
725    #           display_method => '',
726    #           feature_id => '',
727    #           rank => '',
728    #           supports_annotation => '',
729    #           id => '',
730    #            organism => '',
731    #            who => ''
732    #         };
733    
734    $self = { acc => '',    my $self = { class => $dataset->{'class'},
735              description => '',                 type => $dataset->{'type'}
             class => '',  
             type => '',  
             start => '',  
             stop => '',  
             evalue => '',  
             score => '',  
             display_method => '',  
             feature_id => '',  
             rank => '',  
             supports_annotation => ''  
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 602  Line 750 
750    
751    return $self->{feature_id};    return $self->{feature_id};
752  }  }
753    
754    =head3 id (internal)
755    
756    Returns the ID  of the identical sequence
757    
758    =cut
759    
760    sub id {
761        my ($self) = @_;
762    
763        return $self->{id};
764    }
765    
766    =head3 organism (internal)
767    
768    Returns the organism  of the identical sequence
769    
770    =cut
771    
772    sub organism {
773        my ($self) = @_;
774    
775        return $self->{organism};
776    }
777    
778    =head3 database (internal)
779    
780    Returns the database of the identical sequence
781    
782    =cut
783    
784    sub database {
785        my ($self) = @_;
786    
787        return $self->{database};
788    }
789    
790    #package Observation::Identical;
791    #1;
792    #
793    #our @ISA = qw(Observation);  # inherits all the methods from Observation
794    
795    =head3 display_identical()
796    
797    If available use the function specified here to display the "raw" observation.
798    This code will display a table for the identical protein
799    
800    
801    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.
802    
803    =cut
804    
805    sub display_identical {
806        my ($self, $fid, $cgi) = @_;
807    
808        my $content;
809        my $array=Observation->get_objects($fid);
810    
811        my $all_domains = [];
812        my $count_identical = 0;
813        foreach my $thing (@$array) {
814            next if ($thing->class ne "IDENTICAL");
815            my $single_domain = [];
816            push(@$single_domain,$thing->class);
817            my $id = $thing->id;
818            $count_identical++;
819            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
820            push(@$single_domain,$thing->organism);
821            push(@$single_domain,$thing->database);
822            push(@$single_domain,$thing->description);
823            push(@$all_domains,$single_domain);
824        }
825    
826        if ($count_identical >0){
827            my $table_component = $self->application->component('DomainTable');
828    
829            $table_component->columns ([ { 'name' => 'Name', 'filter' => 1 },
830                                         { 'name' => 'ID' },
831                                         { 'name' => 'Organism' },
832                                         { 'name' => 'Database' },
833                                         { 'name' => 'Assignment' }
834                                         ]);
835            $table_component->data($all_domains);
836            $table_component->show_top_browse(1);
837            $table_component->show_bottom_browse(1);
838            $table_component->items_per_page(50);
839            $table_component->show_select_items_per_page(1);
840            $content .= $table_component->output();
841        }
842        else{
843            $content = "<p>This PEG does not have any essentially identical proteins</p>";
844        }
845        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.4  
changed lines
  Added in v.1.8

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3