Nothing
##
## Copyright 2009 Botond Sipos
## See the package description for licensing information.
##
##########################################################################/**
#
# @RdocClass CodonSubst
#
# @title "The CodonSubst class"
#
# \description{
# This is a class implementing a continuous-time Markov process acting on
# the state-space defined by the \code{CodonAlphabet} class.
#
# The rate matrix can be built from PAML files specified by the \code{paml.file} argument.
# Alternatively the rates can be specified as a list through the \code{rate.list} parameter.
#
# @classhierarchy
# }
#
# @synopsis
#
# \arguments{
# \item{name}{The name of the object.}
# \item{paml.file}{The name of the PAML file used to construct the rate matrix.}
# \item{rate.list}{A list of unscaled substitution rates (see \code{setRateList.GeneralSubstitution}).}
# \item{equ.dist}{Equilibrium distribution.}
# \item{...}{Additional arguments.}
# }
#
# \section{Fields and Methods}{
# @allmethods
# }
#
# \examples{
# # create an object
# p<-CodonSubst()
# # build rate matrix from paml file
# # buildFromPAML(p,"path_to_paml_file") # do not run this
# # get object summary
# summary(p)
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#
#*/###########################################################################
setConstructorS3(
"CodonSubst",
function(
name="Anonymous",
paml.file=NA,
rate.list=NA,
equ.dist=NA,
...
) {
got.rate.list<-!missing(rate.list);
got.equ.dist<-!missing(equ.dist);
extend.with.s<-function(this){
this<-extend(this, "CodonSubst",
.s.matrix=data.matrix(matrix(ncol=this$.alphabet$size,nrow=this$.alphabet$size)),
.paml.file=NA
);
rownames(this$.s.matrix)<-this$.alphabet$.symbols;
colnames(this$.s.matrix)<-this$.alphabet$.symbols;
# Setting diagonal elements to zero:
diag(this$.s.matrix)<-0;
return(this);
}
this<-NA;
if(missing(paml.file)){
# No PAML file given
# Got rate list and equlibrium distribution:
if(got.rate.list & got.equ.dist){
this<-GeneralSubstitution(
name=name,
alphabet=CodonAlphabet(),
rate.list=rate.list,
equ.dist=equ.dist
);
this<-extend(this, "CodonSubst");
}
# Got rate list
else if(got.rate.list & !got.equ.dist){
this<-GeneralSubstitution(
name=name,
alphabet=CodonAlphabet(),
rate.list=rate.list
);
this<-extend.with.s(this);
}
# Got equlibrium distribution,
else if(!got.rate.list & got.equ.dist){
this<-GeneralSubstitution(
name=name,
alphabet=CodonAlphabet(),
equ.dist=equ.dist
);
this<-extend(this, "CodonSubst");
this<-extend.with.s(this);
}
# Got nothing:
else if(!got.rate.list & !got.equ.dist){
this<-GeneralSubstitution(
name=name,
alphabet=CodonAlphabet()
);
this<-extend.with.s(this);
}
}
else {
# PAML file given:
if( got.rate.list){
warning("Building process from PAML file, the \"rate.list\" parameter is ignored!\n");
}
this<-GeneralSubstitution(
name=name,
alphabet=CodonAlphabet()
);
this<-extend.with.s(this);
if(got.equ.dist){
setEquDist(this,equ.dist,force=TRUE);
}
buildFromPAML(this, paml.file);
}
# Force clearing id cache:
this$name<-this$name;
return(this);
},
enforceRCC=TRUE
);
##
## Method: checkConsistency
##
###########################################################################/**
#
# @RdocMethod checkConsistency
#
# @title "Check object consistency"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{this}{An object.}
# \item{...}{Not used.}
# }
#
#
# \value{
# Returns an invisible TRUE if no inconsistencies found in the object, throws
# an error otherwise.
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#
#*/###########################################################################
setMethodS3(
"checkConsistency",
class="CodonSubst",
function(
this,
...
){
wp<-this$writeProtected;
if (wp) {
this$writeProtected<-FALSE;
}
may.fail<-function(this) {
if(!inherits(this$alphabet, "CodonAlphabet")){
throw("This process must have as alphabet an CodonAlphabet object!\n");
}
if(!any(is.na(this$.s.matrix))){
for(i in this$.alphabet$.symbols){
for(j in this$.alphabet$.symbols){
if(i != j){
expected<-this$.s.matrix[i, j] * this$.equ.dist[1,j];
actual<-this$.q.matrix$.orig.matrix[i,j];
if(!PSRoot$my.all.equal(expected, actual)){
throw("The rate matrix is not compatible with the exchangeability matrix and the equilibrium distribution!\n");
}
}
}
}
}
}
tryCatch(may.fail(this),finally=this$writeProtected<-wp);
NextMethod();
},
private=FALSE,
protected=FALSE,
overwrite=FALSE,
conflict="warning",
validators=getOption("R.methodsS3:validators:setMethodS3")
);
##
## Method: buildFromPAML
##
###########################################################################/**
#
# @RdocMethod buildFromPAML
#
# @title "Build rate matrix from PAML file"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{this}{A CodonSubst object.}
# \item{paml.file}{Path to the PAML file.}
# \item{...}{Not used.}
# }
#
# \value{
# The CodonSubst object (invisible).
# }
#
# \examples{
# # create an object
# p<-CodonSubst()
# # build rate matrix from paml file
# # buildFromPAML(p,"path_to_paml_file") # do not run this
# # get object summary
# summary(p)
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#
#*/###########################################################################
setMethodS3(
"buildFromPAML",
class="CodonSubst",
function(
this,
paml.file,
...
){
if(!missing(paml.file)){
data<-.readFromPAML(this, paml.file=paml.file);
this$.paml.file<-paml.file;
if(all(is.na(this$equDist))){
setEquDist(this, value=data[["pi"]], force=TRUE, silent=TRUE)
}
S<-data$S;
this$.s.matrix<-S;
for(i in this$.alphabet$.symbols){
for(j in this$.alphabet$.symbols){
if(i != j){
setRate(this$.q.matrix,from=i,to=j,value=(S[i,j] * this$.equ.dist[1, j]),scale=FALSE);
}
}
}
.callRateRescaling(this$.q.matrix,guess.equ=FALSE);
}
else{
throw("PAML data file not specified");
}
return(invisible(this));
},
private=FALSE,
protected=FALSE,
overwrite=FALSE,
conflict="warning",
validators=getOption("R.methodsS3:validators:setMethodS3")
);
##
## Method: .readFromPAML
##
setMethodS3(
".readFromPAML",
class="CodonSubst",
function(
this,
paml.file,
...
){
if(missing(paml.file)){
throw("No PAML data file specified!\n");
}
else if(file.access(c(paml.file), mode=0) != c(0)){
throw("The specified PAML data file \"",paml.file,"\" does not exist!\n",sep="");
}
else if(file.access(c(paml.file), mode=4) != c(0)){
throw("The specified PAML data file \"",paml.file,"\" cannot be opened for reading because of insufficient permissions!\n",sep="");
}
else {
size<-this$alphabet$size;
symbols<-this$alphabet$symbols;
lines<-scan(file=paml.file,what="character",sep="\n",blank.lines.skip=FALSE,quiet=TRUE);
is.blank<-function(line){
if(length(grep(pattern="^\\s*$",x=line,perl=TRUE,value=FALSE)) > 0 ){
return(TRUE);
}
else if(length(grep(pattern="\\d",x=line,perl=TRUE,value=FALSE)) < 1){
# If the line has no decimal number than is considered blank!
return(TRUE);
}
return(FALSE);
}
# Skip blank lines:
count<-1;
while(is.blank(lines[[count]])){
count<-count+1;
}
skip<-count-1;
# Find the beggining of the equilibrium distribution:
count<-skip+size+1;
while(is.blank(lines[[count]])){
count<-count+1;
}
equ.skip<-count-1;
# How many lines has the equilibrium distribution?
count<-equ.skip;
while(!is.blank(lines[[count<-count+1]])){ }
equ.nlines<-count-equ.skip-1;
# We don't need the lines any more.
rm(lines);
# Reading the exchangeability matrix:
# Assuming here that the order of the
# codons is the same as in the CodonAlphabet
# object.
numbers<-scan(file=paml.file,what=0.0,skip=skip,nlines=(size-1),quiet=TRUE);
if(length(numbers) != ((size^2-size)/2)){
throw("Error reading exchangeability matrix from PAML data file!\n");
}
s.matrix<-matrix(nrow=size,ncol=size);
diag(s.matrix)<-0;
colnames(s.matrix)<-symbols;
rownames(s.matrix)<-symbols;
counter<-1;
for(i in 1:size) {
for(j in 1:i){
if( i!= j){
s.matrix[i, j]<-numbers[counter];
s.matrix[j, i]<-numbers[counter];
counter<-counter + 1;
}
}
}
# Reading the equilibrium distribution:
equ.dist<-(scan(file=paml.file,what=0.0,skip=equ.skip, nlines=equ.nlines, quiet=TRUE));
if(length(equ.dist) != size){
throw("Error reading equlibrium distribution from PAML data file!\n");
}
equ.dist<-rbind(equ.dist);
colnames(equ.dist)<-symbols;
return(list(
"S"=s.matrix,
"pi"=equ.dist
));
}
},
private=FALSE,
protected=FALSE,
overwrite=FALSE,
conflict="warning",
validators=getOption("R.methodsS3:validators:setMethodS3")
);
##
## Method: setEquDist
##
setMethodS3(
"setEquDist",
class="CodonSubst",
function(
this,
value,
force=FALSE,
silent=FALSE,
...
){
# Behave like GeneralSubstitution if the S matrix is empty.
if(any(is.na(this$.s.matrix))){
return(NextMethod());
}
.checkWriteProtection(this);
if(!is.Alphabet(this$alphabet)){
throw("Cannot set equilibrium distribution because the alphabet is undefined!");
}
if(missing(value)) {
throw("No new value provided!\n");}
else if(!is.numeric(value)) {
throw("The new value must be numeric!\n");
}
else if(length(value) != this$alphabet$size){
throw("The new value must be a vector of length ",this$alphabet$size,"!\n");
}
else if(!PSRoot$my.all.equal(sum(value), 1.0)) {
value<-(value/sum(value));
if (silent == FALSE){
warning("The provided probabilities were rescaled in order to sum to one!\n");
}
}
value<-rbind(value);
colnames(value)<-this$.alphabet$symbols;
this$.equ.dist<-value;
for(i in this$.alphabet$.symbols){
for(j in this$.alphabet$.symbols){
if(i != j){
setRate(this$.q.matrix,from=i,to=j,value=(this$.s.matrix[i,j] * value[1, j]),scale=FALSE);
}
}
}
.callRateRescaling(this$QMatrix,guess.equ=FALSE);
return(invisible(this));
},
private=FALSE,
protected=FALSE,
overwrite=FALSE,
conflict="warning",
validators=getOption("R.methodsS3:validators:setMethodS3")
);
##
## Method: summary
##
###########################################################################/**
#
# @RdocMethod summary
#
# @title "Summarize the properties of an object"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{object}{An object}
# \item{...}{Not used.}
# }
#
# \value{
# Returns a PSRootSummary object.
# }
#
# \examples{
#
# # create an object
# a<-CodonSubst()
# # get a summary
# summary(a)
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#
#*/###########################################################################
setMethodS3(
"summary",
class="CodonSubst",
function(
object,
...
){
this<-object;
.addSummaryNameId(this);
.addSummaryAlphabet(this);
if(is.na(this$.paml.file)){
this$.summary$"Unscaled rate matrix"<-paste( "\n\t",paste(capture.output(print(this$.q.matrix$matrix,digits=5)
),collapse="\n\t"),"\n",sep="");
}
else {
this$.summary$"PAML data file:"<-this$.paml.file;
this$.summary$"Unscaled rate matrix"<-"not shown";
}
this$.summary$"Equilibrium distribution"<-paste( "\n\t",paste(capture.output(print(this$.equ.dist)),collapse="\n\t"
),"\n",sep="");
NextMethod();
},
private=FALSE,
protected=FALSE,
overwrite=FALSE,
conflict="warning",
validators=getOption("R.methodsS3:validators:setMethodS3")
);
##
## Method: newMatrix
##
###########################################################################/**
#
# @RdocMethod newMatrix
#
# @title "New codon substitution matrix from PAML file"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{name}{Object name}
# \item{paml.file}{PAML file.}
# \item{equ.dist}{Equilibrium distribution.}
# \item{...}{Not used.}
# }
#
# \value{
# A process object inheriting from CodonSubst.
# }
#
#
# @author
#
# \seealso{
# @seeclass
# }
#
#*/###########################################################################
setMethodS3(
"newMatrix",
class="CodonSubst",
function(
name=NA,
paml.file=NA,
equ.dist=NA,
...
){
PAMLDIR<-"./PAMLdat";
RDATDIR<-"./RData";
# Use the package data directory if loaded:
if(length(intersect(search(),c("package:phylosim"))) == 1){
RDATDIR<-paste(path.package("phylosim"),"/data/",sep="");
PAMLDIR<-paste(path.package("phylosim"),"/extdata/",sep="");
}
rdname<-paste(RDATDIR,"/",name,".RData",sep="");
if( ( file.access(c(rdname), mode=0) == c(0) ) & (file.access(c(rdname), mode=4) == c(0))){
this<-clone(Object$load(rdname));
}
else {
file<-paste(PAMLDIR,"/",paml.file,sep="");
this<-CodonSubst(paml.file=file);
this<-extend(this,name);
this$name<-this$name;
save(this, file=rdname);
}
if(!any(is.na(equ.dist))){
setEquDist(this,value=equ.dist,force=TRUE);
}
return(this);
},
private=FALSE,
protected=FALSE,
overwrite=FALSE,
conflict="warning",
validators=getOption("R.methodsS3:validators:setMethodS3")
);
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.