[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.8, Tue Jun 19 22:11:25 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 Table;  use HTML;
9    
10  1;  1;
11    
# Line 24  Line 24 
24    
25  Example:  Example:
26    
27    
28  use FIG;  use FIG;
29  use Observation;  use Observation;
30    
# Line 101  Line 102 
102    
103  =over 9  =over 9
104    
105    =item IDENTICAL (seq)
106    
107  =item SIM (seq)  =item SIM (seq)
108    
109  =item BBH (seq)  =item BBH (seq)
# Line 115  Line 118 
118    
119  =item PFAM (dom)  =item PFAM (dom)
120    
121  =item SIGNALP (dom)  =item SIGNALP_CELLO_TMPRED (loc)
   
 =item  CELLO(loc)  
122    
123  =item TMHMM (loc)  =item TMHMM (loc)
124    
# Line 183  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 210  Line 285 
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    
# Line 334  Line 405 
405          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
406      }      }
407      else{      else{
         #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based  
408          my %domain_classes;          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){          foreach my $class (@$classes){
414              if($class =~/(IPR|CDD|PFAM)/){              if($class =~/(IPR|CDD|PFAM)/){
415                  $domain_classes{$class} = 1;                  $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            if ($identical_flag ==1)
436            {
437                get_identical_proteins($fid,\@matched_datasets);
438            }
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);          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    
         #add CELLO and SignalP later  
456      }      }
457    
458      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 352  Line 460 
460          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
461              $object = Observation::Domain->new($dataset);              $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            }
475          push (@$objects, $object);          push (@$objects, $object);
476      }      }
477    
# Line 470  Line 590 
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 552  Line 712 
712    
713      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
714      my $fig = new FIG;      my $fig = new FIG;
715      my @sims= $fig->nsims($fid,100,1e-20,"fig");  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
716        my @sims= $fig->nsims($fid,100,1e-20,"all");
717      my ($dataset);      my ($dataset);
718      foreach my $sim (@sims){      foreach my $sim (@sims){
719          my $hit = $sim->[1];          my $hit = $sim->[1];
720            my $percent = $sim->[2];
721          my $evalue = $sim->[10];          my $evalue = $sim->[10];
722          my $from = $sim->[8];          my $qfrom = $sim->[6];
723          my $to = $sim->[9];          my $qto = $sim->[7];
724          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
725                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
726                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
727                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
728                          { name => 'start', value => $from},          my $db = get_database($hit);
729                          { name => 'stop' , value => $to}          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);      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)  =head3 get_identical_proteins() (internal)
778    
779  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 587  Line 791 
791      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
792          my ($tmp, $who);          my ($tmp, $who);
793          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
794              if ($id =~ /^fig\|/)           { $who = "FIG" }              $who = &get_database($id);
             elsif ($id =~ /^gi\|/)            { $who = "NCBI" }  
             elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }  
             elsif ($id =~ /^sp\|/)            { $who = "SwissProt" }  
             elsif ($id =~ /^uni\|/)           { $who = "UniProt" }  
             elsif ($id =~ /^tigr\|/)          { $who = "TIGR" }  
             elsif ($id =~ /^pir\|/)           { $who = "PIR" }  
             elsif ($id =~ /^kegg\|/)          { $who = "KEGG" }  
             elsif ($id =~ /^tr\|/)            { $who = "TrEMBL" }  
             elsif ($id =~ /^eric\|/)          { $who = "ASAP" }  
   
