[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.2, Tue Jun 12 16:51:53 2007 UTC revision 1.13, Fri Jun 22 20:30:38 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    
# Line 88  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 100  Line 102 
102    
103  =over 9  =over 9
104    
105  =item sim (seq)  =item IDENTICAL (seq)
106    
107  =item bbh (seq)  =item SIM (seq)
108    
109  =item pch (fc)  =item BBH (seq)
110    
111  =item figfam (seq)  =item PCH (fc)
112    
113  =item ipr (dom)  =item FIGFAM (seq)
114    
115  =item cdd (dom)  =item IPR (dom)
116    
117  =item pfam (dom)  =item CDD (dom)
118    
119  =item signalp (dom)  =item PFAM (dom)
120    
121  =item cello (loc)  =item SIGNALP_CELLO_TMPRED (loc)
122    
123  =item tmhmm (loc)  =item TMHMM (loc)
124    
125  =item hmmtop (loc)  =item HMMTOP (loc)
126    
127  =back  =back
128    
# Line 182  Line 184 
184    return $self->{stop};    return $self->{stop};
185  }  }
186    
187    =head3 start()
188    
189    Start of hit in query sequence.
190    
191    =cut
192    
193    sub qstart {
194        my ($self) = @_;
195    
196        return $self->{qstart};
197    }
198    
199    =head3 qstop()
200    
201    End of the hit in query sequence.
202    
203    =cut
204    
205    sub qstop {
206        my ($self) = @_;
207    
208        return $self->{qstop};
209    }
210    
211    =head3 hstart()
212    
213    Start of hit in hit sequence.
214    
215    =cut
216    
217    sub hstart {
218        my ($self) = @_;
219    
220        return $self->{hstart};
221    }
222    
223    =head3 end()
224    
225    End of the hit in hit sequence.
226    
227    =cut
228    
229    sub hstop {
230        my ($self) = @_;
231    
232        return $self->{hstop};
233    }
234    
235    =head3 qlength()
236    
237    length of the query sequence in similarities
238    
239    =cut
240    
241    sub qlength {
242        my ($self) = @_;
243    
244        return $self->{qlength};
245    }
246    
247    =head3 hlength()
248    
249    length of the hit sequence in similarities
250    
251    =cut
252    
253    sub hlength {
254        my ($self) = @_;
255    
256        return $self->{hlength};
257    }
258    
259    
260    
261  =head3 evalue()  =head3 evalue()
262    
263  E-value or P-Value if present.  E-value or P-Value if present.
# Line 205  Line 281 
281    
282  sub score {  sub score {
283    my ($self) = @_;    my ($self) = @_;
   
284    return $self->{score};    return $self->{score};
285  }  }
286    
287    
288  =head3 display_method()  =head3 display()
289    
290  If available use the function specified here to display the "raw" observation.  will be different for each type
 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.  
