[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.1, Thu May 31 02:08:28 2007 UTC revision 1.10, Wed Jun 20 20:55:36 2007 UTC
# Line 5  Line 5 
5    
6  use strict;  use strict;
7  use warnings;  use warnings;
8    use HTML;
9    
10  1;  1;
11    
# Line 23  Line 24 
24    
25  Example:  Example:
26    
27    
28  use FIG;  use FIG;
29  use Observation;  use Observation;
30    
31  my $fig= new FIG;  my $fig= new FIG;
32  my $fid="fig|83333.1.peg.3";  my $fid="fig|83333.1.peg.3";
33    
34  $fig->get_evidence($fid);  my $observations = Observation::get_objects($fid);
35    foreach my $observation (@$observations) {
36        print "ID: " . $fid . "\n";
37        print "Start: " . $observation->start() . "\n";
38        ...
39    }
40    
41  B<return an array of objects>  B<return an array of objects>
42    
43    
# Line 82  Line 90 
90  sub description {  sub description {
91    my ($self) = @_;    my ($self) = @_;
92    
93    return $self->{acc};    return $self->{description};
94  }  }
95    
96  =head3 class()  =head3 class()
# Line 94  Line 102 
102    
103  =over 9  =over 9
104    
105  =item sim (seq)  =item IDENTICAL (seq)
106    
107    =item SIM (seq)
108    
109  =item bbh (seq)  =item BBH (seq)
110    
111  =item pch (fc)  =item PCH (fc)
112    
113  =item figfam (seq)  =item FIGFAM (seq)
114    
115  =item ipr (dom)  =item IPR (dom)
116    
117  =item cdd (dom)  =item CDD (dom)
118    
119  =item pfam (dom)  =item PFAM (dom)
120    
121  =item signalp (dom)  =item SIGNALP (dom)
122    
123  =item cello (loc)  =item  CELLO(loc)
124    
125  =item tmhmm (loc)  =item TMHMM (loc)
126    
127  =item hmmtop (loc)  =item HMMTOP (loc)
128    
129  =back  =back
130    
# Line 199  Line 209 
209    
210  sub score {  sub score {
211    my ($self) = @_;    my ($self) = @_;
   
212    return $self->{score};    return $self->{score};
213  }  }
214    
# Line 214  Line 223 
223    
224  =cut  =cut
225    
226  sub display_method {  sub display {
   my ($self) = @_;  
227    
228    # add code here    die "Abstract Method Called\n";
229    
   return $self->{display_method};  
230  }  }
231    
232    
233  =head3 rank()  =head3 rank()
234    
235  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 291  Line 299 
299  - 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
300  - 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"
301    
302    my $datasets =    my $dataset
303       [       [
304         [ { name => 'acc', value => '1234' },         [ { name => 'acc', value => '1234' },
305          { name => 'from', value => '4' },          { name => 'from', value => '4' },
# Line 313  Line 321 
321  =cut  =cut
322    
323  sub get_objects {  sub get_objects {
324      my ($self,$fid) = @_;      my ($self,$fid,$classes) = @_;
325    
326    
327      my $objects = [];      my $objects = [];
328    my @matched_datasets=();    my @matched_datasets=();
329    
330    # call function that fetches attribut based observations      # call function that fetches attribute based observations
331    # returns an array of arrays of hashes    # returns an array of arrays of hashes
332    #  
333        if(scalar(@$classes) < 1){
334    get_attribute_based_observations($fid,\@matched_datasets);    get_attribute_based_observations($fid,\@matched_datasets);
335            get_sims_observations($fid,\@matched_datasets);
336            get_identical_proteins($fid,\@matched_datasets);
337            get_functional_coupling($fid,\@matched_datasets);
338        }
339        else{
340            #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based
341            my %domain_classes;
342            my $identical_flag=0;
343            my $pch_flag=0;
344            my $sims_flag=0;
345            foreach my $class (@$classes){
346                if($class =~ /(IPR|CDD|PFAM)/){
347                    $domain_classes{$class} = 1;
348                }
349                elsif ($class eq "IDENTICAL")
350                {
351                    $identical_flag = 1;
352                }
353                elsif ($class eq "PCH")
354                {
355                    $pch_flag = 1;
356                }
357                elsif ($class eq "SIM")
358                {
359                    $sims_flag = 1;
360                }
361            }
362    
363            if ($identical_flag ==1)
364            {
365                get_identical_proteins($fid,\@matched_datasets);
366            }
367            if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {
368                get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
369            }
370            if ($pch_flag == 1)
371            {
372                get_functional_coupling($fid,\@matched_datasets);
373            }
374            if ($sims_flag == 1)
375            {
376                get_sims_observations($fid,\@matched_datasets);
377            }
378    
379    # read sims + bbh (enrich BBHs with sims coordindates etc)          #add CELLO and SignalP later
380    # read pchs      }
   # read figfam match data from 48hr directory (BobO knows how do do this!)  
   # what sources of evidence did I miss?  
381    
382    foreach my $dataset (@matched_datasets) {    foreach my $dataset (@matched_datasets) {
383      my $object = $self->new();          my $object;
384      foreach my $attribute (@$dataset) {          if($dataset->{'type'} eq "dom"){
385        $object->{$attribute->{'name'}} = $attribute->{'value'};              $object = Observation::Domain->new($dataset);
386            }
387            if($dataset->{'class'} eq "PCH"){
388                $object = Observation::FC->new($dataset);
389            }
390            if ($dataset->{'class'} eq "IDENTICAL"){
391                $object = Observation::Identical->new($dataset);
392            }
393            if ($dataset->{'class'} eq "SIM"){
394                $object = Observation::Sims->new($dataset);
395      }      }
 #    $object->{$attribute->{'feature_id'}} = $attribute->{$fid};  
396      push (@$objects, $object);      push (@$objects, $object);
397      }      }
398    
   
399    return $objects;    return $objects;
400    
401  }  }
402    
403  =head1 Internal Methods  =head1 Internal Methods
# Line 409  Line 468 
468       return undef;       return undef;
469  }  }
470    
471    
472    sub get_attribute_based_domain_observations{
473    
474        # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
475        my ($fid,$domain_classes,$datasets_ref) = (@_);
476    
477        my $fig = new FIG;
478    
479        foreach my $attr_ref ($fig->get_attributes($fid)) {
480            my $key = @$attr_ref[1];
481            my @parts = split("::",$key);
482            my $class = $parts[0];
483    
484            if($domain_classes->{$parts[0]}){
485                my $val = @$attr_ref[2];
486                if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
487                    my $raw_evalue = $1;
488                    my $from = $2;
489                    my $to = $3;
490                    my $evalue;
491                    if($raw_evalue =~/(\d+)\.(\d+)/){
492                        my $part2 = 1000 - $1;
493                        my $part1 = $2/100;
494                        $evalue = $part1."e-".$part2;
495                    }
496                    else{
497                        $evalue = "0.0";
498                    }
499    
500                    my $dataset = {'class' => $class,
501                                   'acc' => $key,
502                                   'type' => "dom" ,
503                                   'evalue' => $evalue,
504                                   'start' => $from,
505                                   'stop' => $to
506                                   };
507    
508                    push (@{$datasets_ref} ,$dataset);
509                }
510            }
511        }
512    }
513    
514  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
515    
516  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 481  Line 583 
583      }      }
584  }  }
585    
586    =head3 get_sims_observations() (internal)
587    
588    This methods retrieves sims fills the internal data structures.
589    
590    =cut
591    
592    sub get_sims_observations{
593    
594        my ($fid,$datasets_ref) = (@_);
595        my $fig = new FIG;
596        my @sims= $fig->nsims($fid,100,1e-20,"fig");
597        my ($dataset);
598        foreach my $sim (@sims){
599            my $hit = $sim->[1];
600            my $evalue = $sim->[10];
601            my $from = $sim->[8];
602            my $to = $sim->[9];
603            $dataset = {'class' => 'SIM',
604                        'acc' => $hit,
605                        'type' => 'seq',
606                        'evalue' => $evalue,
607                        'start' => $from,
608                        'stop' => $to
609                        };
610    
611            push (@{$datasets_ref} ,$dataset);
612        }
613    }
614    
615    =head3 get_identical_proteins() (internal)
616    
617    This methods retrieves sims fills the internal data structures.
618    
619    =cut
620    
621    sub get_identical_proteins{
622    
623        my ($fid,$datasets_ref) = (@_);
624        my $fig = new FIG;
625        my @funcs = ();
626    
627        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
628    
629        foreach my $id (@maps_to) {
630            my ($tmp, $who);
631            if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
632                if ($id =~ /^fig\|/)           { $who = "FIG" }
633                elsif ($id =~ /^gi\|/)            { $who = "NCBI" }
634                elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }
635                elsif ($id =~ /^sp\|/)            { $who = "SwissProt" }
636                elsif ($id =~ /^uni\|/)           { $who = "UniProt" }
637                elsif ($id =~ /^tigr\|/)          { $who = "TIGR" }
638                elsif ($id =~ /^pir\|/)           { $who = "PIR" }
639                elsif ($id =~ /^kegg\|/)          { $who = "KEGG" }
640                elsif ($id =~ /^tr\|/)            { $who = "TrEMBL" }
641                elsif ($id =~ /^eric\|/)          { $who = "ASAP" }
642    
643                push(@funcs, [$id,$who,$tmp]);
644            }
645        }
646    
647        my ($dataset);
648        foreach my $row (@funcs){
649            my $id = $row->[0];
650            my $organism = $fig->org_of($fid);
651            my $who = $row->[1];
652            my $assignment = $row->[2];
653    
654            my $dataset = {'class' => 'IDENTICAL',
655                           'id' => $id,
656                           'organism' => $organism,
657                           'type' => 'seq',
658                           'database' => $who,
659                           'function' => $assignment
660                           };
661    
662            push (@{$datasets_ref} ,$dataset);
663        }
664    
665    }
666    
667    =head3 get_functional_coupling() (internal)
668    
669    This methods retrieves the functional coupling of a protein given a peg ID
670    
671    =cut
672    
673    sub get_functional_coupling{
674    
675        my ($fid,$datasets_ref) = (@_);
676        my $fig = new FIG;
677        my @funcs = ();
678    
679        # initialize some variables
680        my($sc,$neigh);
681    
682        # set default parameters for coupling and evidence
683        my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
684    
685        # get the fc data
686        my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
687    
688        # retrieve data
689        my @rows = map { ($sc,$neigh) = @$_;
690                         [$sc,$neigh,scalar $fig->function_of($neigh)]
691                      } @fc_data;
692    
693        my ($dataset);
694        foreach my $row (@rows){
695            my $id = $row->[1];
696            my $score = $row->[0];
697            my $description = $row->[2];
698            my $dataset = {'class' => 'PCH',
699                           'score' => $score,
700                           'id' => $id,
701                           'type' => 'fc',
702                           'function' => $description
703                           };
704    
705            push (@{$datasets_ref} ,$dataset);
706        }
707    }
708    
709  =head3 get_sims_and_bbhs() (internal)  =head3 get_sims_and_bbhs() (internal)
710    
711  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 533  Line 758 
758  =cut  =cut
759    
760  sub new {  sub new {
761    my ($self) = @_;    my ($class,$dataset) = @_;
762    
763    $self = { acc => '',  
764              description => '',    #$self = { acc => '',
765              class => '',  #           description => '',
766              type => '',  #           class => '',
767              start => '',  #           type => '',
768              stop => '',  #           start => '',
769              evalue => '',  #           stop => '',
770              score => '',  #           evalue => '',
771              display_method => '',  #           score => '',
772              feature_id => '',  #           display_method => '',
773              rank => '',  #           feature_id => '',
774              supports_annotation => ''  #           rank => '',
775    #           supports_annotation => '',
776    #           id => '',
777    #            organism => '',
778    #            who => ''
779    #         };
780    
781      my $self = { class => $dataset->{'class'},
782                   type => $dataset->{'type'}
783            };            };
784    
785    bless($self, 'Observation');    bless($self,$class);
786    
787    return $self;    return $self;
788  }  }
789    
790  =head3 feature_id (internal)  =head3 feature_id (internal)
791    
 Returns the ID  of the feature these Observations belong to.  
