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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3