291    
292  =cut  =cut
293    
294  sub display_method {  sub display {
   my ($self) = @_;  
295    
296    # add code here    die "Abstract Method Called\n";
297    
   return $self->{display_method};  
298  }  }
299    
300    
301  =head3 rank()  =head3 rank()
302    
303  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 367 
367  - 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
368  - 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"
369    
370    my $datasets =    my $dataset
371       [       [
372         [ { name => 'acc', value => '1234' },         [ { name => 'acc', value => '1234' },
373          { name => 'from', value => '4' },          { name => 'from', value => '4' },
# Line 319  Line 389 
389  =cut  =cut
390    
391  sub get_objects {  sub get_objects {
392      my ($self,$fid) = @_;      my ($self,$fid,$classes) = @_;
393    
394    
395      my $objects = [];      my $objects = [];
396    my @matched_datasets=();    my @matched_datasets=();
397    
398    # call function that fetches attribut based observations      # call function that fetches attribute based observations
399    # returns an array of arrays of hashes    # returns an array of arrays of hashes
400    #  
401        if(scalar(@$classes) < 1){
402    get_attribute_based_observations($fid,\@matched_datasets);    get_attribute_based_observations($fid,\@matched_datasets);
403            get_sims_observations($fid,\@matched_datasets);
404            get_identical_proteins($fid,\@matched_datasets);
405            get_functional_coupling($fid,\@matched_datasets);
406        }
407        else{
408            my %domain_classes;
409            my $identical_flag=0;
410            my $pch_flag=0;
411            my $location_flag = 0;
412            my $sims_flag=0;
413            foreach my $class (@$classes){
414                if($class =~ /(IPR|CDD|PFAM)/){
415                    $domain_classes{$class} = 1;
416                }
417                elsif ($class eq "IDENTICAL")
418                {
419                    $identical_flag = 1;
420                }
421                elsif ($class eq "PCH")
422                {
423                    $pch_flag = 1;
424                }
425                elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)
426                {
427                    $location_flag = 1;
428                }
429                elsif ($class eq "SIM")
430                {
431                    $sims_flag = 1;
432                }
433            }
434    
435    # read sims + bbh (enrich BBHs with sims coordindates etc)          if ($identical_flag ==1)
436    # read pchs          {
437    # read figfam match data from 48hr directory (BobO knows how do do this!)              get_identical_proteins($fid,\@matched_datasets);
438    # what sources of evidence did I miss?          }
439            if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {
440                get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
441            }
442            if ($pch_flag == 1)
443            {
444                get_functional_coupling($fid,\@matched_datasets);
445            }
446            if ($sims_flag == 1)
447            {
448                get_sims_observations($fid,\@matched_datasets);
449            }
450    
451            if ($location_flag == 1)
452            {
453                get_attribute_based_location_observations($fid,\@matched_datasets);
454            }
455    
456        }
457    
458    foreach my $dataset (@matched_datasets) {    foreach my $dataset (@matched_datasets) {
459      my $object = $self->new();          my $object;
460      foreach my $attribute (@$dataset) {          if($dataset->{'type'} eq "dom"){
461        $object->{$attribute->{'name'}} = $attribute->{'value'};              $object = Observation::Domain->new($dataset);
462            }
463            if($dataset->{'class'} eq "PCH"){
464                $object = Observation::FC->new($dataset);
465            }
466            if ($dataset->{'class'} eq "IDENTICAL"){
467                $object = Observation::Identical->new($dataset);
468            }
469            if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
470                $object = Observation::Location->new($dataset);
471            }
472            if ($dataset->{'class'} eq "SIM"){
473                $object = Observation::Sims->new($dataset);
474      }      }
 #    $object->{$attribute->{'feature_id'}} = $attribute->{$fid};  
475      push (@$objects, $object);      push (@$objects, $object);
476      }      }
477    
   
478    return $objects;    return $objects;
479    
480  }  }
481    
482  =head1 Internal Methods  =head1 Internal Methods
# Line 415  Line 547 
547       return undef;       return undef;
548  }  }
549    
550    
551    sub get_attribute_based_domain_observations{
552    
553        # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
554        my ($fid,$domain_classes,$datasets_ref) = (@_);
555    
556        my $fig = new FIG;
557    
558        foreach my $attr_ref ($fig->get_attributes($fid)) {
559            my $key = @$attr_ref[1];
560            my @parts = split("::",$key);
561            my $class = $parts[0];
562    
563            if($domain_classes->{$parts[0]}){
564                my $val = @$attr_ref[2];
565                if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
566                    my $raw_evalue = $1;
567                    my $from = $2;
568                    my $to = $3;
569                    my $evalue;
570                    if($raw_evalue =~/(\d+)\.(\d+)/){
571                        my $part2 = 1000 - $1;
572                        my $part1 = $2/100;
573                        $evalue = $part1."e-".$part2;
574                    }
575                    else{
576                        $evalue = "0.0";
577                    }
578    
579                    my $dataset = {'class' => $class,
580                                   'acc' => $key,
581                                   'type' => "dom" ,
582                                   'evalue' => $evalue,
583                                   'start' => $from,
584                                   'stop' => $to
585                                   };
586    
587                    push (@{$datasets_ref} ,$dataset);
588                }
589            }
590        }
591    }
592    
593    sub get_attribute_based_location_observations{
594    
595        my ($fid,$datasets_ref) = (@_);
596        my $fig = new FIG;
597    
598        my $location_attributes = ['SignalP','CELLO','TMPRED'];
599    
600        my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};
601        foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
602            my $key = @$attr_ref[1];
603            my @parts = split("::",$key);
604            my $sub_class = $parts[0];
605            my $sub_key = $parts[1];
606            my $value = @$attr_ref[2];
607            if($sub_class eq "SignalP"){
608                if($sub_key eq "cleavage_site"){
609                    my @value_parts = split(";",$value);
610                    $dataset->{'cleavage_prob'} = $value_parts[0];
611                    $dataset->{'cleavage_loc'} = $value_parts[1];
612                }
613                elsif($sub_key eq "signal_peptide"){
614                    $dataset->{'signal_peptide_score'} = $value;
615                }
616            }
617            elsif($sub_class eq "CELLO"){
618                $dataset->{'cello_location'} = $sub_key;
619                $dataset->{'cello_score'} = $value;
620            }
621            elsif($sub_class eq "TMPRED"){
622                my @value_parts = split(";",$value);
623                $dataset->{'tmpred_score'} = $value_parts[0];
624                $dataset->{'tmpred_locations'} = $value_parts[1];
625            }
626        }
627    
628        push (@{$datasets_ref} ,$dataset);
629    
630    }
631    
632    
633  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
634    
635  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 487  Line 702 
702      }      }
703  }  }
704    
705    =head3 get_sims_observations() (internal)
706    
707    This methods retrieves sims fills the internal data structures.
708    
709    =cut
710    
711    sub get_sims_observations{
712    
713        my ($fid,$datasets_ref) = (@_);
714        my $fig = new FIG;
715    #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
716        my @sims= $fig->nsims($fid,100,1e-20,"all");
717        my ($dataset);
718        foreach my $sim (@sims){
719            my $hit = $sim->[1];
720            my $percent = $sim->[2];
721            my $evalue = $sim->[10];
722            my $qfrom = $sim->[6];
723            my $qto = $sim->[7];
724            my $hfrom = $sim->[8];
725            my $hto = $sim->[9];
726            my $qlength = $sim->[12];
727            my $hlength = $sim->[13];
728            my $db = get_database($hit);
729            my $func = $fig->function_of($hit);
730            my $organism = $fig->org_of($hit);
731    
732            $dataset = {'class' => 'SIM',
733                        'acc' => $hit,
734                        'identity' => $percent,
735                        'type' => 'seq',
736                        'evalue' => $evalue,
737                        'qstart' => $qfrom,
738                        'qstop' => $qto,
739                        'hstart' => $hfrom,
740                        'hstop' => $hto,
741                        'database' => $db,
742                        'organism' => $organism,
743                        'function' => $func,
744                        'qlength' => $qlength,
745                        'hlength' => $hlength
746                        };
747    
748            push (@{$datasets_ref} ,$dataset);
749        }
750    }
751    
752    =head3 get_database (internal)
753    This method gets the database association from the sequence id
754    
755    =cut
756    
757    sub get_database{
758        my ($id) = (@_);
759    
760        my ($db);
761        if ($id =~ /^fig\|/)              { $db = "FIG" }
762        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
763        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
764        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
765        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
766        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
767        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
768        elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }
769        elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
770        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
771        elsif ($id =~ /^img\|/)           { $db = "JGI" }
772    
773        return ($db);
774    
775    }
776    
777    =head3 get_identical_proteins() (internal)
778    
779    This methods retrieves sims fills the internal data structures.
780    
781    =cut
782    
783    sub get_identical_proteins{
784    
785        my ($fid,$datasets_ref) = (@_);
786        my $fig = new FIG;
787        my @funcs = ();
788    
789        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
790    
791        foreach my $id (@maps_to) {
792            my ($tmp, $who);
793            if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
794                $who = &get_database($id);
795                push(@funcs, [$id,$who,$tmp]);
796            }
797        }
798    
799        my ($dataset);
800        foreach my $row (@funcs){
801            my $id = $row->[0];
802            my $organism = $fig->org_of($fid);
803            my $who = $row->[1];
804            my $assignment = $row->[2];
805    
806            my $dataset = {'class' => 'IDENTICAL',
807                           'id' => $id,
808                           'organism' => $organism,
809                           'type' => 'seq',
810                           'database' => $who,
811                           'function' => $assignment
812                           };
813    
814            push (@{$datasets_ref} ,$dataset);
815        }
816    
817    }
818    
819    =head3 get_functional_coupling() (internal)
820    
821    This methods retrieves the functional coupling of a protein given a peg ID
822    
823    =cut
824    
825    sub get_functional_coupling{
826    
827        my ($fid,$datasets_ref) = (@_);
828        my $fig = new FIG;
829        my @funcs = ();
830    
831        # initialize some variables
832        my($sc,$neigh);
833    
834        # set default parameters for coupling and evidence
835        my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
836    
837        # get the fc data
838        my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
839    
840        # retrieve data
841        my @rows = map { ($sc,$neigh) = @$_;
842                         [$sc,$neigh,scalar $fig->function_of($neigh)]
843                      } @fc_data;
844    
845        my ($dataset);
846        foreach my $row (@rows){
847            my $id = $row->[1];
848            my $score = $row->[0];
849            my $description = $row->[2];
850            my $dataset = {'class' => 'PCH',
851                           'score' => $score,
852                           'id' => $id,
853                           'type' => 'fc',
854                           'function' => $description
855                           };
856    
857            push (@{$datasets_ref} ,$dataset);
858        }
859    }
860    
861  =head3 get_sims_and_bbhs() (internal)  =head3 get_sims_and_bbhs() (internal)
862    
863  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 539  Line 910 
910  =cut  =cut
911    
912  sub new {  sub new {
913    my ($self) = @_;    my ($class,$dataset) = @_;
914    
915    
916    $self = { acc => '',    #$self = { acc => '',
917              description => '',  #           description => '',
918              class => '',  #           class => '',
919              type => '',  #           type => '',
920              start => '',  #           start => '',
921              stop => '',  #           stop => '',
922              evalue => '',  #           evalue => '',
923              score => '',  #           score => '',
924              display_method => '',  #           display_method => '',
925              feature_id => '',  #           feature_id => '',
926              rank => '',  #           rank => '',
927              supports_annotation => ''  #           supports_annotation => '',
928    #           id => '',
929    #            organism => '',
930    #            who => ''
931    #         };
932    
933      my $self = { class => $dataset->{'class'},
934                   type => $dataset->{'type'}
935            };            };
936    
937    bless($self, 'Observation');    bless($self,$class);
938    
939    return $self;    return $self;
940  }  }
941    
942    =head3 identity (internal)
943    
944    Returns the % identity of the similar sequence
945    
946    =cut
947    
948    sub identity {
949        my ($self) = @_;
950    
951        return $self->{identity};
952    }
953    
954  =head3 feature_id (internal)  =head3 feature_id (internal)
955    
 Returns the ID  of the feature these Observations belong to.  