792    
793  =cut  =cut
794    
# Line 565  Line 797 
797    
798    return $self->{feature_id};    return $self->{feature_id};
799  }  }
800    
801    =head3 id (internal)
802    
803    Returns the ID  of the identical sequence
804    
805    =cut
806    
807    sub id {
808        my ($self) = @_;
809    
810        return $self->{id};
811    }
812    
813    =head3 organism (internal)
814    
815    Returns the organism  of the identical sequence
816    
817    =cut
818    
819    sub organism {
820        my ($self) = @_;
821    
822        return $self->{organism};
823    }
824    
825    =head3 function (internal)
826    
827    Returns the function of the identical sequence
828    
829    =cut
830    
831    sub function {
832        my ($self) = @_;
833    
834        return $self->{function};
835    }
836    
837    =head3 database (internal)
838    
839    Returns the database of the identical sequence
840    
841    =cut
842    
843    sub database {
844        my ($self) = @_;
845    
846        return $self->{database};
847    }
848    
849    
850    ############################################################
851    ############################################################
852    package Observation::Identical;
853    
854    use base qw(Observation);
855    
856    sub new {
857    
858        my ($class,$dataset) = @_;
859        my $self = $class->SUPER::new($dataset);
860        $self->{id} = $dataset->{'id'};
861        $self->{organism} = $dataset->{'organism'};
862        $self->{function} = $dataset->{'function'};
863        $self->{database} = $dataset->{'database'};
864    
865        bless($self,$class);
866        return $self;
867    }
868    
869    =head3 display()
870    
871    If available use the function specified here to display the "raw" observation.
872    This code will display a table for the identical protein
873    
874    
875    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
876    dence.
877    
878    =cut
879    
880    sub display{
881        my ($self, $cgi, $dataset) = @_;
882    
883        my $all_domains = [];
884        my $count_identical = 0;
885        my $content;
886        foreach my $thing (@$dataset) {
887            next if ($thing->class ne "IDENTICAL");
888            my $single_domain = [];
889            push(@$single_domain,$thing->database);
890            my $id = $thing->id;
891            $count_identical++;
892            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
893            push(@$single_domain,$thing->organism);
894            #push(@$single_domain,$thing->type);
895            push(@$single_domain,$thing->function);
896            push(@$all_domains,$single_domain);
897        }
898    
899        if ($count_identical >0){
900            $content = $all_domains;
901        }
902        else{
903            $content = "<p>This PEG does not have any essentially identical proteins</p>";
904        }
905        return ($content);
906    }
907    
908    1;
909    
910    
911    #########################################
912    #########################################
913    package Observation::FC;
914    1;
915    
916    use base qw(Observation);
917    
918    sub new {
919    
920        my ($class,$dataset) = @_;
921        my $self = $class->SUPER::new($dataset);
922        $self->{score} = $dataset->{'score'};
923        $self->{id} = $dataset->{'id'};
924        $self->{function} = $dataset->{'function'};
925    
926        bless($self,$class);
927        return $self;
928    }
929    
930    =head3 display()
931    
932    If available use the function specified here to display the "raw" observation.
933    This code will display a table for the identical protein
934    
935    
936    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
937    dence.
938    
939    =cut
940    
941    sub display {
942        my ($self,$cgi,$dataset, $fid) = @_;
943    
944        my $functional_data = [];
945        my $count = 0;
946        my $content;
947    
948        foreach my $thing (@$dataset) {
949            my $single_domain = [];
950            next if ($thing->class ne "PCH");
951            $count++;
952    
953            # construct the score link
954            my $score = $thing->score;
955            my $toid = $thing->id;
956            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
957            my $sc_link = "<a href=$link>$score</a>";
958    
959            push(@$single_domain,$sc_link);
960            push(@$single_domain,$thing->id);
961            push(@$single_domain,$thing->function);
962            push(@$functional_data,$single_domain);
963        }
964    
965        if ($count >0){
966            $content = $functional_data;
967        }
968        else
969        {
970            $content = "<p>This PEG does not have any functional coupling</p>";
971        }
972        return ($content);
973    }
974    
975    
976    #########################################
977    #########################################
978    package Observation::Domain;
979    
980    use base qw(Observation);
981    
982    sub new {
983    
984        my ($class,$dataset) = @_;
985        my $self = $class->SUPER::new($dataset);
986        $self->{evalue} = $dataset->{'evalue'};
987        $self->{acc} = $dataset->{'acc'};
988        $self->{start} = $dataset->{'start'};
989        $self->{stop} = $dataset->{'stop'};
990    
991        bless($self,$class);
992        return $self;
993    }
994    
995    sub display {
996        my ($thing,$gd) = @_;
997        my $lines = [];
998        my $line_config = { 'title' => $thing->acc,
999                            'short_title' => $thing->type,
1000                            'basepair_offset' => '1' };
1001        my $color = "4";
1002    
1003        my $line_data = [];
1004        my $links_list = [];
1005        my $descriptions = [];
1006    
1007        my $description_function;
1008        $description_function = {"title" => $thing->class,
1009                                 "value" => $thing->acc};
1010    
1011        push(@$descriptions,$description_function);
1012    
1013        my $score;
1014        $score = {"title" => "score",
1015                  "value" => $thing->evalue};
1016        push(@$descriptions,$score);
1017    
1018        my $link_id;
1019        if ($thing->acc =~/CDD::(\d+)/){
1020            $link_id = $1;
1021        }
1022    
1023        my $link;
1024        $link = {"link_title" => $thing->acc,
1025                 "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};
1026        push(@$links_list,$link);
1027    
1028        my $element_hash = {
1029            "title" => $thing->type,
1030            "start" => $thing->start,
1031            "end" =>  $thing->stop,
1032            "color"=> $color,
1033            "zlayer" => '2',
1034            "links_list" => $links_list,
1035            "description" => $descriptions};
1036    
1037        push(@$line_data,$element_hash);
1038        $gd->add_line($line_data, $line_config);
1039    
1040        return $gd;
1041    
1042    }
1043    
1044    #########################################
1045    #########################################
1046    package Observation::Sims;
1047    
1048    use base qw(Observation);
1049    
1050    sub new {
1051    
1052        my ($class,$dataset) = @_;
1053        my $self = $class->SUPER::new($dataset);
1054        $self->{acc} = $dataset->{'acc'};
1055        $self->{evalue} = $dataset->{'evalue'};
1056        $self->{start} = $dataset->{'start'};
1057        $self->{stop} = $dataset->{'stop'};
1058    
1059        bless($self,$class);
1060        return $self;
1061    }
1062    
1063    =head3 display()
1064    
1065    If available use the function specified here to display the "raw" observation.
1066    This code will display a table for the similarities protein
1067    
1068    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.
1069    
1070    =cut
1071    
1072    sub display {
1073        my ($self,$cgi,$dataset) = @_;
1074    
1075        my $data = [];
1076        my $count = 0;
1077        my $content;
1078    
1079        foreach my $thing (@$dataset) {
1080            my $single_domain = [];
1081            next if ($thing->class ne "SIM");
1082            $count++;
1083    
1084            push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
1085            push(@$single_domain,$thing->start);
1086            push(@$single_domain,$thing->stop);
1087            push(@$single_domain,$thing->evalue);
1088            push(@$data,$single_domain);
1089        }
1090    
1091        if ($count >0){
1092            $content = $data;
1093        }
1094        else
1095        {
1096            $content = "<p>This PEG does not have any similarities</p>";
1097        }
1098        return ($content);
1099    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3