[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.11, Thu Jun 21 21:15:23 2007 UTC revision 1.19, Wed Jun 27 14:59:39 2007 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3    use lib '/vol/ontologies';
4    use DBMaster;
5    
6  require Exporter;  require Exporter;
7  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
8    
9    use FIG_Config;
10  use strict;  use strict;
11  use warnings;  #use warnings;
12  use HTML;  use HTML;
13    
14  1;  1;
# Line 118  Line 122 
122    
123  =item PFAM (dom)  =item PFAM (dom)
124    
125  =item SIGNALP (dom)  =item SIGNALP_CELLO_TMPRED (loc)
   
 =item  CELLO(loc)  
126    
127  =item TMHMM (loc)  =item TMHMM (loc)
128    
# Line 287  Line 289 
289  }  }
290    
291    
292  =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".  
293    
294  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
295    
296  =cut  =cut
297    
# Line 397  Line 395 
395  sub get_objects {  sub get_objects {
396      my ($self,$fid,$classes) = @_;      my ($self,$fid,$classes) = @_;
397    
   
398      my $objects = [];      my $objects = [];
399      my @matched_datasets=();      my @matched_datasets=();
400    
# Line 411  Line 408 
408          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
409      }      }
410      else{      else{
         #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based  
411          my %domain_classes;          my %domain_classes;
412          my $identical_flag=0;          my $identical_flag=0;
413          my $pch_flag=0;          my $pch_flag=0;
414            my $location_flag = 0;
415          my $sims_flag=0;          my $sims_flag=0;
416            my $cluster_flag = 0;
417          foreach my $class (@$classes){          foreach my $class (@$classes){
418              if($class =~ /(IPR|CDD|PFAM)/){              if($class =~ /(IPR|CDD|PFAM)/){
419                  $domain_classes{$class} = 1;                  $domain_classes{$class} = 1;
# Line 428  Line 426 
426              {              {
427                  $pch_flag = 1;                  $pch_flag = 1;
428              }              }
429                elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)
430                {
431                    $location_flag = 1;
432                }
433              elsif ($class eq "SIM")              elsif ($class eq "SIM")
434              {              {
435                  $sims_flag = 1;                  $sims_flag = 1;
436              }              }
437                elsif ($class eq "CLUSTER")
438                {
439                    $cluster_flag = 1;
440                }
441          }          }
442    
443          if ($identical_flag ==1)          if ($identical_flag ==1)
# Line 450  Line 456 
456              get_sims_observations($fid,\@matched_datasets);              get_sims_observations($fid,\@matched_datasets);
457          }          }
458    
459          #add CELLO and SignalP later          if ($location_flag == 1)
460            {
461                get_attribute_based_location_observations($fid,\@matched_datasets);
462            }
463            if ($cluster_flag == 1)
464            {
465                get_cluster_observations($fid,\@matched_datasets);
466            }
467    
468      }      }
469    
470      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 464  Line 478 
478          if ($dataset->{'class'} eq "IDENTICAL"){          if ($dataset->{'class'} eq "IDENTICAL"){
479              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
480          }          }
481            if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
482                $object = Observation::Location->new($dataset);
483            }
484          if ($dataset->{'class'} eq "SIM"){          if ($dataset->{'class'} eq "SIM"){
485              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
486          }          }
487            if ($dataset->{'class'} eq "CLUSTER"){
488                $object = Observation::Cluster->new($dataset);
489            }
490          push (@$objects, $object);          push (@$objects, $object);
491      }      }
492    
# Line 585  Line 605 
605      }      }
606  }  }
607    
608    sub get_attribute_based_location_observations{
609    
610        my ($fid,$datasets_ref) = (@_);
611        my $fig = new FIG;
612    
613        my $location_attributes = ['SignalP','CELLO','TMPRED'];
614    
615        my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};
616        foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
617            my $key = @$attr_ref[1];
618            my @parts = split("::",$key);
619            my $sub_class = $parts[0];
620            my $sub_key = $parts[1];
621            my $value = @$attr_ref[2];
622            if($sub_class eq "SignalP"){
623                if($sub_key eq "cleavage_site"){
624                    my @value_parts = split(";",$value);
625                    $dataset->{'cleavage_prob'} = $value_parts[0];
626                    $dataset->{'cleavage_loc'} = $value_parts[1];
627                }
628                elsif($sub_key eq "signal_peptide"){
629                    $dataset->{'signal_peptide_score'} = $value;
630                }
631            }
632            elsif($sub_class eq "CELLO"){
633                $dataset->{'cello_location'} = $sub_key;
634                $dataset->{'cello_score'} = $value;
635            }
636            elsif($sub_class eq "TMPRED"){
637                my @value_parts = split(";",$value);
638                $dataset->{'tmpred_score'} = $value_parts[0];
639                $dataset->{'tmpred_locations'} = $value_parts[1];
640            }
641        }
642    
643        push (@{$datasets_ref} ,$dataset);
644    
645    }
646    
647    
648  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
649    
650  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 657  Line 717 
717      }      }
718  }  }
719    
720    =head3 get_cluster_observations() (internal)
721    
722    This methods sets the type and class for cluster observations
723    
724    =cut
725    
726    sub get_cluster_observations{
727        my ($fid,$datasets_ref) = (@_);
728    
729        my $dataset = {'class' => 'CLUSTER',
730                       'type' => 'fc'
731                       };
732        push (@{$datasets_ref} ,$dataset);
733    }
734    
735    
736  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
737    
738  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 1124  Line 1200 
1200      my $links_list = [];      my $links_list = [];
1201      my $descriptions = [];      my $descriptions = [];
1202    
1203      my $description_function;      my $db_and_id = $thing->acc;
1204      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1205    
1206      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology');
1207    
1208        my ($name_title,$name_value,$description_title,$description_value);
1209        if($db eq "CDD"){
1210            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1211            if(!scalar(@$cdd_objs)){
1212                $name_title = "name";
1213                $name_value = "not available";
1214                $description_title = "description";
1215                $description_value = "not available";
1216            }
1217            else{
1218                my $cdd_obj = $cdd_objs->[0];
1219                $name_title = "name";
1220                $name_value = $cdd_obj->term;
1221                $description_title = "description";
1222                $description_value = $cdd_obj->description;
1223            }
1224        }
1225    
1226        my $name;
1227        $name = {"title" => $name_title,
1228                 "value" => $name_value};
1229        push(@$descriptions,$name);
1230    
1231        my $description;
1232        $description = {"title" => $description_title,
1233                                 "value" => $description_value};
1234        push(@$descriptions,$description);
1235    
1236      my $score;      my $score;
1237      $score = {"title" => "score",      $score = {"title" => "score",
# Line 1136  Line 1239 
1239      push(@$descriptions,$score);      push(@$descriptions,$score);
1240    
1241      my $link_id;      my $link_id;
1242      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/\w+::(\d+)/){
1243          $link_id = $1;          $link_id = $1;
1244      }      }
1245    
1246      my $link;      my $link;
1247        my $link_url;
1248        if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1249        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1250        else{$link_url = "NO_URL"}
1251    
1252      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1253               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1254      push(@$links_list,$link);      push(@$links_list,$link);
1255    
1256      my $element_hash = {      my $element_hash = {
# Line 1163  Line 1271 
1271    
1272  #########################################  #########################################
1273  #########################################  #########################################
1274    package Observation::Location;
1275    
1276    use base qw(Observation);
1277    
1278    sub new {
1279    
1280        my ($class,$dataset) = @_;
1281        my $self = $class->SUPER::new($dataset);
1282        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1283        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1284        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1285        $self->{cello_location} = $dataset->{'cello_location'};
1286        $self->{cello_score} = $dataset->{'cello_score'};
1287        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1288        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1289    
1290        bless($self,$class);
1291        return $self;
1292    }
1293    
1294    sub display {
1295        my ($thing,$gd,$fid) = @_;
1296    
1297        my $fig= new FIG;
1298        my $length = length($fig->get_translation($fid));
1299    
1300        my $cleavage_prob;
1301        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1302        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1303        my $signal_peptide_score = $thing->signal_peptide_score;
1304        my $cello_location = $thing->cello_location;
1305        my $cello_score = $thing->cello_score;
1306        my $tmpred_score = $thing->tmpred_score;
1307        my @tmpred_locations = split(",",$thing->tmpred_locations);
1308    
1309        my $lines = [];
1310        my $line_config = { 'title' => 'Localization Evidence',
1311                            'short_title' => 'Local',
1312                            'basepair_offset' => '1' };
1313    
1314        #color is
1315        my $color = "5";
1316    
1317        my $line_data = [];
1318    
1319        if($cello_location){
1320            my $cello_descriptions = [];
1321            my $description_cello_location = {"title" => 'Best Cello Location',
1322                                              "value" => $cello_location};
1323    
1324            push(@$cello_descriptions,$description_cello_location);
1325    
1326            my $description_cello_score = {"title" => 'Cello Score',
1327                                           "value" => $cello_score};
1328    
1329            push(@$cello_descriptions,$description_cello_score);
1330    
1331            my $element_hash = {
1332                "title" => "CELLO",
1333                "start" => "1",
1334                "end" =>  $length + 1,
1335                "color"=> $color,
1336                "type" => 'box',
1337                "zlayer" => '2',
1338                "description" => $cello_descriptions};
1339    
1340            push(@$line_data,$element_hash);
1341        }
1342    
1343        my $color = "6";
1344        #if(0){
1345        if($tmpred_score){
1346            foreach my $tmpred (@tmpred_locations){
1347                my $descriptions = [];
1348                my ($begin,$end) =split("-",$tmpred);
1349                my $description_tmpred_score = {"title" => 'TMPRED score',
1350                                 "value" => $tmpred_score};
1351    
1352                push(@$descriptions,$description_tmpred_score);
1353    
1354                my $element_hash = {
1355                "title" => "transmembrane location",
1356                "start" => $begin + 1,
1357                "end" =>  $end + 1,
1358                "color"=> $color,
1359                "zlayer" => '5',
1360                "type" => 'smallbox',
1361                "description" => $descriptions};
1362    
1363                push(@$line_data,$element_hash);
1364            }
1365        }
1366    
1367        my $color = "1";
1368        if($signal_peptide_score){
1369            my $descriptions = [];
1370            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1371                                                    "value" => $signal_peptide_score};
1372    
1373            push(@$descriptions,$description_signal_peptide_score);
1374    
1375            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1376                                             "value" => $cleavage_prob};
1377    
1378            push(@$descriptions,$description_cleavage_prob);
1379    
1380            my $element_hash = {
1381                "title" => "SignalP",
1382                "start" => $cleavage_loc_begin - 2,
1383                "end" =>  $cleavage_loc_end + 3,
1384                "type" => 'bigbox',
1385                "color"=> $color,
1386                "zlayer" => '10',
1387                "description" => $descriptions};
1388    
1389            push(@$line_data,$element_hash);
1390        }
1391    
1392        $gd->add_line($line_data, $line_config);
1393    
1394        return ($gd);
1395    
1396    }
1397    
1398    sub cleavage_loc {
1399      my ($self) = @_;
1400    
1401      return $self->{cleavage_loc};
1402    }
1403    
1404    sub cleavage_prob {
1405      my ($self) = @_;
1406    
1407      return $self->{cleavage_prob};
1408    }
1409    
1410    sub signal_peptide_score {
1411      my ($self) = @_;
1412    
1413      return $self->{signal_peptide_score};
1414    }
1415    
1416    sub tmpred_score {
1417      my ($self) = @_;
1418    
1419      return $self->{tmpred_score};
1420    }
1421    
1422    sub tmpred_locations {
1423      my ($self) = @_;
1424    
1425      return $self->{tmpred_locations};
1426    }
1427    
1428    sub cello_location {
1429      my ($self) = @_;
1430    
1431      return $self->{cello_location};
1432    }
1433    
1434    sub cello_score {
1435      my ($self) = @_;
1436    
1437      return $self->{cello_score};
1438    }
1439    
1440    
1441    #########################################
1442    #########################################
1443  package Observation::Sims;  package Observation::Sims;
1444    
1445  use base qw(Observation);  use base qw(Observation);
# Line 1294  Line 1571 
1571  }  }
1572    
1573  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1574    
1575    
1576    
1577    ############################
1578    package Observation::Cluster;
1579    
1580    use base qw(Observation);
1581    
1582    sub new {
1583    
1584        my ($class,$dataset) = @_;
1585        my $self = $class->SUPER::new($dataset);
1586    
1587        bless($self,$class);
1588        return $self;
1589    }
1590    
1591    sub display {
1592        my ($self,$gd, $fid) = @_;
1593    
1594        my $fig = new FIG;
1595        my $all_regions = [];
1596    
1597        #get the organism genome
1598        my $target_genome = $fig->genome_of($fid);
1599    
1600        # get location of the gene
1601        my $data = $fig->feature_location($fid);
1602        my ($contig, $beg, $end);
1603    
1604        if ($data =~ /(.*)_(\d+)_(\d+)$/){
1605            $contig = $1;
1606            $beg = $2;
1607            $end = $3;
1608        }
1609    
1610        my ($region_start, $region_end);
1611        if ($beg < $end)
1612        {
1613            $region_start = $beg - 4000;
1614            $region_end = $end+4000;
1615        }
1616        else
1617        {
1618            $region_end = $end+4000;
1619            $region_start = $beg-4000;
1620        }
1621    
1622        # call genes in region
1623        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
1624        push(@$all_regions,$target_gene_features);
1625        my (@start_array_region);
1626        push (@start_array_region, $region_start);
1627    
1628        my %all_genes;
1629        my %all_genomes;
1630        foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}
1631    
1632        my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1633    
1634        my $coup_count = 0;
1635    
1636        foreach my $pair (@{$coup[0]->[2]}) {
1637            last if ($coup_count > 10);
1638            my ($peg1,$peg2) = @$pair;
1639    
1640            my $location = $fig->feature_location($peg1);
1641            my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1642            if($location =~/(.*)_(\d+)_(\d+)$/){
1643                $pair_contig = $1;
1644                $pair_beg = $2;
1645                $pair_end = $3;
1646                if ($pair_beg < $pair_end)
1647                {
1648                    $pair_region_start = $pair_beg - 4000;
1649                    $pair_region_stop = $pair_end+4000;
1650                }
1651                else
1652                {
1653                    $pair_region_stop = $pair_end+4000;
1654                    $pair_region_start = $pair_beg-4000;
1655                }
1656    
1657                push (@start_array_region, $pair_region_start);
1658    
1659                $pair_genome = $fig->genome_of($peg1);
1660                $all_genomes{$pair_genome} = 1;
1661                my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1662                push(@$all_regions,$pair_features);
1663                foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}
1664            }
1665            $coup_count++;
1666        }
1667    
1668        my $bbh_sets = [];
1669        my %already;
1670        foreach my $gene_key (keys(%all_genes)){
1671            if($already{$gene_key}){next;}
1672            my $gene_set = [$gene_key];
1673    
1674            my $gene_key_genome = $fig->genome_of($gene_key);
1675    
1676            foreach my $genome_key (keys(%all_genomes)){
1677                #next if ($gene_key_genome eq $genome_key);
1678                my $return = $fig->bbh_list($genome_key,[$gene_key]);
1679    
1680                my $feature_list = $return->{$gene_key};
1681                foreach my $fl (@$feature_list){
1682                    push(@$gene_set,$fl);
1683                }
1684            }
1685            $already{$gene_key} = 1;
1686            push(@$bbh_sets,$gene_set);
1687        }
1688    
1689        my %bbh_set_rank;
1690        my $order = 0;
1691        foreach my $set (@$bbh_sets){
1692            my $count = scalar(@$set);
1693            $bbh_set_rank{$order} = $count;
1694            $order++;
1695        }
1696    
1697        my %peg_rank;
1698        my $counter =  1;
1699        foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){
1700            my $good_set = @$bbh_sets[$bbh_order];
1701            my $flag_set = 0;
1702            if (scalar (@$good_set) > 1)
1703            {
1704                foreach my $peg (@$good_set){
1705                    if ((!$peg_rank{$peg})){
1706                        $peg_rank{$peg} = $counter;
1707                        $flag_set = 1;
1708                    }
1709                }
1710                $counter++ if ($flag_set == 1);
1711            }
1712            else
1713            {
1714                foreach my $peg (@$good_set){
1715                    $peg_rank{$peg} = 100;
1716                }
1717            }
1718        }
1719    
1720        open (FH, ">$FIG_Config::temp/good_sets.txt");
1721        foreach my $pr (sort {$peg_rank{$a} <=> $peg_rank{$b}} keys(%peg_rank)){ print FH "rank:$peg_rank{$pr}\tpr:$pr\n";}
1722        close (FH);
1723    
1724        foreach my $region (@$all_regions){
1725            my $sample_peg = @$region[0];
1726            my $region_genome = $fig->genome_of($sample_peg);
1727            my $region_gs = $fig->genus_species($region_genome);
1728            my $abbrev_name = $fig->abbrev($region_gs);
1729            my $line_config = { 'title' => $region_gs,
1730                                'short_title' => $abbrev_name,
1731                                'basepair_offset' => '0'
1732                                };
1733    
1734            my $offset = shift @start_array_region;
1735    
1736            my $line_data = [];
1737            foreach my $fid1 (@$region){
1738                my $element_hash;
1739                my $links_list = [];
1740                my $descriptions = [];
1741    
1742                my $color = $peg_rank{$fid1};
1743                if ($color == 1) {
1744                    print STDERR "PEG: $fid1, RANK: $color";
1745                }
1746    
1747                # get subsystem information
1748                my $function = $fig->function_of($fid1);
1749                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;
1750    
1751                my $link;
1752                $link = {"link_title" => $fid1,
1753                         "link" => $url_link};
1754                push(@$links_list,$link);
1755    
1756                my @subsystems = $fig->peg_to_subsystems($fid1);
1757                foreach my $subsystem (@subsystems){
1758                    my $link;
1759                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1760                             "link_title" => $subsystem};
1761                    push(@$links_list,$link);
1762                }
1763    
1764                my $description_function;
1765                $description_function = {"title" => "function",
1766                                         "value" => $function};
1767                push(@$descriptions,$description_function);
1768    
1769                my $description_ss;
1770                my $ss_string = join (",", @subsystems);
1771                $description_ss = {"title" => "subsystems",
1772                                   "value" => $ss_string};
1773                push(@$descriptions,$description_ss);
1774    
1775    
1776                my $fid_location = $fig->feature_location($fid1);
1777                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
1778                    my($start,$stop);
1779                    if ($2 < $3){$start = $2; $stop = $3;}
1780                    else{$stop = $2; $start = $3;}
1781                    $start = $start - $offset;
1782                    $stop = $stop - $offset;
1783                    $element_hash = {
1784                        "title" => $fid1,
1785                        "start" => $start,
1786                        "end" =>  $stop,
1787                        "type"=> 'arrow',
1788                        "color"=> $color,
1789                        "zlayer" => "2",
1790                        "links_list" => $links_list,
1791                        "description" => $descriptions
1792                    };
1793                    push(@$line_data,$element_hash);
1794                }
1795            }
1796            $gd->add_line($line_data, $line_config);
1797        }
1798        return $gd;
1799    }
1800    
1801    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3