[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.10, Wed Jun 20 20:55:36 2007 UTC revision 1.12, Fri Jun 22 00:22:32 2007 UTC
# Line 118  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 186  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 213  Line 285 
285  }  }
286    
287    
288  =head3 display_method()  =head3 display()
289    
290  If available use the function specified here to display the "raw" observation.  will be different for each type
 In the case of a BLAST alignment of fid1 and fid2 a cgi script  
 will be called to display the results of running the command "bl2seq fid1 fid2".  
   
 B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.  
291    
292  =cut  =cut
293    
# Line 337  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;          my $identical_flag=0;
410          my $pch_flag=0;          my $pch_flag=0;
411            my $location_flag = 0;
412          my $sims_flag=0;          my $sims_flag=0;
413          foreach my $class (@$classes){          foreach my $class (@$classes){
414              if($class =~ /(IPR|CDD|PFAM)/){              if($class =~ /(IPR|CDD|PFAM)/){
# Line 354  Line 422 
422              {              {
423                  $pch_flag = 1;                  $pch_flag = 1;
424              }              }
425                elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)
426                {
427                    $location_flag = 1;
428                }
429              elsif ($class eq "SIM")              elsif ($class eq "SIM")
430              {              {
431                  $sims_flag = 1;                  $sims_flag = 1;
# Line 376  Line 448 
448              get_sims_observations($fid,\@matched_datasets);              get_sims_observations($fid,\@matched_datasets);
449          }          }
450    
451          #add CELLO and SignalP later          if ($location_flag == 1)
452            {
453                get_attribute_based_location_observations($fid,\@matched_datasets);
454            }
455    
456      }      }
457    
458      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 390  Line 466 
466          if ($dataset->{'class'} eq "IDENTICAL"){          if ($dataset->{'class'} eq "IDENTICAL"){
467              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
468          }          }
469            if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
470                $object = Observation::Location->new($dataset);
471            }
472          if ($dataset->{'class'} eq "SIM"){          if ($dataset->{'class'} eq "SIM"){
473              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
474          }          }
# Line 511  Line 590 
590      }      }
591  }  }
592    
593    sub get_attribute_based_location_observations{
594    
595        my ($fid,$datasets_ref) = (@_);
596        my $fig = new FIG;
597    
598        my $location_attributes = ['SignalP','CELLO','TMPRED'];
599    
600        my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};
601        foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
602            my $key = @$attr_ref[1];
603            my @parts = split("::",$key);
604            my $sub_class = $parts[0];
605            my $sub_key = $parts[1];
606            my $value = @$attr_ref[2];
607            if($sub_class eq "SignalP"){
608                if($sub_key eq "cleavage_site"){
609                    my @value_parts = split(";",$value);
610                    $dataset->{'cleavage_prob'} = $value_parts[0];
611                    $dataset->{'cleavage_loc'} = $value_parts[1];
612                }
613                elsif($sub_key eq "signal_peptide"){
614                    $dataset->{'signal_peptide_score'} = $value;
615                }
616            }
617            elsif($sub_class eq "CELLO"){
618                $dataset->{'cello_location'} = $sub_key;
619                $dataset->{'cello_score'} = $value;
620            }
621            elsif($sub_class eq "TMPRED"){
622                my @value_parts = split(";",$value);
623                $dataset->{'tmpred_score'} = $value_parts[0];
624                $dataset->{'tmpred_locations'} = $value_parts[1];
625            }
626        }
627    
628        push (@{$datasets_ref} ,$dataset);
629    
630    }
631    
632    
633  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
634    
635  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 593  Line 712 
712    
713      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
714      my $fig = new FIG;      my $fig = new FIG;
715      my @sims= $fig->nsims($fid,100,1e-20,"fig");  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
716        my @sims= $fig->nsims($fid,100,1e-20,"all");
717      my ($dataset);      my ($dataset);
718      foreach my $sim (@sims){      foreach my $sim (@sims){
719          my $hit = $sim->[1];          my $hit = $sim->[1];
720            my $percent = $sim->[2];
721          my $evalue = $sim->[10];          my $evalue = $sim->[10];
722          my $from = $sim->[8];          my $qfrom = $sim->[6];
723          my $to = $sim->[9];          my $qto = $sim->[7];
724            my $hfrom = $sim->[8];
725            my $hto = $sim->[9];
726            my $qlength = $sim->[12];
727            my $hlength = $sim->[13];
728            my $db = get_database($hit);
729            my $func = $fig->function_of($hit);
730            my $organism = $fig->org_of($hit);
731    
732          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
733                      'acc' => $hit,                      'acc' => $hit,
734                        'identity' => $percent,
735                      'type' => 'seq',                      'type' => 'seq',
736                      'evalue' => $evalue,                      'evalue' => $evalue,
737                      'start' => $from,                      'qstart' => $qfrom,
738                      'stop' => $to                      'qstop' => $qto,
739                        'hstart' => $hfrom,
740                        'hstop' => $hto,
741                        'database' => $db,
742                        'organism' => $organism,
743                        'function' => $func,
744                        'qlength' => $qlength,
745                        'hlength' => $hlength
746                      };                      };
747    
748          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
749      }      }
750  }  }
751    
752    =head3 get_database (internal)
753    This method gets the database association from the sequence id
754    
755    =cut
756    
757    sub get_database{
758        my ($id) = (@_);
759    
760        my ($db);
761        if ($id =~ /^fig\|/)              { $db = "FIG" }
762        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
763        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
764        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
765        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
766        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
767        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
768        elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }
769        elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
770        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
771        elsif ($id =~ /^img\|/)           { $db = "JGI" }
772    
773        return ($db);
774    
775    }
776    
777  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
778    
779  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 629  Line 791 
791      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
792          my ($tmp, $who);          my ($tmp, $who);
793          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
794              if ($id =~ /^fig\|/)           { $who = "FIG" }              $who = &get_database($id);
             elsif ($id =~ /^gi\|/)            { $who = "NCBI" }  
             elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }  
             elsif ($id =~ /^sp\|/)            { $who = "SwissProt" }  
             elsif ($id =~ /^uni\|/)           { $who = "UniProt" }  
             elsif ($id =~ /^tigr\|/)          { $who = "TIGR" }  
             elsif ($id =~ /^pir\|/)           { $who = "PIR" }  
             elsif ($id =~ /^kegg\|/)          { $who = "KEGG" }  
             elsif ($id =~ /^tr\|/)            { $who = "TrEMBL" }  
             elsif ($id =~ /^eric\|/)          { $who = "ASAP" }  
   
