[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.15, Mon Jun 25 16:51:02 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()
   
 If available use the function specified here to display the "raw" observation.  
 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".  
289    
290  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.  will be different for each type
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            my $cluster_flag = 0;
414          foreach my $class (@$classes){          foreach my $class (@$classes){
415              if($class =~/(IPR|CDD|PFAM)/){              if($class =~/(IPR|CDD|PFAM)/){
416                  $domain_classes{$class} = 1;                  $domain_classes{$class} = 1;
   
417              }              }
418                elsif ($class eq "IDENTICAL")
419                {
420                    $identical_flag = 1;
421                }
422                elsif ($class eq "PCH")
423                {
424                    $pch_flag = 1;
425                }
426                elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)
427                {
428                    $location_flag = 1;
429                }
430                elsif ($class eq "SIM")
431                {
432                    $sims_flag = 1;
433                }
434                elsif ($class eq "CLUSTER")
435                {
436                    $cluster_flag = 1;
437          }          }
438            }
439    
440            if ($identical_flag ==1)
441            {
442                get_identical_proteins($fid,\@matched_datasets);
443            }
444            if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {
445          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
446            }
447            if ($pch_flag == 1)
448            {
449                get_functional_coupling($fid,\@matched_datasets);
450            }
451            if ($sims_flag == 1)
452            {
453                get_sims_observations($fid,\@matched_datasets);
454            }
455    
456            if ($location_flag == 1)
457            {
458                get_attribute_based_location_observations($fid,\@matched_datasets);
459            }
460            if ($cluster_flag == 1)
461            {
462                get_cluster_observations($fid,\@matched_datasets);
463            }
464    
         #add CELLO and SignalP later  