795              push(@funcs, [$id,$who,$tmp]);              push(@funcs, [$id,$who,$tmp]);
796          }          }
797      }      }
# Line 608  Line 802 
802          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($fid);
803          my $who = $row->[1];          my $who = $row->[1];
804          my $assignment = $row->[2];          my $assignment = $row->[2];
805          $dataset = [ { name => 'class', value => "IDENTICAL" },  
806                       { name => 'id' , value => $id},          my $dataset = {'class' => 'IDENTICAL',
807                       { name => 'organism', value => "$organism"} ,                         'id' => $id,
808                       { name => 'database', value => $who },                         'organism' => $organism,
809                       { name => 'description' , value => $assignment}                         'type' => 'seq',
810                       ];                         'database' => $who,
811                           'function' => $assignment
812                           };
813    
814          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
815      }      }
816    
# Line 650  Line 847 
847          my $id = $row->[1];          my $id = $row->[1];
848          my $score = $row->[0];          my $score = $row->[0];
849          my $description = $row->[2];          my $description = $row->[2];
850          $dataset = [ { name => 'class', value => "FC" },          my $dataset = {'class' => 'PCH',
851                       { name => 'score' , value => $score},                         'score' => $score,
852                       { name => 'id', value => "$id"} ,                         'id' => $id,
853                       { name => 'description' , value => $description}                         'type' => 'fc',
854                       ];                         'function' => $description
855                           };
856    
857          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
858      }      }
859  }  }
# Line 740  Line 939 
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    
956    
# Line 775  Line 986 
986      return $self->{organism};      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)  =head3 database (internal)
1002    
1003  Returns the database of the identical sequence  Returns the database of the identical sequence
# Line 787  Line 1010 
1010      return $self->{database};      return $self->{database};
1011  }  }
1012    
 #package Observation::Identical;  
 #1;  
 #  
 #our @ISA = qw(Observation);  # inherits all the methods from Observation  
1013    
1014  =head3 display_identical()  
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.  If available use the function specified here to display the "raw" observation.
1037  This code will display a table for the identical protein  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 evidence.  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  =cut
1044    
1045  sub display_identical {  sub display{
1046      my ($self, $fid, $cgi) = @_;      my ($self, $cgi, $dataset) = @_;
   
     my $content;  
     my $array=Observation->get_objects($fid);  
1047    
1048      my $all_domains = [];      my $all_domains = [];
1049      my $count_identical = 0;      my $count_identical = 0;
1050      foreach my $thing (@$array) {      my $content;
1051        foreach my $thing (@$dataset) {
1052          next if ($thing->class ne "IDENTICAL");          next if ($thing->class ne "IDENTICAL");
1053          my $single_domain = [];          my $single_domain = [];
1054          push(@$single_domain,$thing->class);          push(@$single_domain,$thing->database);
1055          my $id = $thing->id;          my $id = $thing->id;
1056          $count_identical++;          $count_identical++;
1057          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1058          push(@$single_domain,$thing->organism);          push(@$single_domain,$thing->organism);
1059          push(@$single_domain,$thing->database);          #push(@$single_domain,$thing->type);
1060          push(@$single_domain,$thing->description);          push(@$single_domain,$thing->function);
1061          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1062      }      }
1063    
1064      if ($count_identical >0){      if ($count_identical >0){
1065          my $table_component = $self->application->component('DomainTable');          $content = $all_domains;
   
         $table_component->columns ([ { 'name' => 'Name', 'filter' => 1 },  
                                      { 'name' => 'ID' },  
                                      { 'name' => 'Organism' },  
                                      { 'name' => 'Database' },  
                                      { 'name' => 'Assignment' }  
                                      ]);  
         $table_component->data($all_domains);  
         $table_component->show_top_browse(1);  
         $table_component->show_bottom_browse(1);  
         $table_component->items_per_page(50);  
         $table_component->show_select_items_per_page(1);  
         $content .= $table_component->output();  
1066      }      }
1067      else{      else{
1068          $content = "<p>This PEG does not have any essentially identical proteins</p>";          $content = "<p>This PEG does not have any essentially identical proteins</p>";
# Line 845  Line 1070 
1070      return ($content);      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;  package Observation::Domain;
1144    
1145  use base qw(Observation);  use base qw(Observation);
# Line 886  Line 1181 
1181      push(@$descriptions,$score);      push(@$descriptions,$score);
1182    
1183      my $link_id;      my $link_id;
1184      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/\w+::(\d+)/){
1185          $link_id = $1;          $link_id = $1;
1186      }      }
1187    
1188      my $link;      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,      $link = {"link_title" => $thing->acc,
1195               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1196      push(@$links_list,$link);      push(@$links_list,$link);
1197    
1198      my $element_hash = {      my $element_hash = {
# Line 911  Line 1211 
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.8  
changed lines
  Added in v.1.13

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3