[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.19, Wed Jun 27 14:59:39 2007 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3    use lib '/vol/ontologies';
4    use DBMaster;
5    
6  require Exporter;  require Exporter;
7  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
8    
9    use FIG_Config;
10  use strict;  use strict;
11  use warnings;  #use warnings;
12  use Table;  use HTML;
13    
14  1;  1;
15    
# Line 24  Line 28 
28    
29  Example:  Example:
30    
31    
32  use FIG;  use FIG;
33  use Observation;  use Observation;
34    
# Line 101  Line 106 
106    
107  =over 9  =over 9
108    
109    =item IDENTICAL (seq)
110    
111  =item SIM (seq)  =item SIM (seq)
112    
113  =item BBH (seq)  =item BBH (seq)
# Line 115  Line 122 
122    
123  =item PFAM (dom)  =item PFAM (dom)
124    
125  =item SIGNALP (dom)  =item SIGNALP_CELLO_TMPRED (loc)
   
 =item  CELLO(loc)  
126    
127  =item TMHMM (loc)  =item TMHMM (loc)
128    
# Line 183  Line 188 
188    return $self->{stop};    return $self->{stop};
189  }  }
190    
191    =head3 start()
192    
193    Start of hit in query sequence.
194    
195    =cut
196    
197    sub qstart {
198        my ($self) = @_;
199    
200        return $self->{qstart};
201    }
202    
203    =head3 qstop()
204    
205    End of the hit in query sequence.
206    
207    =cut
208    
209    sub qstop {
210        my ($self) = @_;
211    
212        return $self->{qstop};
213    }
214    
215    =head3 hstart()
216    
217    Start of hit in hit sequence.
218    
219    =cut
220    
221    sub hstart {
222        my ($self) = @_;
223    
224        return $self->{hstart};
225    }
226    
227    =head3 end()
228    
229    End of the hit in hit sequence.
230    
231    =cut
232    
233    sub hstop {
234        my ($self) = @_;
235    
236        return $self->{hstop};
237    }
238    
239    =head3 qlength()
240    
241    length of the query sequence in similarities
242    
243    =cut
244    
245    sub qlength {
246        my ($self) = @_;
247    
248        return $self->{qlength};
249    }
250    
251    =head3 hlength()
252    
253    length of the hit sequence in similarities
254    
255    =cut
256    
257    sub hlength {
258        my ($self) = @_;
259    
260        return $self->{hlength};
261    }
262    
263    
264    
265  =head3 evalue()  =head3 evalue()
266    
267  E-value or P-Value if present.  E-value or P-Value if present.
# Line 210  Line 289 
289  }  }
290    
291    
292  =head3 display_method()  =head3 display()
293    
294  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.  
295    
296  =cut  =cut
297    
# Line 320  Line 395 
395  sub get_objects {  sub get_objects {
396      my ($self,$fid,$classes) = @_;      my ($self,$fid,$classes) = @_;
397    
   
398      my $objects = [];      my $objects = [];
399      my @matched_datasets=();      my @matched_datasets=();
400    
# Line 334  Line 408 
408          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
409      }      }
410      else{      else{
         #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based  
411          my %domain_classes;          my %domain_classes;
412            my $identical_flag=0;
413            my $pch_flag=0;
414            my $location_flag = 0;
415            my $sims_flag=0;
416            my $cluster_flag = 0;
417          foreach my $class (@$classes){          foreach my $class (@$classes){
418              if($class =~/(IPR|CDD|PFAM)/){              if($class =~/(IPR|CDD|PFAM)/){
419                  $domain_classes{$class} = 1;                  $domain_classes{$class} = 1;
   
420              }              }
421                elsif ($class eq "IDENTICAL")
422                {
423                    $identical_flag = 1;
424                }
425                elsif ($class eq "PCH")
426                {
427                    $pch_flag = 1;
428                }
429                elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)
430                {
431                    $location_flag = 1;
432                }
433                elsif ($class eq "SIM")
434                {
435                    $sims_flag = 1;
436          }          }
437                elsif ($class eq "CLUSTER")
438                {
439                    $cluster_flag = 1;
440                }
441            }
442    
443            if ($identical_flag ==1)
444            {
445                get_identical_proteins($fid,\@matched_datasets);
446            }
447            if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {
448          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
449            }
450            if ($pch_flag == 1)
451            {
452                get_functional_coupling($fid,\@matched_datasets);
453            }
454            if ($sims_flag == 1)
455            {
456                get_sims_observations($fid,\@matched_datasets);
457            }
458    
459            if ($location_flag == 1)
460            {
461                get_attribute_based_location_observations($fid,\@matched_datasets);
462            }
463            if ($cluster_flag == 1)
464            {
465                get_cluster_observations($fid,\@matched_datasets);
466            }
467    
         #add CELLO and SignalP later  
468      }      }
469    
470      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 352  Line 472 
472          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
473              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
474          }          }
475            if($dataset->{'class'} eq "PCH"){
476                $object = Observation::FC->new($dataset);
477            }
478            if ($dataset->{'class'} eq "IDENTICAL"){
479                $object = Observation::Identical->new($dataset);
480            }
481            if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
482                $object = Observation::Location->new($dataset);
483            }
484            if ($dataset->{'class'} eq "SIM"){
485                $object = Observation::Sims->new($dataset);
486            }
487            if ($dataset->{'class'} eq "CLUSTER"){
488                $object = Observation::Cluster->new($dataset);
489            }
490          push (@$objects, $object);          push (@$objects, $object);
491      }      }
492    
# Line 470  Line 605 
605      }      }
606  }  }
607    
608    sub get_attribute_based_location_observations{
609    
610        my ($fid,$datasets_ref) = (@_);
611        my $fig = new FIG;
612    
613        my $location_attributes = ['SignalP','CELLO','TMPRED'];
614    
615        my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};
616        foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
617            my $key = @$attr_ref[1];
618            my @parts = split("::",$key);
619            my $sub_class = $parts[0];
620            my $sub_key = $parts[1];
621            my $value = @$attr_ref[2];
622            if($sub_class eq "SignalP"){
623                if($sub_key eq "cleavage_site"){
624                    my @value_parts = split(";",$value);
625                    $dataset->{'cleavage_prob'} = $value_parts[0];
626                    $dataset->{'cleavage_loc'} = $value_parts[1];
627                }
628                elsif($sub_key eq "signal_peptide"){
629                    $dataset->{'signal_peptide_score'} = $value;
630                }
631            }
632            elsif($sub_class eq "CELLO"){
633                $dataset->{'cello_location'} = $sub_key;
634                $dataset->{'cello_score'} = $value;
635            }
636            elsif($sub_class eq "TMPRED"){
637                my @value_parts = split(";",$value);
638                $dataset->{'tmpred_score'} = $value_parts[0];
639                $dataset->{'tmpred_locations'} = $value_parts[1];
640            }
641        }
642    
643        push (@{$datasets_ref} ,$dataset);
644    
645    }
646    
647    
648  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
649    
650  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 542  Line 717 
717      }      }
718  }  }
719    
720    =head3 get_cluster_observations() (internal)
721    
722    This methods sets the type and class for cluster observations
723    
724    =cut
725    
726    sub get_cluster_observations{
727        my ($fid,$datasets_ref) = (@_);
728    
729        my $dataset = {'class' => 'CLUSTER',
730                       'type' => 'fc'
731                       };
732        push (@{$datasets_ref} ,$dataset);
733    }
734    
735    
736  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
737    
738  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 552  Line 743 
743    
744      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
745      my $fig = new FIG;      my $fig = new FIG;
746      my @sims= $fig->nsims($fid,100,1e-20,"fig");  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
747        my @sims= $fig->nsims($fid,100,1e-20,"all");
748      my ($dataset);      my ($dataset);
749      foreach my $sim (@sims){      foreach my $sim (@sims){
750          my $hit = $sim->[1];          my $hit = $sim->[1];
751            my $percent = $sim->[2];
752          my $evalue = $sim->[10];          my $evalue = $sim->[10];
753          my $from = $sim->[8];          my $qfrom = $sim->[6];
754          my $to = $sim->[9];          my $qto = $sim->[7];
755          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
756                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
757                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
758                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
759                          { name => 'start', value => $from},          my $db = get_database($hit);
760                          { name => 'stop' , value => $to}          my $func = $fig->function_of($hit);
761                          ];          my $organism = $fig->org_of($hit);
762    
763            $dataset = {'class' => 'SIM',
764                        'acc' => $hit,
765                        'identity' => $percent,
766                        'type' => 'seq',
767                        'evalue' => $evalue,
768                        'qstart' => $qfrom,
769                        'qstop' => $qto,
770                        'hstart' => $hfrom,
771                        'hstop' => $hto,
772                        'database' => $db,
773                        'organism' => $organism,
774                        'function' => $func,
775                        'qlength' => $qlength,
776                        'hlength' => $hlength
777                        };
778    
779      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
780      }      }
781  }  }
782    
783    =head3 get_database (internal)
784    This method gets the database association from the sequence id
785    
786    =cut
787    
788    sub get_database{
789        my ($id) = (@_);
790    
791        my ($db);
792        if ($id =~ /^fig\|/)              { $db = "FIG" }
793        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
794        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
795        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
796        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
797        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
798        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
799        elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }
800        elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
801        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
802        elsif ($id =~ /^img\|/)           { $db = "JGI" }
803    
804        return ($db);
805    
806    }
807    
808  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
809    
810  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 587  Line 822 
822      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
823          my ($tmp, $who);          my ($tmp, $who);
824          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
825              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" }  
   