795              push(@funcs, [$id,$who,$tmp]);              push(@funcs, [$id,$who,$tmp]);
796          }          }
797      }      }
# Line 787  Line 939 
939    return $self;    return $self;
940  }  }
941    
942    =head3 identity (internal)
943    
944    Returns the % identity of the similar sequence
945    
946    =cut
947    
948    sub identity {
949        my ($self) = @_;
950    
951        return $self->{identity};
952    }
953    
954  =head3 feature_id (internal)  =head3 feature_id (internal)
955    
956    
# Line 847  Line 1011 
1011  }  }
1012    
1013    
1014    
1015  ############################################################  ############################################################
1016  ############################################################  ############################################################
1017  package Observation::Identical;  package Observation::Identical;
# Line 1016  Line 1181 
1181      push(@$descriptions,$score);      push(@$descriptions,$score);
1182    
1183      my $link_id;      my $link_id;
1184      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/\w+::(\d+)/){
1185          $link_id = $1;          $link_id = $1;
1186      }      }
1187    
1188      my $link;      my $link;
1189        my $link_url;
1190        if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1191        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1192        else{$link_url = "NO_URL"}
1193    
1194      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1195               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1196      push(@$links_list,$link);      push(@$links_list,$link);
1197    
1198      my $element_hash = {      my $element_hash = {
# Line 1043  Line 1213 
1213    
1214  #########################################  #########################################
1215  #########################################  #########################################
1216    package Observation::Location;
1217    
1218    use base qw(Observation);
1219    
1220    sub new {
1221    
1222        my ($class,$dataset) = @_;
1223        my $self = $class->SUPER::new($dataset);
1224        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1225        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1226        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1227        $self->{cello_location} = $dataset->{'cello_location'};
1228        $self->{cello_score} = $dataset->{'cello_score'};
1229        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1230        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1231    
1232        bless($self,$class);
1233        return $self;
1234    }
1235    
1236    sub display {
1237        my ($thing,$gd,$fid) = @_;
1238    
1239        my $fig= new FIG;
1240        my $length = length($fig->get_translation($fid));
1241    
1242        my $cleavage_prob;
1243        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1244        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1245        my $signal_peptide_score = $thing->signal_peptide_score;
1246        my $cello_location = $thing->cello_location;
1247        my $cello_score = $thing->cello_score;
1248        my $tmpred_score = $thing->tmpred_score;
1249        my @tmpred_locations = split(",",$thing->tmpred_locations);
1250    
1251        my $lines = [];
1252        my $line_config = { 'title' => 'Localization Evidence',
1253                            'short_title' => 'Local',
1254                            'basepair_offset' => '1' };
1255    
1256        #color is
1257        my $color = "5";
1258    
1259        my $line_data = [];
1260    
1261        if($cello_location){
1262            my $cello_descriptions = [];
1263            my $description_cello_location = {"title" => 'Best Cello Location',
1264                                              "value" => $cello_location};
1265    
1266            push(@$cello_descriptions,$description_cello_location);
1267    
1268            my $description_cello_score = {"title" => 'Cello Score',
1269                                           "value" => $cello_score};
1270    
1271            push(@$cello_descriptions,$description_cello_score);
1272    
1273            my $element_hash = {
1274                "title" => "CELLO",
1275                "start" => "1",
1276                "end" =>  $length + 1,
1277                "color"=> $color,
1278                "type" => 'box',
1279                "zlayer" => '2',
1280                "description" => $cello_descriptions};
1281    
1282            push(@$line_data,$element_hash);
1283        }
1284    
1285        my $color = "6";
1286        #if(0){
1287        if($tmpred_score){
1288            foreach my $tmpred (@tmpred_locations){
1289                my $descriptions = [];
1290                my ($begin,$end) =split("-",$tmpred);
1291                my $description_tmpred_score = {"title" => 'TMPRED score',
1292                                 "value" => $tmpred_score};
1293    
1294                push(@$descriptions,$description_tmpred_score);
1295    
1296                my $element_hash = {
1297                "title" => "transmembrane location",
1298                "start" => $begin + 1,
1299                "end" =>  $end + 1,
1300                "color"=> $color,
1301                "zlayer" => '5',
1302                "type" => 'smallbox',
1303                "description" => $descriptions};
1304    
1305                push(@$line_data,$element_hash);
1306            }
1307        }
1308    
1309        my $color = "1";
1310        if($signal_peptide_score){
1311            my $descriptions = [];
1312            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1313                                                    "value" => $signal_peptide_score};
1314    
1315            push(@$descriptions,$description_signal_peptide_score);
1316    
1317            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1318                                             "value" => $cleavage_prob};
1319    
1320            push(@$descriptions,$description_cleavage_prob);
1321    
1322            my $element_hash = {
1323                "title" => "SignalP",
1324                "start" => $cleavage_loc_begin - 2,
1325                "end" =>  $cleavage_loc_end + 3,
1326                "type" => 'bigbox',
1327                "color"=> $color,
1328                "zlayer" => '10',
1329                "description" => $descriptions};
1330    
1331            push(@$line_data,$element_hash);
1332        }
1333    
1334        $gd->add_line($line_data, $line_config);
1335    
1336        return ($gd);
1337    
1338    }
1339    
1340    sub cleavage_loc {
1341      my ($self) = @_;
1342    
1343      return $self->{cleavage_loc};
1344    }
1345    
1346    sub cleavage_prob {
1347      my ($self) = @_;
1348    
1349      return $self->{cleavage_prob};
1350    }
1351    
1352    sub signal_peptide_score {
1353      my ($self) = @_;
1354    
1355      return $self->{signal_peptide_score};
1356    }
1357    
1358    sub tmpred_score {
1359      my ($self) = @_;
1360    
1361      return $self->{tmpred_score};
1362    }
1363    
1364    sub tmpred_locations {
1365      my ($self) = @_;
1366    
1367      return $self->{tmpred_locations};
1368    }
1369    
1370    sub cello_location {
1371      my ($self) = @_;
1372    
1373      return $self->{cello_location};
1374    }
1375    
1376    sub cello_score {
1377      my ($self) = @_;
1378    
1379      return $self->{cello_score};
1380    }
1381    
1382    
1383    #########################################
1384    #########################################
1385  package Observation::Sims;  package Observation::Sims;
1386    
1387  use base qw(Observation);  use base qw(Observation);
# Line 1051  Line 1390 
1390    
1391      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1392      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1393        $self->{identity} = $dataset->{'identity'};
1394      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1395      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1396      $self->{start} = $dataset->{'start'};      $self->{qstart} = $dataset->{'qstart'};
1397      $self->{stop} = $dataset->{'stop'};      $self->{qstop} = $dataset->{'qstop'};
1398        $self->{hstart} = $dataset->{'hstart'};
1399        $self->{hstop} = $dataset->{'hstop'};
1400        $self->{database} = $dataset->{'database'};
1401        $self->{organism} = $dataset->{'organism'};
1402        $self->{function} = $dataset->{'function'};
1403        $self->{qlength} = $dataset->{'qlength'};
1404        $self->{hlength} = $dataset->{'hlength'};
1405    
1406      bless($self,$class);      bless($self,$class);
1407      return $self;      return $self;
# Line 1075  Line 1422 
1422      my $data = [];      my $data = [];
1423      my $count = 0;      my $count = 0;
1424      my $content;      my $content;
1425        my $fig = new FIG;
1426    
1427      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1428          my $single_domain = [];          my $single_domain = [];
1429          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1430          $count++;          $count++;
1431    
1432            my $id = $thing->acc;
1433    
1434            # add the subsystem information
1435            my @in_sub  = $fig->peg_to_subsystems($id);
1436            my $in_sub;
1437    
1438            if (@in_sub > 0) {
1439                $in_sub = @in_sub;
1440    
1441                # RAE: add a javascript popup with all the subsystems
1442                my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1443                $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);
1444            } else {
1445                $in_sub = "&nbsp;";
1446            }
1447    
1448            # add evidence code with tool tip
1449            my $ev_codes=" &nbsp; ";
1450            my @ev_codes = "";
1451            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1452                my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);
1453                @ev_codes = ();
1454                foreach my $code (@codes) {
1455                    my $pretty_code = $code->[2];
1456                    if ($pretty_code =~ /;/) {
1457                        my ($cd, $ss) = split(";", $code->[2]);
1458                        $ss =~ s/_/ /g;
1459                        $pretty_code = $cd;# . " in " . $ss;
1460                    }
1461                    push(@ev_codes, $pretty_code);
1462                }
1463            }
1464    
1465            if (scalar(@ev_codes) && $ev_codes[0]) {
1466                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
1467                $ev_codes = $cgi->a(
1468                                    {
1469                                        id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
1470            }
1471    
1472            # add the aliases
1473            my $aliases = undef;
1474            $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );
1475            $aliases = &HTML::set_prot_links( $cgi, $aliases );
1476            $aliases ||= "&nbsp;";
1477    
1478            my $iden    = $thing->identity;
1479            my $ln1     = $thing->qlength;
1480            my $ln2     = $thing->hlength;
1481            my $b1      = $thing->qstart;
1482            my $e1      = $thing->qstop;
1483            my $b2      = $thing->hstart;
1484            my $e2      = $thing->hstop;
1485            my $d1      = abs($e1 - $b1) + 1;
1486            my $d2      = abs($e2 - $b2) + 1;
1487            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1488            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1489    
1490    
1491            push(@$single_domain,$thing->database);
1492          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
         push(@$single_domain,$thing->start);  
         push(@$single_domain,$thing->stop);  
1493          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
1494            push(@$single_domain,"$iden\%");
1495            push(@$single_domain,$reg1);
1496            push(@$single_domain,$reg2);
1497            push(@$single_domain,$in_sub);
1498            push(@$single_domain,$ev_codes);
1499            push(@$single_domain,$thing->organism);
1500            push(@$single_domain,$thing->function);
1501            push(@$single_domain,$aliases);
1502          push(@$data,$single_domain);          push(@$data,$single_domain);
1503      }      }
1504    
# Line 1097  Line 1511 
1511      }      }
1512      return ($content);      return ($content);
1513  }  }
1514    
1515    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1516    

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.12

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3