465      }      }
466    
467      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 352  Line 469 
469          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
470              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
471          }          }
472            if($dataset->{'class'} eq "PCH"){
473                $object = Observation::FC->new($dataset);
474            }
475            if ($dataset->{'class'} eq "IDENTICAL"){
476                $object = Observation::Identical->new($dataset);
477            }
478            if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
479                $object = Observation::Location->new($dataset);
480            }
481            if ($dataset->{'class'} eq "SIM"){
482                $object = Observation::Sims->new($dataset);
483            }
484            if ($dataset->{'class'} eq "CLUSTER"){
485                $object = Observation::Cluster->new($dataset);
486            }
487          push (@$objects, $object);          push (@$objects, $object);
488      }      }
489    
# Line 470  Line 602 
602      }      }
603  }  }
604    
605    sub get_attribute_based_location_observations{
606    
607        my ($fid,$datasets_ref) = (@_);
608        my $fig = new FIG;
609    
610        my $location_attributes = ['SignalP','CELLO','TMPRED'];
611    
612        my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};
613        foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
614            my $key = @$attr_ref[1];
615            my @parts = split("::",$key);
616            my $sub_class = $parts[0];
617            my $sub_key = $parts[1];
618            my $value = @$attr_ref[2];
619            if($sub_class eq "SignalP"){
620                if($sub_key eq "cleavage_site"){
621                    my @value_parts = split(";",$value);
622                    $dataset->{'cleavage_prob'} = $value_parts[0];
623                    $dataset->{'cleavage_loc'} = $value_parts[1];
624                }
625                elsif($sub_key eq "signal_peptide"){
626                    $dataset->{'signal_peptide_score'} = $value;
627                }
628            }
629            elsif($sub_class eq "CELLO"){
630                $dataset->{'cello_location'} = $sub_key;
631                $dataset->{'cello_score'} = $value;
632            }
633            elsif($sub_class eq "TMPRED"){
634                my @value_parts = split(";",$value);
635                $dataset->{'tmpred_score'} = $value_parts[0];
636                $dataset->{'tmpred_locations'} = $value_parts[1];
637            }
638        }
639    
640        push (@{$datasets_ref} ,$dataset);
641    
642    }
643    
644    
645  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
646    
647  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 542  Line 714 
714      }      }
715  }  }
716    
717    =head3 get_cluster_observations() (internal)
718    
719    This methods sets the type and class for cluster observations
720    
721    =cut
722    
723    sub get_cluster_observations{
724        my ($fid,$datasets_ref) = (@_);
725    
726        $dataset = {'class' => 'CLUSTER',
727                    'type' => 'fc'
728                    };
729        push (@{$datasets_ref} ,$dataset);
730    }
731    
732    
733  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
734    
735  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 552  Line 740 
740    
741      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
742      my $fig = new FIG;      my $fig = new FIG;
743      my @sims= $fig->nsims($fid,100,1e-20,"fig");  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
744        my @sims= $fig->nsims($fid,100,1e-20,"all");
745      my ($dataset);      my ($dataset);
746      foreach my $sim (@sims){      foreach my $sim (@sims){
747          my $hit = $sim->[1];          my $hit = $sim->[1];
748            my $percent = $sim->[2];
749          my $evalue = $sim->[10];          my $evalue = $sim->[10];
750          my $from = $sim->[8];          my $qfrom = $sim->[6];
751          my $to = $sim->[9];          my $qto = $sim->[7];
752          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
753                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
754                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
755                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
756                          { name => 'start', value => $from},          my $db = get_database($hit);
757                          { name => 'stop' , value => $to}          my $func = $fig->function_of($hit);
758                          ];          my $organism = $fig->org_of($hit);
759    
760            $dataset = {'class' => 'SIM',
761                        'acc' => $hit,
762                        'identity' => $percent,
763                        'type' => 'seq',
764                        'evalue' => $evalue,
765                        'qstart' => $qfrom,
766                        'qstop' => $qto,
767                        'hstart' => $hfrom,
768                        'hstop' => $hto,
769                        'database' => $db,
770                        'organism' => $organism,
771                        'function' => $func,
772                        'qlength' => $qlength,
773                        'hlength' => $hlength
774                        };
775    
776      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
777      }      }
778  }  }
779    
780    =head3 get_database (internal)
781    This method gets the database association from the sequence id
782    
783    =cut
784    
785    sub get_database{
786        my ($id) = (@_);
787    
788        my ($db);
789        if ($id =~ /^fig\|/)              { $db = "FIG" }
790        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
791        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
792        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
793        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
794        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
795        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
796        elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }
797        elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
798        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
799        elsif ($id =~ /^img\|/)           { $db = "JGI" }
800    
801        return ($db);
802    
803    }
804    
805  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
806    
807  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 587  Line 819 
819      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
820          my ($tmp, $who);          my ($tmp, $who);
821          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
822              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" }  
   
823              push(@funcs, [$id,$who,$tmp]);              push(@funcs, [$id,$who,$tmp]);
824          }          }
825      }      }
# Line 608  Line 830 
830          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($fid);
831          my $who = $row->[1];          my $who = $row->[1];
832          my $assignment = $row->[2];          my $assignment = $row->[2];
833          $dataset = [ { name => 'class', value => "IDENTICAL" },  
834                       { name => 'id' , value => $id},          my $dataset = {'class' => 'IDENTICAL',
835                       { name => 'organism', value => "$organism"} ,                         'id' => $id,
836                       { name => 'database', value => $who },                         'organism' => $organism,
837                       { name => 'description' , value => $assignment}                         'type' => 'seq',
838                       ];                         'database' => $who,
839                           'function' => $assignment
840                           };
841    
842          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
843      }      }
844    
# Line 650  Line 875 
875          my $id = $row->[1];          my $id = $row->[1];
876          my $score = $row->[0];          my $score = $row->[0];
877          my $description = $row->[2];          my $description = $row->[2];
878          $dataset = [ { name => 'class', value => "FC" },          my $dataset = {'class' => 'PCH',
879                       { name => 'score' , value => $score},                         'score' => $score,
880                       { name => 'id', value => "$id"} ,                         'id' => $id,
881                       { name => 'description' , value => $description}                         'type' => 'fc',
882                       ];                         'function' => $description
883                           };
884    
885          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
886      }      }
887  }  }
# Line 740  Line 967 
967    return $self;    return $self;
968  }  }
969    
970    =head3 identity (internal)
971    
972    Returns the % identity of the similar sequence
973    
974    =cut
975    
976    sub identity {
977        my ($self) = @_;
978    
979        return $self->{identity};
980    }
981    
982  =head3 feature_id (internal)  =head3 feature_id (internal)
983    
984    
# Line 775  Line 1014 
1014      return $self->{organism};      return $self->{organism};
1015  }  }
1016    
1017    =head3 function (internal)
1018    
1019    Returns the function of the identical sequence
1020    
1021    =cut
1022    
1023    sub function {
1024        my ($self) = @_;
1025    
1026        return $self->{function};
1027    }
1028    
1029  =head3 database (internal)  =head3 database (internal)
1030    
1031  Returns the database of the identical sequence  Returns the database of the identical sequence
# Line 787  Line 1038 
1038      return $self->{database};      return $self->{database};
1039  }  }
1040    
 #package Observation::Identical;  
 #1;  
 #  
 #our @ISA = qw(Observation);  # inherits all the methods from Observation  