826              push(@funcs, [$id,$who,$tmp]);              push(@funcs, [$id,$who,$tmp]);
827          }          }
828      }      }
# Line 608  Line 833 
833          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($fid);
834          my $who = $row->[1];          my $who = $row->[1];
835          my $assignment = $row->[2];          my $assignment = $row->[2];
836          $dataset = [ { name => 'class', value => "IDENTICAL" },  
837                       { name => 'id' , value => $id},          my $dataset = {'class' => 'IDENTICAL',
838                       { name => 'organism', value => "$organism"} ,                         'id' => $id,
839                       { name => 'database', value => $who },                         'organism' => $organism,
840                       { name => 'description' , value => $assignment}                         'type' => 'seq',
841                       ];                         'database' => $who,
842                           'function' => $assignment
843                           };
844    
845          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
846      }      }
847    
# Line 650  Line 878 
878          my $id = $row->[1];          my $id = $row->[1];
879          my $score = $row->[0];          my $score = $row->[0];
880          my $description = $row->[2];          my $description = $row->[2];
881          $dataset = [ { name => 'class', value => "FC" },          my $dataset = {'class' => 'PCH',
882                       { name => 'score' , value => $score},                         'score' => $score,
883                       { name => 'id', value => "$id"} ,                         'id' => $id,
884                       { name => 'description' , value => $description}                         'type' => 'fc',
885                       ];                         'function' => $description
886                           };
887    
888          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
889      }      }
890  }  }
# Line 740  Line 970 
970    return $self;    return $self;
971  }  }
972    
973    =head3 identity (internal)
974    
975    Returns the % identity of the similar sequence
976    
977    =cut
978    
979    sub identity {
980        my ($self) = @_;
981    
982        return $self->{identity};
983    }
984    
985  =head3 feature_id (internal)  =head3 feature_id (internal)
986    
987    
# Line 775  Line 1017 
1017      return $self->{organism};      return $self->{organism};
1018  }  }
1019    
1020    =head3 function (internal)
1021    
1022    Returns the function of the identical sequence
1023    
1024    =cut
1025    
1026    sub function {
1027        my ($self) = @_;
1028    
1029        return $self->{function};
1030    }
1031    
1032  =head3 database (internal)  =head3 database (internal)
1033    
1034  Returns the database of the identical sequence  Returns the database of the identical sequence
# Line 787  Line 1041 
1041      return $self->{database};      return $self->{database};
1042  }  }
1043    
 #package Observation::Identical;  
 #1;  
 #  
 #our @ISA = qw(Observation);  # inherits all the methods from Observation  
