[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.11, Thu Jun 21 21:15:23 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 183  Line 186 
186    return $self->{stop};    return $self->{stop};
187  }  }
188    
189    =head3 start()
190    
191    Start of hit in query sequence.
192    
193    =cut
194    
195    sub qstart {
196        my ($self) = @_;
197    
198        return $self->{qstart};
199    }
200    
201    =head3 qstop()
202    
203    End of the hit in query sequence.
204    
205    =cut
206    
207    sub qstop {
208        my ($self) = @_;
209    
210        return $self->{qstop};
211    }
212    
213    =head3 hstart()
214    
215    Start of hit in hit sequence.
216    
217    =cut
218    
219    sub hstart {
220        my ($self) = @_;
221    
222        return $self->{hstart};
223    }
224    
225    =head3 end()
226    
227    End of the hit in hit sequence.
228    
229    =cut
230    
231    sub hstop {
232        my ($self) = @_;
233    
234        return $self->{hstop};
235    }
236    
237    =head3 qlength()
238    
239    length of the query sequence in similarities
240    
241    =cut
242    
243    sub qlength {
244        my ($self) = @_;
245    
246        return $self->{qlength};
247    }
248    
249    =head3 hlength()
250    
251    length of the hit sequence in similarities
252    
253    =cut
254    
255    sub hlength {
256        my ($self) = @_;
257    
258        return $self->{hlength};
259    }
260    
261    
262    
263  =head3 evalue()  =head3 evalue()
264    
265  E-value or P-Value if present.  E-value or P-Value if present.
# Line 336  Line 413 
413      else{      else{
414          #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based          #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based
415          my %domain_classes;          my %domain_classes;
416            my $identical_flag=0;
417            my $pch_flag=0;
418            my $sims_flag=0;
419          foreach my $class (@$classes){          foreach my $class (@$classes){
420              if($class =~/(IPR|CDD|PFAM)/){              if($class =~/(IPR|CDD|PFAM)/){
421                  $domain_classes{$class} = 1;                  $domain_classes{$class} = 1;
422                }
423                elsif ($class eq "IDENTICAL")
424                {
425                    $identical_flag = 1;
426                }
427                elsif ($class eq "PCH")
428                {
429                    $pch_flag = 1;
430                }
431                elsif ($class eq "SIM")
432                {
433                    $sims_flag = 1;
434              }              }
435          }          }
436    
437            if ($identical_flag ==1)
438            {
439                get_identical_proteins($fid,\@matched_datasets);
440            }
441            if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {
442          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
443            }
444            if ($pch_flag == 1)
445            {
446                get_functional_coupling($fid,\@matched_datasets);
447            }
448            if ($sims_flag == 1)
449            {
450                get_sims_observations($fid,\@matched_datasets);
451            }
452    
453          #add CELLO and SignalP later          #add CELLO and SignalP later
454      }      }
# Line 352  Line 458 
458          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
459              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
460          }          }
461            if($dataset->{'class'} eq "PCH"){
462                $object = Observation::FC->new($dataset);
463            }
464            if ($dataset->{'class'} eq "IDENTICAL"){
465                $object = Observation::Identical->new($dataset);
466            }
467            if ($dataset->{'class'} eq "SIM"){
468                $object = Observation::Sims->new($dataset);
469            }
470          push (@$objects, $object);          push (@$objects, $object);
471      }      }
472    
# Line 552  Line 667 
667    
668      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
669      my $fig = new FIG;      my $fig = new FIG;
670      my @sims= $fig->nsims($fid,100,1e-20,"fig");  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
671        my @sims= $fig->nsims($fid,100,1e-20,"all");
672      my ($dataset);      my ($dataset);
673      foreach my $sim (@sims){      foreach my $sim (@sims){
674          my $hit = $sim->[1];          my $hit = $sim->[1];
675            my $percent = $sim->[2];
676          my $evalue = $sim->[10];          my $evalue = $sim->[10];
677          my $from = $sim->[8];          my $qfrom = $sim->[6];
678          my $to = $sim->[9];          my $qto = $sim->[7];
679          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
680                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
681                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
682                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
683                          { name => 'start', value => $from},          my $db = get_database($hit);
684                          { name => 'stop' , value => $to}          my $func = $fig->function_of($hit);
685                          ];          my $organism = $fig->org_of($hit);
686    
687            $dataset = {'class' => 'SIM',
688                        'acc' => $hit,
689                        'identity' => $percent,
690                        'type' => 'seq',
691                        'evalue' => $evalue,
692                        'qstart' => $qfrom,
693                        'qstop' => $qto,
694                        'hstart' => $hfrom,
695                        'hstop' => $hto,
696                        'database' => $db,
697                        'organism' => $organism,
698                        'function' => $func,
699                        'qlength' => $qlength,
700                        'hlength' => $hlength
701                        };
702    
703      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
704      }      }
705  }  }
706    
707    =head3 get_database (internal)
708    This method gets the database association from the sequence id
709    
710    =cut
711    
712    sub get_database{
713        my ($id) = (@_);
714    
715        my ($db);
716        if ($id =~ /^fig\|/)              { $db = "FIG" }
717        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
718        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
719        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
720        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
721        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
722        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
723        elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }
724        elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
725        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
726        elsif ($id =~ /^img\|/)           { $db = "JGI" }
727    
728        return ($db);
729    
730    }
731    
732  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
733    
734  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 587  Line 746 
746      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
747          my ($tmp, $who);          my ($tmp, $who);
748          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
749              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" }  
   