1041    
1042  =head3 display_identical()  
1043    ############################################################
1044    ############################################################
1045    package Observation::Identical;
1046    
1047    use base qw(Observation);
1048    
1049    sub new {
1050    
1051        my ($class,$dataset) = @_;
1052        my $self = $class->SUPER::new($dataset);
1053        $self->{id} = $dataset->{'id'};
1054        $self->{organism} = $dataset->{'organism'};
1055        $self->{function} = $dataset->{'function'};
1056        $self->{database} = $dataset->{'database'};
1057    
1058        bless($self,$class);
1059        return $self;
1060    }
1061    
1062    =head3 display()
1063    
1064  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1065  This code will display a table for the identical protein  This code will display a table for the identical protein
1066    
1067    
1068  B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.  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
1069    dence.
1070    
1071  =cut  =cut
1072    
1073  sub display_identical {  sub display{
1074      my ($self, $fid, $cgi) = @_;      my ($self, $cgi, $dataset) = @_;
   
     my $content;  
     my $array=Observation->get_objects($fid);  
1075    
1076      my $all_domains = [];      my $all_domains = [];
1077      my $count_identical = 0;      my $count_identical = 0;
1078      foreach my $thing (@$array) {      my $content;
1079        foreach my $thing (@$dataset) {
1080          next if ($thing->class ne "IDENTICAL");          next if ($thing->class ne "IDENTICAL");
1081          my $single_domain = [];          my $single_domain = [];
1082          push(@$single_domain,$thing->class);          push(@$single_domain,$thing->database);
1083          my $id = $thing->id;          my $id = $thing->id;
1084          $count_identical++;          $count_identical++;
1085          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1086          push(@$single_domain,$thing->organism);          push(@$single_domain,$thing->organism);
1087          push(@$single_domain,$thing->database);          #push(@$single_domain,$thing->type);
1088          push(@$single_domain,$thing->description);          push(@$single_domain,$thing->function);
1089          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1090      }      }
1091    
1092      if ($count_identical >0){      if ($count_identical >0){
1093          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();  
1094      }      }
1095      else{      else{
1096          $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 1098 
1098      return ($content);      return ($content);
1099  }  }
1100    
1101    1;
1102    
1103    
1104    #########################################
1105    #########################################
1106    package Observation::FC;
1107    1;
1108    
1109    use base qw(Observation);
1110    
1111    sub new {
1112    
1113        my ($class,$dataset) = @_;
1114        my $self = $class->SUPER::new($dataset);
1115        $self->{score} = $dataset->{'score'};
1116        $self->{id} = $dataset->{'id'};
1117        $self->{function} = $dataset->{'function'};
1118    
1119        bless($self,$class);
1120        return $self;
1121    }
1122    
1123    =head3 display()
1124    
1125    If available use the function specified here to display the "raw" observation.
1126    This code will display a table for the identical protein
1127    
1128    
1129    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
1130    dence.
1131    
1132    =cut
1133    
1134    sub display {
1135        my ($self,$cgi,$dataset, $fid) = @_;
1136    
1137        my $functional_data = [];
1138        my $count = 0;
1139        my $content;
1140    
1141        foreach my $thing (@$dataset) {
1142            my $single_domain = [];
1143            next if ($thing->class ne "PCH");
1144            $count++;
1145    
1146            # construct the score link
1147            my $score = $thing->score;
1148            my $toid = $thing->id;
1149            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1150            my $sc_link = "<a href=$link>$score</a>";
1151    
1152            push(@$single_domain,$sc_link);
1153            push(@$single_domain,$thing->id);
1154            push(@$single_domain,$thing->function);
1155            push(@$functional_data,$single_domain);
1156        }
1157    
1158        if ($count >0){
1159            $content = $functional_data;
1160        }
1161        else
1162        {
1163            $content = "<p>This PEG does not have any functional coupling</p>";
1164        }
1165        return ($content);
1166    }
1167    
1168    
1169    #########################################
1170    #########################################
1171  package Observation::Domain;  package Observation::Domain;
1172    
1173  use base qw(Observation);  use base qw(Observation);
# Line 886  Line 1209 
1209      push(@$descriptions,$score);      push(@$descriptions,$score);
1210    
1211      my $link_id;      my $link_id;
1212      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/\w+::(\d+)/){
1213          $link_id = $1;          $link_id = $1;
1214      }      }
1215    
1216      my $link;      my $link;
1217        my $link_url;
1218        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"}
1219        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1220        else{$link_url = "NO_URL"}
1221    
1222      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1223               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1224      push(@$links_list,$link);      push(@$links_list,$link);
1225    
1226      my $element_hash = {      my $element_hash = {
# Line 911  Line 1239 
1239    
1240  }  }
1241    
1242    #########################################
1243    #########################################
1244    package Observation::Location;
1245    
1246    use base qw(Observation);
1247    
1248    sub new {
1249    
1250        my ($class,$dataset) = @_;
1251        my $self = $class->SUPER::new($dataset);
1252        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1253        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1254        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1255        $self->{cello_location} = $dataset->{'cello_location'};
1256        $self->{cello_score} = $dataset->{'cello_score'};
1257        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1258        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1259    
1260        bless($self,$class);
1261        return $self;
1262    }
1263    
1264    sub display {
1265        my ($thing,$gd,$fid) = @_;
1266    
1267        my $fig= new FIG;
1268        my $length = length($fig->get_translation($fid));
1269    
1270        my $cleavage_prob;
1271        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1272        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1273        my $signal_peptide_score = $thing->signal_peptide_score;
1274        my $cello_location = $thing->cello_location;
1275        my $cello_score = $thing->cello_score;
1276        my $tmpred_score = $thing->tmpred_score;
1277        my @tmpred_locations = split(",",$thing->tmpred_locations);
1278    
1279        my $lines = [];
1280        my $line_config = { 'title' => 'Localization Evidence',
1281                            'short_title' => 'Local',
1282                            'basepair_offset' => '1' };
1283    
1284        #color is
1285        my $color = "5";
1286    
1287        my $line_data = [];
1288    
1289        if($cello_location){
1290            my $cello_descriptions = [];
1291            my $description_cello_location = {"title" => 'Best Cello Location',
1292                                              "value" => $cello_location};
1293    
1294            push(@$cello_descriptions,$description_cello_location);
1295    
1296            my $description_cello_score = {"title" => 'Cello Score',
1297                                           "value" => $cello_score};
1298    
1299            push(@$cello_descriptions,$description_cello_score);
1300    
1301            my $element_hash = {
1302                "title" => "CELLO",
1303                "start" => "1",
1304                "end" =>  $length + 1,
1305                "color"=> $color,
1306                "type" => 'box',
1307                "zlayer" => '2',
1308                "description" => $cello_descriptions};
1309    
1310            push(@$line_data,$element_hash);
1311        }
1312    
1313        my $color = "6";
1314        #if(0){
1315        if($tmpred_score){
1316            foreach my $tmpred (@tmpred_locations){
1317                my $descriptions = [];
1318                my ($begin,$end) =split("-",$tmpred);
1319                my $description_tmpred_score = {"title" => 'TMPRED score',
1320                                 "value" => $tmpred_score};
1321    
1322                push(@$descriptions,$description_tmpred_score);
1323    
1324                my $element_hash = {
1325                "title" => "transmembrane location",
1326                "start" => $begin + 1,
1327                "end" =>  $end + 1,
1328                "color"=> $color,
1329                "zlayer" => '5',
1330                "type" => 'smallbox',
1331                "description" => $descriptions};
1332    
1333                push(@$line_data,$element_hash);
1334            }
1335        }
1336    
1337        my $color = "1";
1338        if($signal_peptide_score){
1339            my $descriptions = [];
1340            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1341                                                    "value" => $signal_peptide_score};
1342    
1343            push(@$descriptions,$description_signal_peptide_score);
1344    
1345            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1346                                             "value" => $cleavage_prob};
1347    
1348            push(@$descriptions,$description_cleavage_prob);
1349    
1350            my $element_hash = {
1351                "title" => "SignalP",
1352                "start" => $cleavage_loc_begin - 2,
1353                "end" =>  $cleavage_loc_end + 3,
1354                "type" => 'bigbox',
1355                "color"=> $color,
1356                "zlayer" => '10',
1357                "description" => $descriptions};
1358    
1359            push(@$line_data,$element_hash);
1360        }
1361    
1362        $gd->add_line($line_data, $line_config);
1363    
1364        return ($gd);
1365    
1366    }
1367    
1368    sub cleavage_loc {
1369      my ($self) = @_;
1370    
1371      return $self->{cleavage_loc};
1372    }
1373    
1374    sub cleavage_prob {
1375      my ($self) = @_;
1376    
1377      return $self->{cleavage_prob};
1378    }
1379    
1380    sub signal_peptide_score {
1381      my ($self) = @_;
1382    
1383      return $self->{signal_peptide_score};
1384    }
1385    
1386    sub tmpred_score {
1387      my ($self) = @_;
1388    
1389      return $self->{tmpred_score};
1390    }
1391    
1392    sub tmpred_locations {
1393      my ($self) = @_;
1394    
1395      return $self->{tmpred_locations};
1396    }
1397    
1398    sub cello_location {
1399      my ($self) = @_;
1400    
1401      return $self->{cello_location};
1402    }
1403    
1404    sub cello_score {
1405      my ($self) = @_;
1406    
1407      return $self->{cello_score};
1408    }
1409    
1410    
1411    #########################################
1412    #########################################
1413    package Observation::Sims;
1414    
1415    use base qw(Observation);
1416    
1417    sub new {
1418    
1419        my ($class,$dataset) = @_;
1420        my $self = $class->SUPER::new($dataset);
1421        $self->{identity} = $dataset->{'identity'};
1422        $self->{acc} = $dataset->{'acc'};
1423        $self->{evalue} = $dataset->{'evalue'};
1424        $self->{qstart} = $dataset->{'qstart'};
1425        $self->{qstop} = $dataset->{'qstop'};
1426        $self->{hstart} = $dataset->{'hstart'};
1427        $self->{hstop} = $dataset->{'hstop'};
1428        $self->{database} = $dataset->{'database'};
1429        $self->{organism} = $dataset->{'organism'};
1430        $self->{function} = $dataset->{'function'};
1431        $self->{qlength} = $dataset->{'qlength'};
1432        $self->{hlength} = $dataset->{'hlength'};
1433    
1434        bless($self,$class);
1435        return $self;
1436    }
1437    
1438    =head3 display()
1439    
1440    If available use the function specified here to display the "raw" observation.
1441    This code will display a table for the similarities protein
1442    
1443    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.
1444    
1445    =cut
1446    
1447    sub display {
1448        my ($self,$cgi,$dataset) = @_;
1449    
1450        my $data = [];
1451        my $count = 0;
1452        my $content;
1453        my $fig = new FIG;
1454    
1455        foreach my $thing (@$dataset) {
1456            my $single_domain = [];
1457            next if ($thing->class ne "SIM");
1458            $count++;
1459    
1460            my $id = $thing->acc;
1461    
1462            # add the subsystem information
1463            my @in_sub  = $fig->peg_to_subsystems($id);
1464            my $in_sub;
1465    
1466            if (@in_sub > 0) {
1467                $in_sub = @in_sub;
1468    
1469                # RAE: add a javascript popup with all the subsystems
1470                my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1471                $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);
1472            } else {
1473                $in_sub = "&nbsp;";
1474            }
1475    
1476            # add evidence code with tool tip
1477            my $ev_codes=" &nbsp; ";
1478            my @ev_codes = "";
1479            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1480                my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);
1481                @ev_codes = ();
1482                foreach my $code (@codes) {
1483                    my $pretty_code = $code->[2];
1484                    if ($pretty_code =~ /;/) {
1485                        my ($cd, $ss) = split(";", $code->[2]);
1486                        $ss =~ s/_/ /g;
1487                        $pretty_code = $cd;# . " in " . $ss;
1488                    }
1489                    push(@ev_codes, $pretty_code);
1490                }
1491            }
1492    
1493            if (scalar(@ev_codes) && $ev_codes[0]) {
1494                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
1495                $ev_codes = $cgi->a(
1496                                    {
1497                                        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));
1498            }
1499    
1500            # add the aliases
1501            my $aliases = undef;
1502            $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );
1503            $aliases = &HTML::set_prot_links( $cgi, $aliases );
1504            $aliases ||= "&nbsp;";
1505    
1506            my $iden    = $thing->identity;
1507            my $ln1     = $thing->qlength;
1508            my $ln2     = $thing->hlength;
1509            my $b1      = $thing->qstart;
1510            my $e1      = $thing->qstop;
1511            my $b2      = $thing->hstart;
1512            my $e2      = $thing->hstop;
1513            my $d1      = abs($e1 - $b1) + 1;
1514            my $d2      = abs($e2 - $b2) + 1;
1515            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1516            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1517    
1518    
1519            push(@$single_domain,$thing->database);
1520            push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
1521            push(@$single_domain,$thing->evalue);
1522            push(@$single_domain,"$iden\%");
1523            push(@$single_domain,$reg1);
1524            push(@$single_domain,$reg2);
1525            push(@$single_domain,$in_sub);
1526            push(@$single_domain,$ev_codes);
1527            push(@$single_domain,$thing->organism);
1528            push(@$single_domain,$thing->function);
1529            push(@$single_domain,$aliases);
1530            push(@$data,$single_domain);
1531        }
1532    
1533        if ($count >0){
1534            $content = $data;
1535        }
1536        else
1537        {
1538            $content = "<p>This PEG does not have any similarities</p>";
1539        }
1540        return ($content);
1541    }
1542    
1543    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1544    
1545    
1546    
1547    ############################
1548    package Observation::Cluster;
1549    
1550    use base qw(Observation);
1551    
1552    sub new {
1553    
1554        my ($class,$dataset) = @_;
1555        my $self = $class->SUPER::new($dataset);
1556    
1557        bless($self,$class);
1558        return $self;
1559    }
1560    
1561    sub display {
1562        my ($self,$gd, $fid) = @_;
1563    
1564        my $fig = new FIG;
1565        my $all_regions = [];
1566    
1567        #get the organism genome
1568        my $target_genome = $fig->genome_of($fid);
1569    
1570        # get location of the gene
1571        my $data = $fig->feature_location($fid);
1572        my ($contig, $beg, $end);
1573    
1574        if ($data =~ /(.*)_(\d+)_(\d+)$/){
1575            $contig = $1;
1576            $beg = $2;
1577            $end = $3;
1578        }
1579    
1580        my ($region_start, $region_end);
1581        if ($beg < $end)
1582        {
1583            $region_start = $beg - 4000;
1584            $region_end = $end+4000;
1585        }
1586        else
1587        {
1588            $region_end = $end+4000;
1589            $region_start = $beg-4000;
1590        }
1591    
1592        # call genes in region
1593        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_stop);
1594        push(@$all_regions,$target_gene_features);
1595    
1596        my %all_genes;
1597        my %all_genomes;
1598        foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1}
1599    
1600        my @coup = $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1601    
1602        foreach my $pair (@$coup[0]->[2]){
1603            my ($peg1,$peg2) = @$pair;
1604            my $location = $fig->feature_location($peg1);
1605            my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1606            if($location =~/(.*)_(\d+)_(\d+)$/){
1607                $pair_contig = $1;
1608                $pair_beg = $2;
1609                $pair_end = $3;
1610                if ($pair_beg < $pair_end)
1611                {
1612                    $pair_region_start = $pair_beg - 4000;
1613                    $pair_region_end = $pair_end+4000;
1614                }
1615                else
1616                {
1617                    $pair_region_end = $pair_end+4000;
1618                    $pair_region_start = $pair_beg-4000;
1619                }
1620    
1621                $pair_genome = $fig->genome_of($peg1);
1622                $all_genomes{$pair_genome} = 1;
1623                my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1624                push(@$all_regions,$pair_features);
1625                foreach my $pair_feature (@$pair_features){ $all_genes{$feature} = 1}
1626    
1627            }
1628        }
1629    
1630        my $bbh_sets = [];
1631        my %already;
1632        foreach my $gene_key (keys(%all_genes)){
1633            if($already{$gene_key}){next;}
1634            my $gene_set = [$gene_key];
1635            foreach my $genome_key (keys(%all_genomes)){
1636                my $return = $fig->bbh_list($genome_key,[$gene_key]);
1637                my @$feature_list = $return->{$gene_key};
1638                foreach my $fl (@$feature_list){
1639                    push(@$gene_set,$fl);
1640                    $already{$fl} = 1;
1641                }
1642            }
1643            $already{$gene_key} = 1;
1644            push(@$bbh_sets,$gene_set);
1645        }
1646    
1647        %bbh_set_rank;
1648        my $order = 0;
1649        foreach my $set (@$bbh_sets){
1650            my $count = scalar(@$set);
1651            $bbh_rank{$order} = $count;
1652            $order++;
1653        }
1654    
1655        my %peg_rank;
1656        my $counter =  1;
1657        foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){
1658            my $good_set = @$bbh_sets[$bbh_order];
1659            foreach my $peg (@$good_set){
1660                $peg_rank{$peg} = $counter;
1661            }
1662            $counter++;
1663        }
1664    
1665        foreach my $region (@$all_regions){
1666            my $sample_peg = @$region[0];
1667            my $region_genome = $fig->genome_of($sample_peg);
1668            my $region_gs = $fig->genus_species($region_genome);
1669            my $line_config = { 'title' => $region_gs,
1670                                'short_title' => $region_gs,
1671                                'height' => 30,
1672                                'basepair_offset' => '0';
1673                            };
1674            my $line_data = [];
1675            foreach my $fid (@$region){
1676                my $element_hash;
1677                my $links_list = [];
1678                my $descriptions = [];
1679    
1680                my $color = $peg_rank{$fid};
1681                my $fid_location = $fig->feature_location($fid);
1682                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
1683                    my($start,$stop);
1684                    if ($2 < $3){$start = $2; $stop = $3;}
1685                    else{$stop = $2; $start = $3;}
1686                    $element_hash = {
1687                        "title" => $fid,
1688                        "start" => $start,
1689                        "end" =>  $stop,
1690                        "type"=> 'arrow',
1691                        "color"=> $color,
1692                        "zlayer" => "2",
1693                    };
1694                    push(@$line_data,$element_hash);
1695                }
1696            }
1697            $gd->add_line($line_data, $line_config);
1698        }
1699        return $gd;
1700    }
1701    
1702    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3