1044    
1045  =head3 display_identical()  
1046    ############################################################
1047    ############################################################
1048    package Observation::Identical;
1049    
1050    use base qw(Observation);
1051    
1052    sub new {
1053    
1054        my ($class,$dataset) = @_;
1055        my $self = $class->SUPER::new($dataset);
1056        $self->{id} = $dataset->{'id'};
1057        $self->{organism} = $dataset->{'organism'};
1058        $self->{function} = $dataset->{'function'};
1059        $self->{database} = $dataset->{'database'};
1060    
1061        bless($self,$class);
1062        return $self;
1063    }
1064    
1065    =head3 display()
1066    
1067  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1068  This code will display a table for the identical protein  This code will display a table for the identical protein
1069    
1070    
1071  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
1072    dence.
1073    
1074  =cut  =cut
1075    
1076  sub display_identical {  sub display{
1077      my ($self, $fid, $cgi) = @_;      my ($self, $cgi, $dataset) = @_;
   
     my $content;  
     my $array=Observation->get_objects($fid);  
1078    
1079      my $all_domains = [];      my $all_domains = [];
1080      my $count_identical = 0;      my $count_identical = 0;
1081      foreach my $thing (@$array) {      my $content;
1082        foreach my $thing (@$dataset) {
1083          next if ($thing->class ne "IDENTICAL");          next if ($thing->class ne "IDENTICAL");
1084          my $single_domain = [];          my $single_domain = [];
1085          push(@$single_domain,$thing->class);          push(@$single_domain,$thing->database);
1086          my $id = $thing->id;          my $id = $thing->id;
1087          $count_identical++;          $count_identical++;
1088          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1089          push(@$single_domain,$thing->organism);          push(@$single_domain,$thing->organism);
1090          push(@$single_domain,$thing->database);          #push(@$single_domain,$thing->type);
1091          push(@$single_domain,$thing->description);          push(@$single_domain,$thing->function);
1092          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1093      }      }
1094    
1095      if ($count_identical >0){      if ($count_identical >0){
1096          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();  
1097      }      }
1098      else{      else{
1099          $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 1101 
1101      return ($content);      return ($content);
1102  }  }
1103    
1104    1;
1105    
1106    
1107    #########################################
1108    #########################################
1109    package Observation::FC;
1110    1;
1111    
1112    use base qw(Observation);
1113    
1114    sub new {
1115    
1116        my ($class,$dataset) = @_;
1117        my $self = $class->SUPER::new($dataset);
1118        $self->{score} = $dataset->{'score'};
1119        $self->{id} = $dataset->{'id'};
1120        $self->{function} = $dataset->{'function'};
1121    
1122        bless($self,$class);
1123        return $self;
1124    }
1125    
1126    =head3 display()
1127    
1128    If available use the function specified here to display the "raw" observation.
1129    This code will display a table for the identical protein
1130    
1131    
1132    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
1133    dence.
1134    
1135    =cut
1136    
1137    sub display {
1138        my ($self,$cgi,$dataset, $fid) = @_;
1139    
1140        my $functional_data = [];
1141        my $count = 0;
1142        my $content;
1143    
1144        foreach my $thing (@$dataset) {
1145            my $single_domain = [];
1146            next if ($thing->class ne "PCH");
1147            $count++;
1148    
1149            # construct the score link
1150            my $score = $thing->score;
1151            my $toid = $thing->id;
1152            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1153            my $sc_link = "<a href=$link>$score</a>";
1154    
1155            push(@$single_domain,$sc_link);
1156            push(@$single_domain,$thing->id);
1157            push(@$single_domain,$thing->function);
1158            push(@$functional_data,$single_domain);
1159        }
1160    
1161        if ($count >0){
1162            $content = $functional_data;
1163        }
1164        else
1165        {
1166            $content = "<p>This PEG does not have any functional coupling</p>";
1167        }
1168        return ($content);
1169    }
1170    
1171    
1172    #########################################
1173    #########################################
1174  package Observation::Domain;  package Observation::Domain;
1175    
1176  use base qw(Observation);  use base qw(Observation);
# Line 874  Line 1200 
1200      my $links_list = [];      my $links_list = [];
1201      my $descriptions = [];      my $descriptions = [];
1202    
1203      my $description_function;      my $db_and_id = $thing->acc;
1204      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1205    
1206      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology');
1207    
1208        my ($name_title,$name_value,$description_title,$description_value);
1209        if($db eq "CDD"){
1210            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1211            if(!scalar(@$cdd_objs)){
1212                $name_title = "name";
1213                $name_value = "not available";
1214                $description_title = "description";
1215                $description_value = "not available";
1216            }
1217            else{
1218                my $cdd_obj = $cdd_objs->[0];
1219                $name_title = "name";
1220                $name_value = $cdd_obj->term;
1221                $description_title = "description";
1222                $description_value = $cdd_obj->description;
1223            }
1224        }
1225    
1226        my $name;
1227        $name = {"title" => $name_title,
1228                 "value" => $name_value};
1229        push(@$descriptions,$name);
1230    
1231        my $description;
1232        $description = {"title" => $description_title,
1233                                 "value" => $description_value};
1234        push(@$descriptions,$description);
1235    
1236      my $score;      my $score;
1237      $score = {"title" => "score",      $score = {"title" => "score",
# Line 886  Line 1239 
1239      push(@$descriptions,$score);      push(@$descriptions,$score);
1240    
1241      my $link_id;      my $link_id;
1242      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/\w+::(\d+)/){
1243          $link_id = $1;          $link_id = $1;
1244      }      }
1245    
1246      my $link;      my $link;
1247        my $link_url;
1248        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"}
1249        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1250        else{$link_url = "NO_URL"}
1251    
1252      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1253               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1254      push(@$links_list,$link);      push(@$links_list,$link);
1255    
1256      my $element_hash = {      my $element_hash = {
# Line 911  Line 1269 
1269    
1270  }  }
1271    
1272    #########################################
1273    #########################################
1274    package Observation::Location;
1275    
1276    use base qw(Observation);
1277    
1278    sub new {
1279    
1280        my ($class,$dataset) = @_;
1281        my $self = $class->SUPER::new($dataset);
1282        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1283        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1284        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1285        $self->{cello_location} = $dataset->{'cello_location'};
1286        $self->{cello_score} = $dataset->{'cello_score'};
1287        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1288        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1289    
1290        bless($self,$class);
1291        return $self;
1292    }
1293    
1294    sub display {
1295        my ($thing,$gd,$fid) = @_;
1296    
1297        my $fig= new FIG;
1298        my $length = length($fig->get_translation($fid));
1299    
1300        my $cleavage_prob;
1301        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1302        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1303        my $signal_peptide_score = $thing->signal_peptide_score;
1304        my $cello_location = $thing->cello_location;
1305        my $cello_score = $thing->cello_score;
1306        my $tmpred_score = $thing->tmpred_score;
1307        my @tmpred_locations = split(",",$thing->tmpred_locations);
1308    
1309        my $lines = [];
1310        my $line_config = { 'title' => 'Localization Evidence',
1311                            'short_title' => 'Local',
1312                            'basepair_offset' => '1' };
1313    
1314        #color is
1315        my $color = "5";
1316    
1317        my $line_data = [];
1318    
1319        if($cello_location){
1320            my $cello_descriptions = [];
1321            my $description_cello_location = {"title" => 'Best Cello Location',
1322                                              "value" => $cello_location};
1323    
1324            push(@$cello_descriptions,$description_cello_location);
1325    
1326            my $description_cello_score = {"title" => 'Cello Score',
1327                                           "value" => $cello_score};
1328    
1329            push(@$cello_descriptions,$description_cello_score);
1330    
1331            my $element_hash = {
1332                "title" => "CELLO",
1333                "start" => "1",
1334                "end" =>  $length + 1,
1335                "color"=> $color,
1336                "type" => 'box',
1337                "zlayer" => '2',
1338                "description" => $cello_descriptions};
1339    
1340            push(@$line_data,$element_hash);
1341        }
1342    
1343        my $color = "6";
1344        #if(0){
1345        if($tmpred_score){
1346            foreach my $tmpred (@tmpred_locations){
1347                my $descriptions = [];
1348                my ($begin,$end) =split("-",$tmpred);
1349                my $description_tmpred_score = {"title" => 'TMPRED score',
1350                                 "value" => $tmpred_score};
1351    
1352                push(@$descriptions,$description_tmpred_score);
1353    
1354                my $element_hash = {
1355                "title" => "transmembrane location",
1356                "start" => $begin + 1,
1357                "end" =>  $end + 1,
1358                "color"=> $color,
1359                "zlayer" => '5',
1360                "type" => 'smallbox',
1361                "description" => $descriptions};
1362    
1363                push(@$line_data,$element_hash);
1364            }
1365        }
1366    
1367        my $color = "1";
1368        if($signal_peptide_score){
1369            my $descriptions = [];
1370            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1371                                                    "value" => $signal_peptide_score};
1372    
1373            push(@$descriptions,$description_signal_peptide_score);
1374    
1375            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1376                                             "value" => $cleavage_prob};
1377    
1378            push(@$descriptions,$description_cleavage_prob);
1379    
1380            my $element_hash = {
1381                "title" => "SignalP",
1382                "start" => $cleavage_loc_begin - 2,
1383                "end" =>  $cleavage_loc_end + 3,
1384                "type" => 'bigbox',
1385                "color"=> $color,
1386                "zlayer" => '10',
1387                "description" => $descriptions};
1388    
1389            push(@$line_data,$element_hash);
1390        }
1391    
1392        $gd->add_line($line_data, $line_config);
1393    
1394        return ($gd);
1395    
1396    }
1397    
1398    sub cleavage_loc {
1399      my ($self) = @_;
1400    
1401      return $self->{cleavage_loc};
1402    }
1403    
1404    sub cleavage_prob {
1405      my ($self) = @_;
1406    
1407      return $self->{cleavage_prob};
1408    }
1409    
1410    sub signal_peptide_score {
1411      my ($self) = @_;
1412    
1413      return $self->{signal_peptide_score};
1414    }
1415    
1416    sub tmpred_score {
1417      my ($self) = @_;
1418    
1419      return $self->{tmpred_score};
1420    }
1421    
1422    sub tmpred_locations {
1423      my ($self) = @_;
1424    
1425      return $self->{tmpred_locations};
1426    }
1427    
1428    sub cello_location {
1429      my ($self) = @_;
1430    
1431      return $self->{cello_location};
1432    }
1433    
1434    sub cello_score {
1435      my ($self) = @_;
1436    
1437      return $self->{cello_score};
1438    }
1439    
1440    
1441    #########################################
1442    #########################################
1443    package Observation::Sims;
1444    
1445    use base qw(Observation);
1446    
1447    sub new {
1448    
1449        my ($class,$dataset) = @_;
1450        my $self = $class->SUPER::new($dataset);
1451        $self->{identity} = $dataset->{'identity'};
1452        $self->{acc} = $dataset->{'acc'};
1453        $self->{evalue} = $dataset->{'evalue'};
1454        $self->{qstart} = $dataset->{'qstart'};
1455        $self->{qstop} = $dataset->{'qstop'};
1456        $self->{hstart} = $dataset->{'hstart'};
1457        $self->{hstop} = $dataset->{'hstop'};
1458        $self->{database} = $dataset->{'database'};
1459        $self->{organism} = $dataset->{'organism'};
1460        $self->{function} = $dataset->{'function'};
1461        $self->{qlength} = $dataset->{'qlength'};
1462        $self->{hlength} = $dataset->{'hlength'};
1463    
1464        bless($self,$class);
1465        return $self;
1466    }
1467    
1468    =head3 display()
1469    
1470    If available use the function specified here to display the "raw" observation.
1471    This code will display a table for the similarities protein
1472    
1473    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.
1474    
1475    =cut
1476    
1477    sub display {
1478        my ($self,$cgi,$dataset) = @_;
1479    
1480        my $data = [];
1481        my $count = 0;
1482        my $content;
1483        my $fig = new FIG;
1484    
1485        foreach my $thing (@$dataset) {
1486            my $single_domain = [];
1487            next if ($thing->class ne "SIM");
1488            $count++;
1489    
1490            my $id = $thing->acc;
1491    
1492            # add the subsystem information
1493            my @in_sub  = $fig->peg_to_subsystems($id);
1494            my $in_sub;
1495    
1496            if (@in_sub > 0) {
1497                $in_sub = @in_sub;
1498    
1499                # RAE: add a javascript popup with all the subsystems
1500                my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1501                $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);
1502            } else {
1503                $in_sub = "&nbsp;";
1504            }
1505    
1506            # add evidence code with tool tip
1507            my $ev_codes=" &nbsp; ";
1508            my @ev_codes = "";
1509            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1510                my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);
1511                @ev_codes = ();
1512                foreach my $code (@codes) {
1513                    my $pretty_code = $code->[2];
1514                    if ($pretty_code =~ /;/) {
1515                        my ($cd, $ss) = split(";", $code->[2]);
1516                        $ss =~ s/_/ /g;
1517                        $pretty_code = $cd;# . " in " . $ss;
1518                    }
1519                    push(@ev_codes, $pretty_code);
1520                }
1521            }
1522    
1523            if (scalar(@ev_codes) && $ev_codes[0]) {
1524                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
1525                $ev_codes = $cgi->a(
1526                                    {
1527                                        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));
1528            }
1529    
1530            # add the aliases
1531            my $aliases = undef;
1532            $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );
1533            $aliases = &HTML::set_prot_links( $cgi, $aliases );
1534            $aliases ||= "&nbsp;";
1535    
1536            my $iden    = $thing->identity;
1537            my $ln1     = $thing->qlength;
1538            my $ln2     = $thing->hlength;
1539            my $b1      = $thing->qstart;
1540            my $e1      = $thing->qstop;
1541            my $b2      = $thing->hstart;
1542            my $e2      = $thing->hstop;
1543            my $d1      = abs($e1 - $b1) + 1;
1544            my $d2      = abs($e2 - $b2) + 1;
1545            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1546            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1547    
1548    
1549            push(@$single_domain,$thing->database);
1550            push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
1551            push(@$single_domain,$thing->evalue);
1552            push(@$single_domain,"$iden\%");
1553            push(@$single_domain,$reg1);
1554            push(@$single_domain,$reg2);
1555            push(@$single_domain,$in_sub);
1556            push(@$single_domain,$ev_codes);
1557            push(@$single_domain,$thing->organism);
1558            push(@$single_domain,$thing->function);
1559            push(@$single_domain,$aliases);
1560            push(@$data,$single_domain);
1561        }
1562    
1563        if ($count >0){
1564            $content = $data;
1565        }
1566        else
1567        {
1568            $content = "<p>This PEG does not have any similarities</p>";
1569        }
1570        return ($content);
1571    }
1572    
1573    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1574    
1575    
1576    
1577    ############################
1578    package Observation::Cluster;
1579    
1580    use base qw(Observation);
1581    
1582    sub new {
1583    
1584        my ($class,$dataset) = @_;
1585        my $self = $class->SUPER::new($dataset);
1586    
1587        bless($self,$class);
1588        return $self;
1589    }
1590    
1591    sub display {
1592        my ($self,$gd, $fid) = @_;
1593    
1594        my $fig = new FIG;
1595        my $all_regions = [];
1596    
1597        #get the organism genome
1598        my $target_genome = $fig->genome_of($fid);
1599    
1600        # get location of the gene
1601        my $data = $fig->feature_location($fid);
1602        my ($contig, $beg, $end);
1603    
1604        if ($data =~ /(.*)_(\d+)_(\d+)$/){
1605            $contig = $1;
1606            $beg = $2;
1607            $end = $3;
1608        }
1609    
1610        my ($region_start, $region_end);
1611        if ($beg < $end)
1612        {
1613            $region_start = $beg - 4000;
1614            $region_end = $end+4000;
1615        }
1616        else
1617        {
1618            $region_end = $end+4000;
1619            $region_start = $beg-4000;
1620        }
1621    
1622        # call genes in region
1623        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
1624        push(@$all_regions,$target_gene_features);
1625        my (@start_array_region);
1626        push (@start_array_region, $region_start);
1627    
1628        my %all_genes;
1629        my %all_genomes;
1630        foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}
1631    
1632        my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1633    
1634        my $coup_count = 0;
1635    
1636        foreach my $pair (@{$coup[0]->[2]}) {
1637            last if ($coup_count > 10);
1638            my ($peg1,$peg2) = @$pair;
1639    
1640            my $location = $fig->feature_location($peg1);
1641            my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1642            if($location =~/(.*)_(\d+)_(\d+)$/){
1643                $pair_contig = $1;
1644                $pair_beg = $2;
1645                $pair_end = $3;
1646                if ($pair_beg < $pair_end)
1647                {
1648                    $pair_region_start = $pair_beg - 4000;
1649                    $pair_region_stop = $pair_end+4000;
1650                }
1651                else
1652                {
1653                    $pair_region_stop = $pair_end+4000;
1654                    $pair_region_start = $pair_beg-4000;
1655                }
1656    
1657                push (@start_array_region, $pair_region_start);
1658    
1659                $pair_genome = $fig->genome_of($peg1);
1660                $all_genomes{$pair_genome} = 1;
1661                my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1662                push(@$all_regions,$pair_features);
1663                foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}
1664            }
1665            $coup_count++;
1666        }
1667    
1668        my $bbh_sets = [];
1669        my %already;
1670        foreach my $gene_key (keys(%all_genes)){
1671            if($already{$gene_key}){next;}
1672            my $gene_set = [$gene_key];
1673    
1674            my $gene_key_genome = $fig->genome_of($gene_key);
1675    
1676            foreach my $genome_key (keys(%all_genomes)){
1677                #next if ($gene_key_genome eq $genome_key);
1678                my $return = $fig->bbh_list($genome_key,[$gene_key]);
1679    
1680                my $feature_list = $return->{$gene_key};
1681                foreach my $fl (@$feature_list){
1682                    push(@$gene_set,$fl);
1683                }
1684            }
1685            $already{$gene_key} = 1;
1686            push(@$bbh_sets,$gene_set);
1687        }
1688    
1689        my %bbh_set_rank;
1690        my $order = 0;
1691        foreach my $set (@$bbh_sets){
1692            my $count = scalar(@$set);
1693            $bbh_set_rank{$order} = $count;
1694            $order++;
1695        }
1696    
1697        my %peg_rank;
1698        my $counter =  1;
1699        foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){
1700            my $good_set = @$bbh_sets[$bbh_order];
1701            my $flag_set = 0;
1702            if (scalar (@$good_set) > 1)
1703            {
1704                foreach my $peg (@$good_set){
1705                    if ((!$peg_rank{$peg})){
1706                        $peg_rank{$peg} = $counter;
1707                        $flag_set = 1;
1708                    }
1709                }
1710                $counter++ if ($flag_set == 1);
1711            }
1712            else
1713            {
1714                foreach my $peg (@$good_set){
1715                    $peg_rank{$peg} = 100;
1716                }
1717            }
1718        }
1719    
1720        open (FH, ">$FIG_Config::temp/good_sets.txt");
1721        foreach my $pr (sort {$peg_rank{$a} <=> $peg_rank{$b}} keys(%peg_rank)){ print FH "rank:$peg_rank{$pr}\tpr:$pr\n";}
1722        close (FH);
1723    
1724        foreach my $region (@$all_regions){
1725            my $sample_peg = @$region[0];
1726            my $region_genome = $fig->genome_of($sample_peg);
1727            my $region_gs = $fig->genus_species($region_genome);
1728            my $abbrev_name = $fig->abbrev($region_gs);
1729            my $line_config = { 'title' => $region_gs,
1730                                'short_title' => $abbrev_name,
1731                                'basepair_offset' => '0'
1732                                };
1733    
1734            my $offset = shift @start_array_region;
1735    
1736            my $line_data = [];
1737            foreach my $fid1 (@$region){
1738                my $element_hash;
1739                my $links_list = [];
1740                my $descriptions = [];
1741    
1742                my $color = $peg_rank{$fid1};
1743                if ($color == 1) {
1744                    print STDERR "PEG: $fid1, RANK: $color";
1745                }
1746    
1747                # get subsystem information
1748                my $function = $fig->function_of($fid1);
1749                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;
1750    
1751                my $link;
1752                $link = {"link_title" => $fid1,
1753                         "link" => $url_link};
1754                push(@$links_list,$link);
1755    
1756                my @subsystems = $fig->peg_to_subsystems($fid1);
1757                foreach my $subsystem (@subsystems){
1758                    my $link;
1759                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1760                             "link_title" => $subsystem};
1761                    push(@$links_list,$link);
1762                }
1763    
1764                my $description_function;
1765                $description_function = {"title" => "function",
1766                                         "value" => $function};
1767                push(@$descriptions,$description_function);
1768    
1769                my $description_ss;
1770                my $ss_string = join (",", @subsystems);
1771                $description_ss = {"title" => "subsystems",
1772                                   "value" => $ss_string};
1773                push(@$descriptions,$description_ss);
1774    
1775    
1776                my $fid_location = $fig->feature_location($fid1);
1777                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
1778                    my($start,$stop);
1779                    if ($2 < $3){$start = $2; $stop = $3;}
1780                    else{$stop = $2; $start = $3;}
1781                    $start = $start - $offset;
1782                    $stop = $stop - $offset;
1783                    $element_hash = {
1784                        "title" => $fid1,
1785                        "start" => $start,
1786                        "end" =>  $stop,
1787                        "type"=> 'arrow',
1788                        "color"=> $color,
1789                        "zlayer" => "2",
1790                        "links_list" => $links_list,
1791                        "description" => $descriptions
1792                    };
1793                    push(@$line_data,$element_hash);
1794                }
1795            }
1796            $gd->add_line($line_data, $line_config);
1797        }
1798        return $gd;
1799    }
1800    
1801    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3