750              push(@funcs, [$id,$who,$tmp]);              push(@funcs, [$id,$who,$tmp]);
751          }          }
752      }      }
# Line 608  Line 757 
757          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($fid);
758          my $who = $row->[1];          my $who = $row->[1];
759          my $assignment = $row->[2];          my $assignment = $row->[2];
760          $dataset = [ { name => 'class', value => "IDENTICAL" },  
761                       { name => 'id' , value => $id},          my $dataset = {'class' => 'IDENTICAL',
762                       { name => 'organism', value => "$organism"} ,                         'id' => $id,
763                       { name => 'database', value => $who },                         'organism' => $organism,
764                       { name => 'description' , value => $assignment}                         'type' => 'seq',
765                       ];                         'database' => $who,
766                           'function' => $assignment
767                           };
768    
769          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
770      }      }
771    
# Line 650  Line 802 
802          my $id = $row->[1];          my $id = $row->[1];
803          my $score = $row->[0];          my $score = $row->[0];
804          my $description = $row->[2];          my $description = $row->[2];
805          $dataset = [ { name => 'class', value => "FC" },          my $dataset = {'class' => 'PCH',
806                       { name => 'score' , value => $score},                         'score' => $score,
807                       { name => 'id', value => "$id"} ,                         'id' => $id,
808                       { name => 'description' , value => $description}                         'type' => 'fc',
809                       ];                         'function' => $description
810                           };
811    
812          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
813      }      }
814  }  }
# Line 740  Line 894 
894    return $self;    return $self;
895  }  }
896    
897    =head3 identity (internal)
898    
899    Returns the % identity of the similar sequence
900    
901    =cut
902    
903    sub identity {
904        my ($self) = @_;
905    
906        return $self->{identity};
907    }
908    
909  =head3 feature_id (internal)  =head3 feature_id (internal)
910    
911    
# Line 775  Line 941 
941      return $self->{organism};      return $self->{organism};
942  }  }
943    
944    =head3 function (internal)
945    
946    Returns the function of the identical sequence
947    
948    =cut
949    
950    sub function {
951        my ($self) = @_;
952    
953        return $self->{function};
954    }
955    
956  =head3 database (internal)  =head3 database (internal)
957    
958  Returns the database of the identical sequence  Returns the database of the identical sequence
# Line 787  Line 965 
965      return $self->{database};      return $self->{database};
966  }  }
967    
 #package Observation::Identical;  
 #1;  
 #  
 #our @ISA = qw(Observation);  # inherits all the methods from Observation  