956    
957  =cut  =cut
958    
# Line 571  Line 961 
961    
962    return $self->{feature_id};    return $self->{feature_id};
963  }  }
964    
965    =head3 id (internal)
966    
967    Returns the ID  of the identical sequence
968    
969    =cut
970    
971    sub id {
972        my ($self) = @_;
973    
974        return $self->{id};
975    }
976    
977    =head3 organism (internal)
978    
979    Returns the organism  of the identical sequence
980    
981    =cut
982    
983    sub organism {
984        my ($self) = @_;
985    
986        return $self->{organism};
987    }
988    
989    =head3 function (internal)
990    
991    Returns the function of the identical sequence
992    
993    =cut
994    
995    sub function {
996        my ($self) = @_;
997    
998        return $self->{function};
999    }
1000    
1001    =head3 database (internal)
1002    
1003    Returns the database of the identical sequence
1004    
1005    =cut
1006    
1007    sub database {
1008        my ($self) = @_;
1009    
1010        return $self->{database};
1011    }
1012    
1013    
1014    
1015    ############################################################
1016    ############################################################
1017    package Observation::Identical;
1018    
1019    use base qw(Observation);
1020    
1021    sub new {
1022    
1023        my ($class,$dataset) = @_;
1024        my $self = $class->SUPER::new($dataset);
1025        $self->{id} = $dataset->{'id'};
1026        $self->{organism} = $dataset->{'organism'};
1027        $self->{function} = $dataset->{'function'};
1028        $self->{database} = $dataset->{'database'};
1029    
1030        bless($self,$class);
1031        return $self;
1032    }
1033    
1034    =head3 display()
1035    
1036    If available use the function specified here to display the "raw" observation.
1037    This code will display a table for the identical protein
1038    
1039    
1040    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
1041    dence.
1042    
1043    =cut
1044    
1045    sub display{
1046        my ($self, $cgi, $dataset) = @_;
1047    
1048        my $all_domains = [];
1049        my $count_identical = 0;
1050        my $content;
1051        foreach my $thing (@$dataset) {
1052            next if ($thing->class ne "IDENTICAL");
1053            my $single_domain = [];
1054            push(@$single_domain,$thing->database);
1055            my $id = $thing->id;
1056            $count_identical++;
1057            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1058            push(@$single_domain,$thing->organism);
1059            #push(@$single_domain,$thing->type);
1060            push(@$single_domain,$thing->function);
1061            push(@$all_domains,$single_domain);
1062        }
1063    
1064        if ($count_identical >0){
1065            $content = $all_domains;
1066        }
1067        else{
1068            $content = "<p>This PEG does not have any essentially identical proteins</p>";
1069        }
1070        return ($content);
1071    }
1072    
1073    1;
1074    
1075    
1076    #########################################
1077    #########################################
1078    package Observation::FC;
1079    1;
1080    
1081    use base qw(Observation);
1082    
1083    sub new {
1084    
1085        my ($class,$dataset) = @_;
1086        my $self = $class->SUPER::new($dataset);
1087        $self->{score} = $dataset->{'score'};
1088        $self->{id} = $dataset->{'id'};
1089        $self->{function} = $dataset->{'function'};
1090    
1091        bless($self,$class);
1092        return $self;
1093    }
1094    
1095    =head3 display()
1096    
1097    If available use the function specified here to display the "raw" observation.
1098    This code will display a table for the identical protein
1099    
1100    
1101    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
1102    dence.
1103    
1104    =cut
1105    
1106    sub display {
1107        my ($self,$cgi,$dataset, $fid) = @_;
1108    
1109        my $functional_data = [];
1110        my $count = 0;
1111        my $content;
1112    
1113        foreach my $thing (@$dataset) {
1114            my $single_domain = [];
1115            next if ($thing->class ne "PCH");
1116            $count++;
1117    
1118            # construct the score link
1119            my $score = $thing->score;
1120            my $toid = $thing->id;
1121            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1122            my $sc_link = "<a href=$link>$score</a>";
1123    
1124            push(@$single_domain,$sc_link);
1125            push(@$single_domain,$thing->id);
1126            push(@$single_domain,$thing->function);
1127            push(@$functional_data,$single_domain);
1128        }
1129    
1130        if ($count >0){
1131            $content = $functional_data;
1132        }
1133        else
1134        {
1135            $content = "<p>This PEG does not have any functional coupling</p>";
1136        }
1137        return ($content);
1138    }
1139    
1140    
1141    #########################################
1142    #########################################
1143    package Observation::Domain;
1144    
1145    use base qw(Observation);
1146    
1147    sub new {
1148    
1149        my ($class,$dataset) = @_;
1150        my $self = $class->SUPER::new($dataset);
1151        $self->{evalue} = $dataset->{'evalue'};
1152        $self->{acc} = $dataset->{'acc'};
1153        $self->{start} = $dataset->{'start'};
1154        $self->{stop} = $dataset->{'stop'};
1155    
1156        bless($self,$class);
1157        return $self;
1158    }
1159    
1160    sub display {
1161        my ($thing,$gd) = @_;
1162        my $lines = [];
1163        my $line_config = { 'title' => $thing->acc,
1164                            'short_title' => $thing->type,
1165                            'basepair_offset' => '1' };
1166        my $color = "4";
1167    
1168        my $line_data = [];
1169        my $links_list = [];
1170        my $descriptions = [];
1171    
1172        my $description_function;
1173        $description_function = {"title" => $thing->class,
1174                                 "value" => $thing->acc};
1175    
1176        push(@$descriptions,$description_function);
1177    
1178        my $score;
1179        $score = {"title" => "score",
1180                  "value" => $thing->evalue};
1181        push(@$descriptions,$score);
1182    
1183        my $link_id;
1184        if ($thing->acc =~/\w+::(\d+)/){
1185            $link_id = $1;
1186        }
1187    
1188        my $link;
1189        my $link_url;
1190        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"}
1191        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1192        else{$link_url = "NO_URL"}
1193    
1194        $link = {"link_title" => $thing->acc,
1195                 "link" => $link_url};
1196        push(@$links_list,$link);
1197    
1198        my $element_hash = {
1199            "title" => $thing->type,
1200            "start" => $thing->start,
1201            "end" =>  $thing->stop,
1202            "color"=> $color,
1203            "zlayer" => '2',
1204            "links_list" => $links_list,
1205            "description" => $descriptions};
1206    
1207        push(@$line_data,$element_hash);
1208        $gd->add_line($line_data, $line_config);
1209    
1210        return $gd;
1211    
1212    }
1213    
1214    #########################################
1215    #########################################
1216    package Observation::Location;
1217    
1218    use base qw(Observation);
1219    
1220    sub new {
1221    
1222        my ($class,$dataset) = @_;
1223        my $self = $class->SUPER::new($dataset);
1224        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1225        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1226        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1227        $self->{cello_location} = $dataset->{'cello_location'};
1228        $self->{cello_score} = $dataset->{'cello_score'};
1229        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1230        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1231    
1232        bless($self,$class);
1233        return $self;
1234    }
1235    
1236    sub display {
1237        my ($thing,$gd,$fid) = @_;
1238    
1239        my $fig= new FIG;
1240        my $length = length($fig->get_translation($fid));
1241    
1242        my $cleavage_prob;
1243        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1244        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1245        my $signal_peptide_score = $thing->signal_peptide_score;
1246        my $cello_location = $thing->cello_location;
1247        my $cello_score = $thing->cello_score;
1248        my $tmpred_score = $thing->tmpred_score;
1249        my @tmpred_locations = split(",",$thing->tmpred_locations);
1250    
1251        my $lines = [];
1252        my $line_config = { 'title' => 'Localization Evidence',
1253                            'short_title' => 'Local',
1254                            'basepair_offset' => '1' };
1255    
1256        #color is
1257        my $color = "5";
1258    
1259        my $line_data = [];
1260    
1261        if($cello_location){
1262            my $cello_descriptions = [];
1263            my $description_cello_location = {"title" => 'Best Cello Location',
1264                                              "value" => $cello_location};
1265    
1266            push(@$cello_descriptions,$description_cello_location);
1267    
1268            my $description_cello_score = {"title" => 'Cello Score',
1269                                           "value" => $cello_score};
1270    
1271            push(@$cello_descriptions,$description_cello_score);
1272    
1273            my $element_hash = {
1274                "title" => "CELLO",
1275                "start" => "1",
1276                "end" =>  $length + 1,
1277                "color"=> $color,
1278                "type" => 'box',
1279                "zlayer" => '2',
1280                "description" => $cello_descriptions};
1281    
1282            push(@$line_data,$element_hash);
1283        }
1284    
1285        my $color = "6";
1286        #if(0){
1287        if($tmpred_score){
1288            foreach my $tmpred (@tmpred_locations){
1289                my $descriptions = [];
1290                my ($begin,$end) =split("-",$tmpred);
1291                my $description_tmpred_score = {"title" => 'TMPRED score',
1292                                 "value" => $tmpred_score};
1293    
1294                push(@$descriptions,$description_tmpred_score);
1295    
1296                my $element_hash = {
1297                "title" => "transmembrane location",
1298                "start" => $begin + 1,
1299                "end" =>  $end + 1,
1300                "color"=> $color,
1301                "zlayer" => '5',
1302                "type" => 'smallbox',
1303                "description" => $descriptions};
1304    
1305                push(@$line_data,$element_hash);
1306            }
1307        }
1308    
1309        my $color = "1";
1310        if($signal_peptide_score){
1311            my $descriptions = [];
1312            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1313                                                    "value" => $signal_peptide_score};
1314    
1315            push(@$descriptions,$description_signal_peptide_score);
1316    
1317            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1318                                             "value" => $cleavage_prob};
1319    
1320            push(@$descriptions,$description_cleavage_prob);
1321    
1322            my $element_hash = {
1323                "title" => "SignalP",
1324                "start" => $cleavage_loc_begin - 2,
1325                "end" =>  $cleavage_loc_end + 3,
1326                "type" => 'bigbox',
1327                "color"=> $color,
1328                "zlayer" => '10',
1329                "description" => $descriptions};
1330    
1331            push(@$line_data,$element_hash);
1332        }
1333    
1334        $gd->add_line($line_data, $line_config);
1335    
1336        return ($gd);
1337    
1338    }
1339    
1340    sub cleavage_loc {
1341      my ($self) = @_;
1342    
1343      return $self->{cleavage_loc};
1344    }
1345    
1346    sub cleavage_prob {
1347      my ($self) = @_;
1348    
1349      return $self->{cleavage_prob};
1350    }
1351    
1352    sub signal_peptide_score {
1353      my ($self) = @_;
1354    
1355      return $self->{signal_peptide_score};
1356    }
1357    
1358    sub tmpred_score {
1359      my ($self) = @_;
1360    
1361      return $self->{tmpred_score};
1362    }
1363    
1364    sub tmpred_locations {
1365      my ($self) = @_;
1366    
1367      return $self->{tmpred_locations};
1368    }
1369    
1370    sub cello_location {
1371      my ($self) = @_;
1372    
1373      return $self->{cello_location};
1374    }
1375    
1376    sub cello_score {
1377      my ($self) = @_;
1378    
1379      return $self->{cello_score};
1380    }
1381    
1382    
1383    #########################################
1384    #########################################
1385    package Observation::Sims;
1386    
1387    use base qw(Observation);
1388    
1389    sub new {
1390    
1391        my ($class,$dataset) = @_;
1392        my $self = $class->SUPER::new($dataset);
1393        $self->{identity} = $dataset->{'identity'};
1394        $self->{acc} = $dataset->{'acc'};
1395        $self->{evalue} = $dataset->{'evalue'};
1396        $self->{qstart} = $dataset->{'qstart'};
1397        $self->{qstop} = $dataset->{'qstop'};
1398        $self->{hstart} = $dataset->{'hstart'};
1399        $self->{hstop} = $dataset->{'hstop'};
1400        $self->{database} = $dataset->{'database'};
1401        $self->{organism} = $dataset->{'organism'};
1402        $self->{function} = $dataset->{'function'};
1403        $self->{qlength} = $dataset->{'qlength'};
1404        $self->{hlength} = $dataset->{'hlength'};
1405    
1406        bless($self,$class);
1407        return $self;
1408    }
1409    
1410    =head3 display()
1411    
1412    If available use the function specified here to display the "raw" observation.
1413    This code will display a table for the similarities protein
1414    
1415    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.
1416    
1417    =cut
1418    
1419    sub display {
1420        my ($self,$cgi,$dataset) = @_;
1421    
1422        my $data = [];
1423        my $count = 0;
1424        my $content;
1425        my $fig = new FIG;
1426    
1427        foreach my $thing (@$dataset) {
1428            my $single_domain = [];
1429            next if ($thing->class ne "SIM");
1430            $count++;
1431    
1432            my $id = $thing->acc;
1433    
1434            # add the subsystem information
1435            my @in_sub  = $fig->peg_to_subsystems($id);
1436            my $in_sub;
1437    
1438            if (@in_sub > 0) {
1439                $in_sub = @in_sub;
1440    
1441                # RAE: add a javascript popup with all the subsystems
1442                my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1443                $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);
1444            } else {
1445                $in_sub = "&nbsp;";
1446            }
1447    
1448            # add evidence code with tool tip
1449            my $ev_codes=" &nbsp; ";
1450            my @ev_codes = "";
1451            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1452                my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);
1453                @ev_codes = ();
1454                foreach my $code (@codes) {
1455                    my $pretty_code = $code->[2];
1456                    if ($pretty_code =~ /;/) {
1457                        my ($cd, $ss) = split(";", $code->[2]);
1458                        $ss =~ s/_/ /g;
1459                        $pretty_code = $cd;# . " in " . $ss;
1460                    }
1461                    push(@ev_codes, $pretty_code);
1462                }
1463            }
1464    
1465            if (scalar(@ev_codes) && $ev_codes[0]) {
1466                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
1467                $ev_codes = $cgi->a(
1468                                    {
1469                                        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));
1470            }
1471    
1472            # add the aliases
1473            my $aliases = undef;
1474            $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );
1475            $aliases = &HTML::set_prot_links( $cgi, $aliases );
1476            $aliases ||= "&nbsp;";
1477    
1478            my $iden    = $thing->identity;
1479            my $ln1     = $thing->qlength;
1480            my $ln2     = $thing->hlength;
1481            my $b1      = $thing->qstart;
1482            my $e1      = $thing->qstop;
1483            my $b2      = $thing->hstart;
1484            my $e2      = $thing->hstop;
1485            my $d1      = abs($e1 - $b1) + 1;
1486            my $d2      = abs($e2 - $b2) + 1;
1487            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1488            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1489    
1490    
1491            push(@$single_domain,$thing->database);
1492            push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
1493            push(@$single_domain,$thing->evalue);
1494            push(@$single_domain,"$iden\%");
1495            push(@$single_domain,$reg1);
1496            push(@$single_domain,$reg2);
1497            push(@$single_domain,$in_sub);
1498            push(@$single_domain,$ev_codes);
1499            push(@$single_domain,$thing->organism);
1500            push(@$single_domain,$thing->function);
1501            push(@$single_domain,$aliases);
1502            push(@$data,$single_domain);
1503        }
1504    
1505        if ($count >0){
1506            $content = $data;
1507        }
1508        else
1509        {
1510            $content = "<p>This PEG does not have any similarities</p>";
1511        }
1512        return ($content);
1513    }
1514    
1515    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1516    
1517    
1518    
1519    ############################
1520    package Observation::Cluster;
1521    
1522    use base qw(Observation);
1523    
1524    sub new {
1525    
1526        my ($class,$dataset) = @_;
1527        my $self = $class->SUPER::new($dataset);
1528    
1529        bless($self,$class);
1530        return $self;
1531    }
1532    
1533    sub display {
1534        my ($self,$gd, $fid) = @_;
1535    
1536        my $fig = new FIG;
1537    
1538        #get the organism genome
1539        my $genome = $fig->genome_of($fid);
1540    
1541        # get location of the gene
1542        my $data = $fig->feature_location($fid);
1543        my ($contig, $beg, $end);
1544    
1545        if ($data =~ /(.*)_(\d+)_(\d+)$/){
1546            $contig = $1;
1547            $beg = $2;
1548            $end = $3;
1549        }
1550    
1551        my ($region_start, $region_end);
1552        if ($beg < $end)
1553        {
1554            $region_start = $beg - 4000;
1555            $region_end = $end+4000;
1556        }
1557        else
1558        {
1559            $region_end = $end+4000;
1560            $region_start = $beg-4000;
1561        }
1562    
1563        # call genes in region
1564        my ($features, $reg_beg, $reg_end) = $fig->genes_in_region($genome, $contig, $region_start, $region_stop);
1565    
1566        # call to see what is coupled to main peg
1567        my ($ref_coupled_to) = $fig->coupled_to($fid);
1568        my @coupled_to = @$ref_coupled_to;
1569        my @array = ();
1570    
1571        foreach my $key (@coupled_to)
1572        {
1573            my $coupled_peg = @$key[0];
1574            my $score = @$key[1];
1575    
1576            my $tmp = $score . "_" . $coupled_peg;
1577            push (@array, $tmp);
1578        }
1579    
1580        my @new_array = sort {lc($b) cmp lc($a)} (@array);
1581        my %hash = ();
1582        my $count = 2;
1583    
1584        foreach my $element (@new_array)
1585        {
1586            my ($score, $peg) = split ("_", $element);
1587            $hash{$peg} = $count;
1588            $count++;
1589        }
1590        foreach my $feature ($@genes_in_region)
1591        {
1592            # start populatign the $gd object (shapes and colors, links)
1593    
1594    
1595        }
1596    
1597        # call coupling_and_evidence
1598    
1599        # read through each result and get the top hit
1600    
1601        # call get_genes_in_region foreach of the top hit
1602    
1603        foreach $tophit (@whatever)
1604        {
1605            #populate $gd object with the top hits (shapes, colors, links);
1606    
1607        }
1608    
1609    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.13

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3