968    
969  =head3 display_identical()  
970    ############################################################
971    ############################################################
972    package Observation::Identical;
973    
974    use base qw(Observation);
975    
976    sub new {
977    
978        my ($class,$dataset) = @_;
979        my $self = $class->SUPER::new($dataset);
980        $self->{id} = $dataset->{'id'};
981        $self->{organism} = $dataset->{'organism'};
982        $self->{function} = $dataset->{'function'};
983        $self->{database} = $dataset->{'database'};
984    
985        bless($self,$class);
986        return $self;
987    }
988    
989    =head3 display()
990    
991  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
992  This code will display a table for the identical protein  This code will display a table for the identical protein
993    
994    
995  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
996    dence.
997    
998  =cut  =cut
999    
1000  sub display_identical {  sub display{
1001      my ($self, $fid, $cgi) = @_;      my ($self, $cgi, $dataset) = @_;
   
     my $content;  
     my $array=Observation->get_objects($fid);  
1002    
1003      my $all_domains = [];      my $all_domains = [];
1004      my $count_identical = 0;      my $count_identical = 0;
1005      foreach my $thing (@$array) {      my $content;
1006        foreach my $thing (@$dataset) {
1007          next if ($thing->class ne "IDENTICAL");          next if ($thing->class ne "IDENTICAL");
1008          my $single_domain = [];          my $single_domain = [];
1009          push(@$single_domain,$thing->class);          push(@$single_domain,$thing->database);
1010          my $id = $thing->id;          my $id = $thing->id;
1011          $count_identical++;          $count_identical++;
1012          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1013          push(@$single_domain,$thing->organism);          push(@$single_domain,$thing->organism);
1014          push(@$single_domain,$thing->database);          #push(@$single_domain,$thing->type);
1015          push(@$single_domain,$thing->description);          push(@$single_domain,$thing->function);
1016          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1017      }      }
1018    
1019      if ($count_identical >0){      if ($count_identical >0){
1020          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();  
1021      }      }
1022      else{      else{
1023          $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 1025 
1025      return ($content);      return ($content);
1026  }  }
1027    
1028    1;
1029    
1030    
1031    #########################################
1032    #########################################
1033    package Observation::FC;
1034    1;
1035    
1036    use base qw(Observation);
1037    
1038    sub new {
1039    
1040        my ($class,$dataset) = @_;
1041        my $self = $class->SUPER::new($dataset);
1042        $self->{score} = $dataset->{'score'};
1043        $self->{id} = $dataset->{'id'};
1044        $self->{function} = $dataset->{'function'};
1045    
1046        bless($self,$class);
1047        return $self;
1048    }
1049    
1050    =head3 display()
1051    
1052    If available use the function specified here to display the "raw" observation.
1053    This code will display a table for the identical protein
1054    
1055    
1056    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
1057    dence.
1058    
1059    =cut
1060    
1061    sub display {
1062        my ($self,$cgi,$dataset, $fid) = @_;
1063    
1064        my $functional_data = [];
1065        my $count = 0;
1066        my $content;
1067    
1068        foreach my $thing (@$dataset) {
1069            my $single_domain = [];
1070            next if ($thing->class ne "PCH");
1071            $count++;
1072    
1073            # construct the score link
1074            my $score = $thing->score;
1075            my $toid = $thing->id;
1076            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1077            my $sc_link = "<a href=$link>$score</a>";
1078    
1079            push(@$single_domain,$sc_link);
1080            push(@$single_domain,$thing->id);
1081            push(@$single_domain,$thing->function);
1082            push(@$functional_data,$single_domain);
1083        }
1084    
1085        if ($count >0){
1086            $content = $functional_data;
1087        }
1088        else
1089        {
1090            $content = "<p>This PEG does not have any functional coupling</p>";
1091        }
1092        return ($content);
1093    }
1094    
1095    
1096    #########################################
1097    #########################################
1098  package Observation::Domain;  package Observation::Domain;
1099    
1100  use base qw(Observation);  use base qw(Observation);
# Line 911  Line 1161 
1161    
1162  }  }
1163    
1164    #########################################
1165    #########################################
1166    package Observation::Sims;
1167    
1168    use base qw(Observation);
1169    
1170    sub new {
1171    
1172        my ($class,$dataset) = @_;
1173        my $self = $class->SUPER::new($dataset);
1174        $self->{identity} = $dataset->{'identity'};
1175        $self->{acc} = $dataset->{'acc'};
1176        $self->{evalue} = $dataset->{'evalue'};
1177        $self->{qstart} = $dataset->{'qstart'};
1178        $self->{qstop} = $dataset->{'qstop'};
1179        $self->{hstart} = $dataset->{'hstart'};
1180        $self->{hstop} = $dataset->{'hstop'};
1181        $self->{database} = $dataset->{'database'};
1182        $self->{organism} = $dataset->{'organism'};
1183        $self->{function} = $dataset->{'function'};
1184        $self->{qlength} = $dataset->{'qlength'};
1185        $self->{hlength} = $dataset->{'hlength'};
1186    
1187        bless($self,$class);
1188        return $self;
1189    }
1190    
1191    =head3 display()
1192    
1193    If available use the function specified here to display the "raw" observation.
1194    This code will display a table for the similarities protein
1195    
1196    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.
1197    
1198    =cut
1199    
1200    sub display {
1201        my ($self,$cgi,$dataset) = @_;
1202    
1203        my $data = [];
1204        my $count = 0;
1205        my $content;
1206        my $fig = new FIG;
1207    
1208        foreach my $thing (@$dataset) {
1209            my $single_domain = [];
1210            next if ($thing->class ne "SIM");
1211            $count++;
1212    
1213            my $id = $thing->acc;
1214    
1215            # add the subsystem information
1216            my @in_sub  = $fig->peg_to_subsystems($id);
1217            my $in_sub;
1218    
1219            if (@in_sub > 0) {
1220                $in_sub = @in_sub;
1221    
1222                # RAE: add a javascript popup with all the subsystems
1223                my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1224                $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);
1225            } else {
1226                $in_sub = "&nbsp;";
1227            }
1228    
1229            # add evidence code with tool tip
1230            my $ev_codes=" &nbsp; ";
1231            my @ev_codes = "";
1232            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1233                my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);
1234                @ev_codes = ();
1235                foreach my $code (@codes) {
1236                    my $pretty_code = $code->[2];
1237                    if ($pretty_code =~ /;/) {
1238                        my ($cd, $ss) = split(";", $code->[2]);
1239                        $ss =~ s/_/ /g;
1240                        $pretty_code = $cd;# . " in " . $ss;
1241                    }
1242                    push(@ev_codes, $pretty_code);
1243                }
1244            }
1245    
1246            if (scalar(@ev_codes) && $ev_codes[0]) {
1247                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
1248                $ev_codes = $cgi->a(
1249                                    {
1250                                        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));
1251            }
1252    
1253            # add the aliases
1254            my $aliases = undef;
1255            $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );
1256            $aliases = &HTML::set_prot_links( $cgi, $aliases );
1257            $aliases ||= "&nbsp;";
1258    
1259            my $iden    = $thing->identity;
1260            my $ln1     = $thing->qlength;
1261            my $ln2     = $thing->hlength;
1262            my $b1      = $thing->qstart;
1263            my $e1      = $thing->qstop;
1264            my $b2      = $thing->hstart;
1265            my $e2      = $thing->hstop;
1266            my $d1      = abs($e1 - $b1) + 1;
1267            my $d2      = abs($e2 - $b2) + 1;
1268            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1269            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1270    
1271    
1272            push(@$single_domain,$thing->database);
1273            push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
1274            push(@$single_domain,$thing->evalue);
1275            push(@$single_domain,"$iden\%");
1276            push(@$single_domain,$reg1);
1277            push(@$single_domain,$reg2);
1278            push(@$single_domain,$in_sub);
1279            push(@$single_domain,$ev_codes);
1280            push(@$single_domain,$thing->organism);
1281            push(@$single_domain,$thing->function);
1282            push(@$single_domain,$aliases);
1283            push(@$data,$single_domain);
1284        }
1285    
1286        if ($count >0){
1287            $content = $data;
1288        }
1289        else
1290        {
1291            $content = "<p>This PEG does not have any similarities</p>";
1292        }
1293        return ($content);
1294    }
1295    
1296    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.11

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3