R/PhyloSimSource.R

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##
##########################################################################/** 
#
# @RdocClass Alphabet
# 
# @title "The Alphabet class"
# 
# \description{ 
#
#		Class representing an alphabet (a set of symbols).
#		@classhierarchy
#	
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{symbols}{A character vector containing the symbols for the alphabet. All elements must have the 
#	same length and no duplicates are allowed. No element of the vector may contain the dash symbol, which is reserved for gaps.}
# 	\item{type}{An identifier for the Alphabet object.}
#	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
#		@allmethods 
# }
# 
# \examples{ 
#		# create an alphabet object
#		a<-Alphabet(type="Binary",symbols=c("0","1"));
#		# print summary
#		summary(a);
#		# change the identifier
#		a$type<-"Nucleotide";
#		# change the symbol set
#		a$symbols<-c("A","T","G","C");
#		# print summary again
#		summary(a);
#		# clone the alphabet object
#		b<-clone(a);
#		# test the equality of the symbol sets
#		a == b;
# }
# 
# @author
#
#
# \seealso{ 
# 	Site Process Event BinaryAlphabet NucleotideAlphabet AminoAcidAlphabet
# }
# 
#*/###########################################################################
setConstructorS3(
	"Alphabet", 
	function(
		symbols=NA,
		type="Generic",
		...	
	){

	symbol_length<-NA;	
	if(!missing(symbols)){
		symbols<-as.character(symbols);
		symbol_length<-.checkSymbolLengths(symbols);
		if(!exists(x="PSIM_FAST")){
			.checkSymbolDuplicates(symbols);
		}

	}
	
	size<-NA;
	if(!is.na(symbol_length)){
		size<-length(symbols);
	}
	extend(PSRoot(), "Alphabet",
			.symbols=symbols,
			.symbolLength=symbol_length,
			.size=size,
			.type=type,
			.write.protected=FALSE,
			.is.alphabet=TRUE
	);
	},
	###
	enforceRCC=TRUE
);

##	
## Method: .checkSymbolLengths
##	
setMethodS3(
	".checkSymbolLengths", 
	class="character", 
	function(
		this,
		...
	){

		if(length(this) == 0 ){return(0)}			
		symbol_lengths<-stringLengthVector(this);
		if(length(unique(symbol_lengths)) != 1) {
			throw("The symbols must have the same length!");
		} else {
			symbol_lengths[[1]];
		}

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .checkSymbolDuplicates
##	
setMethodS3(
	".checkSymbolDuplicates", 
	class="character", 
	function(
		this,
		...
	){

		# Check for the gap character "-", and die if present:
		if(length(grep("^-+$",this)) != 0){
			throw("The symbol sets cannot contain the character \"-\" as that is reserved as a gap symbol!\n");
		}

		if(length(this) != length(unique(this))){
			throw("The alphabet must not contain duplicated symbols!");
		} else {
			return(invisible(TRUE));
		}				

	},
	###
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .checkConsistency
##	
setMethodS3(
	".checkConsistency", 
	class="character", 
	function(
		this,
		...
	){
		
		.checkSymbolLengths(this);
		.checkSymbolDuplicates(this);

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## 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, throws an error otherwise. 
# } 
# 
# \examples{
#		# create an alphabet object
#		a<-Alphabet(symbols=c(0,1));
#		# check consistency
#		print(checkConsistency(a));
#		# mess up with the internals
#		a$.symbols[1]<-"BAD";
#		# NOT run: cosistency check now will throw an error
#		\dontrun{ print(checkConsistency(a)); }
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"checkConsistency", 
	class="Alphabet", 
	function(
		this,
		...
	){
		
		if(is.null(this$.symbols)) {
			throw("Alphabet symbols is NULL!\n");
		}	
		else if(is.null(this$.size)) {
			throw("Alphabet size is NULL!\n");
		}	
		else if(is.null(this$.symbolLength)) {
			throw("Alphabet symbol length is NULL!\n");
		}	
		else if(is.null(this$.type)) {
			throw("Alphabet type is NULL!\n");
		}	
		# Disable write protection for a while.
		wp<-this$writeProtected;
		if(wp) {
			this$writeProtected<-FALSE;
		}	
		
		may.fail<-function(this){
			this$symbols<-this$symbols;
			if( length(this$symbols) != this$size) {
				throw("Alphabet object inconsistent! Length mismatch!\n");
			}
		}
		tryCatch(may.fail(this), finally=this$writeProtected<-wp);

		.checkConsistency(this$.symbols);

	},
	###
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: ==
##	
###########################################################################/**
#
# @RdocMethod ==
# \alias{!=.Alphabet}
# @title "Check if two alaphabet objects have the same symbol set" 
#  
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{e1}{An Alphabet object.} 
# 	\item{e2}{An Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE 
# } 
# 
# \examples{
#	
#	# create an alpahabet object
#	a<-Alphabet(symbols=c(0,1));	
#	# clone object
#	b<-clone(a)
#	# compare the two objects
#	print(a == b)
#	# modify symbol set in b
#	b$symbols<-c("AT","GC");
#	print(a == b)
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"==", 
	class="Alphabet", 
	function(
		e1,	
		e2,
		...
	){

		# First check by reference:
		if ( equals(e1,e2) ) {return(TRUE)}
		# Check if both objects inherit from Alphabet:
		if(!exists(x="PSIM_FAST")){
			if (!length(intersect(intersect(class(e1),class(e2)),c("Alphabet")))){
				throw("Alphabet object compared to something else!");
			}
		}
		# Check ANY flag:
		if(!is.null(e1$.any.flag) | !is.null(e2$.any.flag)) { return(TRUE) }
		# then check by value:
		setequal(e1$.symbols,e2$.symbols);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: !=
##	
setMethodS3(
	"!=", 
	class="Alphabet", 
	function(
		e1,	
		e2,
		...
	){
		!'=='(e1,e2);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSymbols
##	
###########################################################################/**
#
# @RdocMethod getSymbols
# 
# @title "Get the symbol set from an Alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	A character vector containing the symbol set of the Alphabet object.
# } 
# 
# \examples{
#	
#	# create a new alphabet object
#	a<-Alphabet(symbols=c("AC","GT"));
#	# get the symbols
#	getSymbols(a)
#	# get the symbols by using the virtual field
#	a$symbols
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSymbols", 
	class="Alphabet", 
	function(
		this,
		...
	){
		
		as.character(this$.symbols);
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSymbols
##	
###########################################################################/**
#
# @RdocMethod setSymbols
# 
# @title "Specify a new symbol set for an Alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{set}{The vector containing the new symbols set, automatically converted 
#	into a character vector.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new symbol set as a character vector.
# } 
# 
# \examples{
#
#	# create a new alphabet object	
#	a<-Alphabet()
#	a
#	# specify a new symbol set
#	setSymbols(a,c(0,1))
#	a
#	# the same, but now use the virtual field
#	a$symbols<-c("A","T","G","C")
#	a
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSymbols", 
	class="Alphabet", 
	function(
		this,
		set,	# the new symbol set
		...	
	){
			if (is.null(set))	{
				throw("Cannot set NULL as symbols!\n");
			}
			.checkWriteProtection(this);	
			set<-as.character(set);					
			if(!exists(x="PSIM_FAST")){
				.checkSymbolDuplicates(set)
			}
			this$.symbolLength<-.checkSymbolLengths(set);
			this$.size<-length(set);
			this$.symbols<-set;	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSymbolLength
##	
###########################################################################/**
#
# @RdocMethod getSymbolLength
# 
# @title "Get the length of the symbols in a given alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#
#	# create an alphabet object	
#	a<-Alphabet(symbols=c("AAA","AAC"));
#	# get symbol length
#	getSymbolLength(a);
#	# get symbol length via virtual field
#	a$symbolLength
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSymbolLength", 
	class="Alphabet", 
	function(
		this,
		...
	){

		this$.symbolLength;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSymbolLength
##	
###########################################################################/**
#
# @RdocMethod setSymbolLength
# 
# @title "Forbidden action: setting the symbol length for an Alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{value}{Not used.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Throws an error.
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSymbolLength", 
	class="Alphabet", 
	function(
		this,
		value,
		...
	){

			virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSize
##	
###########################################################################/**
#
# @RdocMethod getSize
# 
# @title "Get the number of symbols in an Alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	An integer vector of length one.
# } 
# 
# \examples{
#	
#	# create an alphabet object
#	a<-Alphabet(symbols=c(0,1,2,3,4,5))
#	a
#	# get alphabet size
#	getSize(a)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSize", 
	class="Alphabet", 
	function(
		this,
		...
	){

		this$.size;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getType
##	
###########################################################################/**
#
# @RdocMethod getType
# 
# @title "Get Alphabet obejct type" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	
#	# create alphabet object
#	a<-Alphabet(symbols=c(0,1),type="Binary");
#	# get alphabet type
#	getType(a)
#	a$type
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getType", 
	class="Alphabet", 
	function(
		this,
		...
	){

		this$.type;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setType
##	
###########################################################################/**
#
# @RdocMethod setType
# 
# @title "Set Alphabet object type" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
#	\item{new_type}{A character vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new type (invisible).
# } 
# 
# \examples{
#	# create an alphabet object
#	a<-Alphabet(symbols=c(1,2,3))
#	# set a new type
#	setType(a,"MyAlphabet")
#	a$type
#	# set type via virtual field
#	a$type<-"MorphChars"
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setType", 
	class="Alphabet", 
	function(
		this,
		new_type,
		...
	){

		
		.checkWriteProtection(this);	
		if(!exists(x="PSIM_FAST")){
			if (length(new_type) != 1) {throw("The new type must be a character vector of length 1!")}	
			if (new_type == "" ){ throw("Cannot set empty type!")}
		}
		this$.type<-new_type;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: hasSymbols
##	
###########################################################################/**
#
# @RdocMethod hasSymbols
# 
# @title "Check if an Alphabet object has a given set of symbols" 
# 
# \description{ 
#	@get "title".
#	Returns true if the class of the object is "AnyAlphabet".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{sym}{A character vector.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#	
#	# create alphabet object
#	a<-Alphabet(symbols=c("A","T","G","C"));
#	# check if it has the symbols "A" and "G"
#	hasSymbols(a,c("A","G"))
#	# check if has the symbol "X"
#	hasSymbols(a,"X")
#	# any alphabet returns true for every symbol
#	b<-AnyAlphabet();	
#	hasSymbols(b,"X")
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"hasSymbols", 
	class="Alphabet", 
	function(
		this,
		sym,
		...
	){
	
		sym<-unique(as.character(sym));
		if (length(intersect(this$.symbols,sym)) == length(sym)){
			return(TRUE);
		}
		# Check ANY flag:
		else if(!is.null(this$.any.flag)) { return(TRUE) }
		else {
			return(FALSE);
		}
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getWriteProtected
##	
###########################################################################/**
#
# @RdocMethod getWriteProtected
#  
# @title "Check if the object is write protected" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#
#       # create an object
#       o<-Alphabet()
#       # toggle write protection
#       o$writeProtected<-TRUE
#       # check if it's write protected
#       getWriteProtected(o)
#       # check write protection via virtual field
#       o$writeProtected
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getWriteProtected", 
	class="Alphabet", 
	function(
		this,
		...
	){

		this$.write.protected;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setWriteProtected
##	
###########################################################################/**
#
# @RdocMethod setWriteProtected
#  
# @title "Set the write protection field for an object" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{value}{A logical vector of size one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or FALSE.
# } 
# 
# \examples{
#
#	# create an object
#	o<-Alphabet()
#	# toggle write protection
#	setWriteProtected(o,TRUE)
#	# check write protection
#	o$writeProtected
#	# set write protection via virtual field
#	o$writeProtected<-FALSE
#	o$writeProtected
#	
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setWriteProtected", 
	class="Alphabet", 
	function(
		this,
		value,
		...
	){
		
		if(!is.logical(value)) {throw("The new value must be logical!\n")} 
		else {
			this$.write.protected<-value;
		}
			
	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .checkWriteProtection
##	
setMethodS3(
	".checkWriteProtection", 
	class="Alphabet", 
	function(
		this,
		...
	){
		if(exists(x="PSIM_FAST")){ return(FALSE) }	

		if(this$writeProtected) {throw("Cannot set value because the object is write protected!\n")}
		else {return(invisible(FALSE))}
			
	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSize
##	
###########################################################################/**
#
# @RdocMethod setSize
# 
# @title "Forbidden action: setting the symbol set size of an Alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{value}{Not used.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Throws an error.
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSize", 
	class="Alphabet", 
	function(
		this,
		value,
		...
	){

			virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: as.character
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Get the character representation of an Alphabet object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{An Alphabet object} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Returns the character vector containing the symbol set.
# } 
# 
# \examples{
#
#	# create alphabet object
#	a<-Alphabet(symbols=c("A","T","G","C","N"))
#	# get charcter representation
#	as.character(a)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="Alphabet", 
	function(
		x,
		...
	){

		x$.symbols;				

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: summary.Alphabet
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#	# get a summary
#	summary(a)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"summary", 
	class="Alphabet", 
	function(
		object,
		...
	){
	
			this<-object;	
			this$.summary$Type<-this$type;
			this$.summary$Size<-this$size;
			this$.summary$Symbols<-paste(this$symbols,collapse=' ');
			this$.summary$"Symbol length"<-this$symbolLength;
			if(getWriteProtected(this)){
				this$.summary$"Write protected"<-TRUE;	
			}
		
			NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
	);

##	
## Method: is.Alphabet
##	
###########################################################################/**
#
# @RdocDefault is.Alphabet
# 
# @title "Check if an object is an instance of the Alphabet class" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#
#	# create an alphabet object
#	a<-Alphabet()
#	# create a PSRoot object
#	o<-PSRoot()
#	# check if they are alphabet objects
#	is.Alphabet(a)
#	is.Alphabet(o)
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"is.Alphabet", 
	class="default", 
	function(
		this,
		...
	){
	
    if(!is.PSRoot(this)) {return(FALSE)}
   	if(!is.null(this$.is.alphabet)){return(TRUE)}
    if ( inherits(this, "Alphabet")) {
      this$.is.alphabet<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: isEmpty
##	
###########################################################################/**
#
# @RdocMethod isEmpty
# 
# @title "Check if the symbol set is empty" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#
#	# create an empty alphabet
#	a<-Alphabet();
#	# check whether it is empty
#	isEmpty(a)
#	# specify a new symbol set
#	a$symbols<-c(0,1)
#	isEmpty(a)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"isEmpty", 
	class="Alphabet", 
	function(
		this,
		...
	){
	
	if(is.na(this$.size) | this$.size == 0 ){
		return(TRUE);
	}
	else {
		return(FALSE);
	}
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);




##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	

##
## cpREV
##
##########################################################################/** 
#
# @RdocClass cpREV
# 
# @title "The cpREV empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Adachi, J., P. J. Waddell, W. Martin, and M. Hasegawa (2000) Plastid
# genome phylogeny and a model of amino acid substitution for proteins
# encoded by chloroplast DNA - Journal of Molecular Evolution 50:348--358 
# DOI: 10.1007/s002399910038 \url{http://bit.ly/bnBVLm}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-cpREV()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "cpREV",
  function(
		equ.dist=NA,
    		...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="cpREV",
			paml.file="cpREV.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## PAM
##
##########################################################################/** 
#
# @RdocClass PAM
# 
# @title "The PAM empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Dayhoff, M. O.; Schwartz, R. M.; Orcutt, B. C. (1978). "A model of evolutionary change in proteins" - 
# Atlas of Protein Sequence and Structure 5 (3):345-352
#
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-PAM()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "PAM",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="PAM",
			paml.file="dayhoff.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## PAM-dcmut
##
##########################################################################/** 
#
# @RdocClass PAM.dcmut
# 
# @title "The PAM.dcmut empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Kosiol, C, and Goldman, N (2005) Different versions of the Dayhoff rate matrix -
# Molecular Biology and Evolution 22:193-199 \url{http://dx.doi.org/10.1093/molbev/msi005}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-PAM.dcmut()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "PAM.dcmut",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="PAM.dcmut",
			paml.file="dayhoff-dcmut.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## JTT
##
##########################################################################/** 
#
# @RdocClass JTT
# 
# @title "The JTT empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Jones, D. T., W. R. Taylor, and J. M. Thornton (1992) The rapid generation of mutation data matrices 
# from protein sequences. CABIOS 8:275-282 \url{http://dx.doi.org/10.1093/bioinformatics/8.3.275}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-JTT()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "JTT",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="JTT",
			paml.file="jones.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## JTT.dcmut
##
##########################################################################/** 
#
# @RdocClass JTT.dcmut
# 
# @title "The JTT.dcmut empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Kosiol, C, and Goldman, N (2005) Different versions of the Dayhoff rate matrix -
# Molecular Biology and Evolution 22:193-199 \url{http://dx.doi.org/10.1093/molbev/msi005}
#
# Jones, D. T., W. R. Taylor, and J. M. Thornton (1992) The rapid generation of mutation data matrices 
# from protein sequences. CABIOS 8:275-282 \url{http://dx.doi.org/10.1093/bioinformatics/8.3.275}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-JTT.dcmut()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first threee positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "JTT.dcmut",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="JTT.dcmut",
			paml.file="jones-dcmut.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## LG
##
##########################################################################/** 
#
# @RdocClass LG
# 
# @title "The LG empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Le, S. Q., and O. Gascuel (2008) An improved general amino acid replacement matrix - 
# Mol. Biol. Evol. 25:1307-1320 \url{http://dx.doi.org/10.1093/molbev/msn067}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-LG()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "LG",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="LG",
			paml.file="lg.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## mtArt
##
##########################################################################/** 
#
# @RdocClass mtArt
# 
# @title "The mtArt empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Abascal, F., D. Posada, and R. Zardoya (2007) MtArt: A new Model of
# amino acid replacement for Arthropoda - Mol. Biol. Evol. 24:1-5 \url{http://dx.doi.org/10.1093/molbev/msl136}
#
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-mtArt()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "mtArt",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="mtArt",
			paml.file="mtArt.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## mtMam
##
##########################################################################/** 
#
# @RdocClass mtMam
# 
# @title "The mtMam empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Yang, Z., R. Nielsen, and M. Hasegawa (1998) Models of amino acid
# substitution and applications to Mitochondrial protein evolution,
# Molecular Biology and Evolution 15:1600-1611 \url{http://bit.ly/by4NMb}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-mtMam()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "mtMam",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="mtMam",
			paml.file="mtmam.dat",
			equ.dist=equ.dist
		);
		
		return(this);

  },
  enforceRCC=FALSE
);

##
## mtREV24
##
##########################################################################/** 
#
# @RdocClass mtREV24
# 
# @title "The mtREV24 empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Adachi, J. and Hasegawa, M. (1996) MOLPHY version 2.3: programs for
# molecular phylogenetics based on maximum likelihood.  Computer Science
# Monographs of Institute of Statistical Mathematics 28:1-150
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-mtREV24()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "mtREV24",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="mtREV24",
			paml.file="mtREV24.dat",
			equ.dist=equ.dist
		);
		
		return(this);

  },
  enforceRCC=FALSE
);

##
## MtZoa
##
##########################################################################/** 
#
# @RdocClass MtZoa
# 
# @title "The MtZoa empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Rota-Stabelli, O., Z. Yang, and M. Telford. (2009) MtZoa: a general mitochondrial amino acid 
# substitutions model for animal evolutionary studies. Mol. Phyl. Evol 52(1):268-72 \url{http://bit.ly/2bMbGAl}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-MtZoa()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "MtZoa",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="MtZoa",
			paml.file="MtZoa.dat",
			equ.dist=equ.dist
		);
		
		return(this);

  },
  enforceRCC=FALSE
);

##
## WAG
##
##########################################################################/** 
#
# @RdocClass WAG
# 
# @title "The WAG empirical amino acid substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Whelan, S. and N. Goldman (2001)  A general empirical model of
# protein evolution derived from multiple protein families using a maximum likelihood 
# approach - Molecular Biology and Evolution 18:691-699 \url{http://bit.ly/dpTKAd}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-WAG()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-AminoAcidSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	AminoAcidSubst GeneralSubstitution UNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "WAG",
  function(
		equ.dist=NA,
    ...
  ){

		this<-AminoAcidSubst$newAAMatrix(
			name="WAG",
			paml.file="wag.dat",
			equ.dist=equ.dist
		);
		return(this);

  },
  enforceRCC=FALSE
);






##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass AminoAcidSubst
# 
# @title "The AminoAcidSubst class"
# 
# \description{ 
#       This is a class implementing a continuous-time Markov process acting on 
#       the state-space defined by the \code{AminoAcidAlphabet} class. The rate
#	matrix of this model is completely unrestricted.
#
#	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<-AminoAcidSubst()
#	# build rate matrix from paml file
#	# buildFromPAML(p,"path_to_paml_file")	# do not run this
#	# set a rate
#	setRate(p,"A->D",2)
#	# get object summary	
#	summary(p)
# }
# 
# @author
#
# \seealso{ 
# 	@seeclass 
# }
# 
#*/###########################################################################
setConstructorS3(
  "AminoAcidSubst",
  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, "AminoAcidSubst",
				.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=AminoAcidAlphabet(),
					rate.list=rate.list,
					equ.dist=equ.dist
				);	
				this<-extend(this, "AminoAcidSubst");
			}
		
			# Got rate list	
			else if(got.rate.list & !got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=AminoAcidAlphabet(),
					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=AminoAcidAlphabet(),
					equ.dist=equ.dist
				);	
				this<-extend(this, "AminoAcidSubst");
				this<-extend.with.s(this);
			}

			# Got nothing:
			else if(!got.rate.list & !got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=AminoAcidAlphabet()
				);	
				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=AminoAcidAlphabet()
			);	

			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="AminoAcidSubst", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

			if(!inherits(this$alphabet, "AminoAcidAlphabet")){
				throw("This process must have as alphabet an AminoAcidAlphabet 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}{An AminoAcidSubst object.} 
#	\item{paml.file}{Path to the PAML file.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The AminoAcidSubst object (invisible).
# } 
# 
# \examples{
#	# create an object
#	p<-AminoAcidSubst()
#	# 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="AminoAcidSubst", 
	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="AminoAcidSubst", 
	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
		# amino acids is the same as in the AminoAcidAlphabet
		# 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="AminoAcidSubst",
  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<-AminoAcidSubst()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="AminoAcidSubst",
  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: newAAMatrix 
##
###########################################################################/**
#
# @RdocMethod newAAMatrix
# 
# @title "Undocumented method" 
# 
# \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 AminoAcidSubst.
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"newAAMatrix", 
	class="AminoAcidSubst", 
	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<-AminoAcidSubst(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")
);

				
##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass BinarySubst
# 
# @title "The BinarySubst class"
# 
# \description{ 
#	This is a class implementing a continuous-time Markov process acting on 
#	the state space defined by the \code{BinaryAlphabet} class.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
# 	\item{rate.list}{A list of substitution rates (see \code{setRateList.GeneralSubstitution}).}
#	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
# 	# The following code demonstrates 
#       # the use of the BinarySubst process    
#       # during a simulation.
#       p<-BinarySubst(rate=0.25,name="Binary",rate.list=list("0->1"=2,"1->0"=1))
#       # create a sequence object, attach process p
#       s<-BinarySequence(string="000000000000000000",processes=list(list(p)));
#       # make the first five positions invariable
#       setRateMultipliers(s,p,0,1:5)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # simulate
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(3))
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GeneralSubstitution GTR WAG
# }
# 
#*/###########################################################################
setConstructorS3(
  "BinarySubst",
  function( 
		name="Anonymous", 
		rate.list=NA,	
		equ.dist=NA,
		... 
		)	{

		got.rate.list<-!missing(rate.list);
		got.equ.dist<-!missing(equ.dist);

		this<-NA;
		
		if(got.rate.list & got.equ.dist){
			this<-GeneralSubstitution(name=name, rate.list=rate.list, equ.dist=equ.dist, alphabet=BinaryAlphabet());
		}
		else if(got.rate.list & !got.equ.dist){
			this<-GeneralSubstitution(name=name, rate.list=rate.list, alphabet=BinaryAlphabet());
		}
		else if(!got.rate.list & got.equ.dist){
			this<-GeneralSubstitution(name=name, equ.dist=equ.dist, alphabet=BinaryAlphabet());
		}
		else if(!got.rate.list & !got.equ.dist){
			this<-GeneralSubstitution(name=name, alphabet=BinaryAlphabet());
		}
		else {
			throw("You should never see this message!\n");
		}
		
		this<-extend(this, "BinarySubst");
		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="BinarySubst",
  function(
    this,
    ...
  ){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

				is.binary.alphabet<-inherits(this$alphabet, "BinaryAlphabet");
				if(!is.binary.alphabet){
					throw("The alphabet must be a BinaryAlphabet object!\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: 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
#       p<-BinarySubst(rate=0.25,name="Binary",rate.list=list("0->1"=2,"1->0"=1))
#       # get a summary
#       summary(p)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="BinarySubst",
  function(
    object,
    ...
  ){

      NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);




## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass BrownianInsertor
# 
# @title "The BrownianInsertor class"
# 
# \description{ 
#	The \code{BrownianInsertor} class inherits from the \code{DiscreteInsertor}
#	or \code{ContinuousInsertor} class depending on the \code{type} constructor argument 
#	("discrete" or "continuous").
#
#	This process generates the insert sequence based on the sites flanking the insertions as follows:
#	\itemize{
#		\item An insert length is sampled by calling the function stored in the \code{proposeBy} virtual field.
#		\item A sequence object is constructed.
#		\item The processes attached to both flanking sites are attached to the insert sequence. If there are no common processes, the processes from a randomly chosen site will be attached to the insert.
#		\item The site-process specific parameters are sampled from Brownian paths with linear trends having the values from the flanking sites as endpoints.
# 	}
#
#	The "noisiness" of the Brownian path can be controlled through the \code{scale} virtual field/constructor parameter.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{type}{Process type (see above).}
#	\item{scale}{Brownian path scale parameter.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a BrownianInsertor process, discrete type
#	p<-BrownianInsertor(
#                       type="discrete",
#                       scale=0.05, 
#                       sizes=1:4,
#                       probs=c(3/6,1/6,1/6,1/6),
#                       rate=0.05
#                       )
#	# get object summary
#	summary(p)
#	# plot insert length distribution
#	plot(p)
#	# create a nucleotide sequence, attach processes
#	s<-NucleotideSequence(string="AAAAAAAAAAA",processes=list(list(p,JC69())))
#	# create simulation object
#	sim<-PhyloSim(root.seq=s, phylo=rcoal(2))
#	# simulate and show alignment
#	Simulate(sim)
#	sim$alignment
#	# check the rate multipliers and insertion tolerances in one of the sequences
#	res<-sim$sequences[[2]]
#	getRateMultipliers(res,p)
#	getInsertionTolerance(res,p)
# }
# 
# @author
#
# \seealso{ 
# 	DiscreteInsertor ContinuousInsertor GeneralInsertor GeneralInDel
# }
# 
#*/###########################################################################
setConstructorS3(
  "BrownianInsertor",
  function( 
		name="Anonymous",
		type="discrete",
		scale=0.001,
		... 
		)	{

		if(type == "continuous"){
			this<-ContinuousInsertor(
			 ...
			);
		}
		else if (type == "discrete") {
			this<-DiscreteInsertor(
			 ...
			);
		}
		else {
			throw("Invalid insertor process type!\n");
		}
    
		this<-extend(
      			this,
      			"BrownianInsertor",
			.scale = NA,
			.type  = type
    		);
		
		# Using virtual field to clear Id cache:
		this$name<-name;
		# setting scale
		this$scale<-scale;

		this$generateBy<-function(process=NA,length=NA,target.seq=NA,event.pos=NA,insert.pos=NA){
	 
			if(is.na(target.seq)){
				return(NA);
			}
			
			if(is.na(length) | (length(length) == 0) | length == 0){
				throw("Invalid insert length!\n");
			}	
			
			# The start and end of the Brownian path:

			start;
			end;
			proc<-list();
			
			if( (event.pos == 1) || (event.pos == target.seq$.length) ){

				start<-clone(target.seq$.sites[[event.pos]]);
				start$.state=NA;
				end<-clone(start);
				proc<-getProcesses(start);
				
			} else {
				start<-clone(target.seq$.sites[[insert.pos]]);
				start$.state=NA;
				end<-clone(target.seq$.sites[[insert.pos + 1]]);
				end$.state=NA;
			
				proc.start<-getProcesses(start);
				proc.end<-getProcesses(end);

				# Calculate the intersection of process list:

				proc<-PSRoot$intersect.list(proc.start,proc.end);

				# No common processes:

				if(length(proc) == 0){
					coin.flip<-sample(c(0,1),1);
                                        if (coin.flip) {
                                          proc <- getProcesses(start)
                                          end <- clone(start)
                                        } else {
                                          proc <- getProcesses(end)
                                          start <- clone(end)
                                        }
				}
			}
		

			# Create the insert sequence:			

			class.seq<-class(target.seq)[[1]];
			insert<-do.call(class.seq,list(length=length));
			setProcesses(this=insert,value=list(proc));

			# For every process...
			
			for (p in proc){
				
				# ... and site specific parameter:	
				for(param in getSiteSpecificParamIds(p)){
					
					start.value<-getParameterAtSite(p,site=start,id=param)$value;
					end.value<-getParameterAtSite(p,site=end,id=param)$value;
					
					path<-seq(from=start.value,to=end.value,length.out=(insert$.length + 2));
					path<-path[2:(length(path)-1)];
					brownian.path<-abs(BrownianInsertor$BrownianPath(p=path, a=this$.scale));
		
					# Tolerance values are probabilities, do not alow them to wander beyond 1:	
					if(param == "insertion.tolerance" || param == "deletion.tolerance"){
						brownian.path[which(brownian.path > 1)]<-1;	
					}

					setParameterAtSites(
						insert,
						process	= p,
						id	= param,
						value	= brownian.path 
					);	
					
				}
			}

			return(insert);

				
	 	}

		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="BrownianInsertor",
  function(
    this,
    ...
  ){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {
		
	this$scale<-this$scale;
	if( (this$.type != "discrete") && (this$.type != "continuous") ){
		throw("BrownianInsertor type is invalid!\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: BrownianPath
##
###########################################################################/**
#
# @RdocMethod BrownianPath 
# 
# @title "Generate a Brownian path" 
# 
# \description{ 
#	@get "title".
#
#	This method generates a Brownian path given the scale parameter a (determining "noisiness") 
#	and the vector p describing the trends. More useful as a static method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#	\item{this}{A BrownianInsertor object.}
# 	\item{p}{Path parameter (a numeric vector).} 
# 	\item{a}{Scale paramater (a numeric vector of length one).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	path<-BrownianInsertor$BrownianPath(a=2,p=1:10);
#	path
#	plot(path)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "BrownianPath",
  class="BrownianInsertor",
  function(
	this,
	p=NA,
	a=NA,
    	...
  ){

	generate_brownian<-function(length, a){
		cumsum(rnorm(length,0,sd=a));
	}

	generate_bridge <- function (length,a){
		b <- generate_brownian(length,a)
		b - (1:length)/(length) * b[length]
	}

	generate_path <- function (p,a){
		n <- length(p);
		b <- generate_bridge (n+1,a);
		p + b[1:n];
	}

	return(generate_path(p,a));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning"
);


##	
## Method: getType
##	
###########################################################################/**
#
# @RdocMethod getType
# 
# @title "Get the type of the BrownianInsertor process" 
# 
# \description{ 
#	@get "title".
#
#	If type is \code{discrete}, than the process inherits from \code{DiscreteInsertor}.
#	If the type is \code{continuous}, then the object inherits from \code{ContinuousInsertor}.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A BrownianInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	p<-BrownianInsertor(type="discrete")
#	# get type
#	getType(p)
#	# get upstream classes
#	class(p)
#	p<-BrownianInsertor(type="continuous")
#	# get type via virtual field
#	p$type
#	# get upstream classes
#	class(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getType", 
	class="BrownianInsertor", 
	function(
		this,
		...
	){

		this$.type;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setType
##	
###########################################################################/**
#
# @RdocMethod setType
#
# @title "Forbidden action: setting the type of a BrownianInsertor object"
#
# \description{
#       @get "title".
#
#	The type can be set only from the \code{type} constructor argument and cannot be changed later.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setType", 
	class="BrownianInsertor", 
	function(
		this,
		value,
		...
	){

		throw("The type of the BrownianInsertor objects can be set only from the constructor!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getScale
##	
###########################################################################/**
#
# @RdocMethod getScale
# 
# @title "Get scale parameter" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A BrownianInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a BrownianInsertor object
#	p<-BrownianInsertor(scale=0.002)
#	# set/get scale parameter
#	setScale(p,0.1)
#	getScale(p)
#	# set/get scale parameter via virtual field
#	p$scale<-0.1
#	p$scale
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getScale", 
	class="BrownianInsertor", 
	function(
		this,
		...
	){

		this$.scale;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setScale
##	
###########################################################################/**
#
# @RdocMethod setScale
# 
# @title "Set scale parameter" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A BrownianInsertor object.} 
# 	\item{value}{A numeric vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible).
# } 
# 
# \examples{
#	# create a BrownianInsertor object
#	p<-BrownianInsertor(scale=0.002)
#	# set/get scale parameter
#	setScale(p,0.1)
#	getScale(p)
#	# set/get scale parameter via virtual field
#	p$scale<-0.1
#	p$scale
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setScale", 
	class="BrownianInsertor", 
	function(
		this,
		value,
		...
	){


		.checkWriteProtection(this);	
		if(!is.numeric(value) || (length(value) != 1)){
			throw("The value of the scale paramter must be a numeric vector of length 1!\n");
		}
		this$.scale<-value;
		return(invisible(this$.scale));
	},
	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
#	p<-BrownianInsertor(
#                       type="discrete",
#                       scale=0.05, 
#                       sizes=1:4,
#                       probs=c(3/6,1/6,1/6,1/6),
#                       rate=0.05
#                       )
#       # get a summary
#       summary(p)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="BrownianInsertor",
  function(
    object,
    ...
  ){
	this<-object;
    	.addSummaryNameId(this);
	this$.summary$"Type"<-this$.type;
	this$.summary$"Brownian path scale parameter"<-this$.scale;
	
    	NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	

##
## CodonAlphabet
##
##########################################################################/** 
#
# @RdocClass CodonAlphabet
# 
# @title "The CodonAlphabet class"
# 
# \description{ 
#	This class implements codon alphabets and handles the translation of codons 
#	to their corresponding amino acids. Stop codons are excluded from the symbol set, 
#	thus the symbol set depends on the genetic code table.
#	The genetic code table can be specified through the \code{table.id} constructor parameter.
#
#	The available genetic code tables:
#	\preformatted{
#	1	Standard
#	2	Vertebrate Mitochondrial
#	3	Yeast Mitochondrial
#	4	Mold, Protozoan, and CoelenterateMitochondrial and Mycoplasma/Spiroplasma
#	5	Invertebrate Mitochondrial
#	6	Ciliate, Dasycladacean and Hexamita Nuclear	
#	9	Echinoderm Mitochondrial
#	10	Euplotid Nuclear
#	11	Bacterial
#	12	Alternative Yeast Nuclear
#	13	Ascidian Mitochondrial
#	14	Flatworm Mitochondrial
#	15	Blepharisma Nuclear
#	16	Chlorophycean Mitochondrial
#	21	Trematode Mitochondrial
#	22	Scenedesmus obliquus Mitochondrial
#	23	Thraustochytrium Mitochondrial
#	}
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{table.id}{The identifier of the genetic code table.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a CodonAlphabet object
#	a<-CodonAlphabet(table.id=2)
#	# get object summary
#	summary(a)
# }
# 
# @author
#
# \seealso{ 
# 	@seeclass 
# }
# 
#*/###########################################################################
setConstructorS3(
  "CodonAlphabet",
  function(table.id=1,...){

# Genetic code tables, ripped from BioPerl. #

CODON.TABLES<-list(
	'1'=list(
		'name'='Standard',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='START'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='START'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'2'=list(
		'name'='Vertebrate Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='START'
			),
			'ATC'=list(
				aa='I',
				type='START'
			),
			'ATA'=list(
				aa='M',
				type='START'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='*',
				type='STOP'
			),
			'AGG'=list(
				aa='*',
				type='STOP'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='START'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'3'=list(
		'name'='Yeast Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='T',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='T',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='T',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='T',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='M',
				type='START'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'4'=list(
		'name'='Mold, Protozoan, and CoelenterateMitochondrial and Mycoplasma/Spiroplasma',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='START'
			),
			'TTG'=list(
				aa='L',
				type='START'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='START'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='START'
			),
			'ATC'=list(
				aa='I',
				type='START'
			),
			'ATA'=list(
				aa='I',
				type='START'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='START'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'5'=list(
		'name'='Invertebrate Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='START'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='START'
			),
			'ATC'=list(
				aa='I',
				type='START'
			),
			'ATA'=list(
				aa='M',
				type='START'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='S',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='START'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'6'=list(
		'name'='Ciliate, Dasycladacean and Hexamita Nuclear',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'TAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'9'=list(
		'name'='Echinoderm Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='S',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'10'=list(
		'name'='Euplotid Nuclear',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'11'=list(
		'name'='Bacterial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='START'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='START'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='START'
			),
			'ATC'=list(
				aa='I',
				type='START'
			),
			'ATA'=list(
				aa='I',
				type='START'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='START'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'12'=list(
		'name'='Alternative Yeast Nuclear',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='S',
				type='START'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'13'=list(
		'name'='Ascidian Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='M',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='G',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'14'=list(
		'name'='Flatworm Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='S',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'15'=list(
		'name'='Blepharisma Nuclear',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'16'=list(
		'name'='Chlorophycean Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'21'=list(
		'name'='Trematode Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='W',
				type='ORDINARY'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='M',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='S',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='START'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'22'=list(
		'name'='Scenedesmus obliquus Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='*',
				type='STOP'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='ORDINARY'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	),
	'23'=list(
		'name'='Thraustochytrium Mitochondrial',
		'trans'=list(
			'TTT'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTC'=list(
				aa='F',
				type='ORDINARY'
			),
			'TTA'=list(
				aa='*',
				type='STOP'
			),
			'TTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'TCT'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCC'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCA'=list(
				aa='S',
				type='ORDINARY'
			),
			'TCG'=list(
				aa='S',
				type='ORDINARY'
			),
			'TAT'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAC'=list(
				aa='Y',
				type='ORDINARY'
			),
			'TAA'=list(
				aa='*',
				type='STOP'
			),
			'TAG'=list(
				aa='*',
				type='STOP'
			),
			'TGT'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGC'=list(
				aa='C',
				type='ORDINARY'
			),
			'TGA'=list(
				aa='*',
				type='STOP'
			),
			'TGG'=list(
				aa='W',
				type='ORDINARY'
			),
			'CTT'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTC'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTA'=list(
				aa='L',
				type='ORDINARY'
			),
			'CTG'=list(
				aa='L',
				type='ORDINARY'
			),
			'CCT'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCC'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCA'=list(
				aa='P',
				type='ORDINARY'
			),
			'CCG'=list(
				aa='P',
				type='ORDINARY'
			),
			'CAT'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAC'=list(
				aa='H',
				type='ORDINARY'
			),
			'CAA'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CAG'=list(
				aa='Q',
				type='ORDINARY'
			),
			'CGT'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGC'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'CGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'ATT'=list(
				aa='I',
				type='START'
			),
			'ATC'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATA'=list(
				aa='I',
				type='ORDINARY'
			),
			'ATG'=list(
				aa='M',
				type='START'
			),
			'ACT'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACC'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACA'=list(
				aa='T',
				type='ORDINARY'
			),
			'ACG'=list(
				aa='T',
				type='ORDINARY'
			),
			'AAT'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAC'=list(
				aa='N',
				type='ORDINARY'
			),
			'AAA'=list(
				aa='K',
				type='ORDINARY'
			),
			'AAG'=list(
				aa='K',
				type='ORDINARY'
			),
			'AGT'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGC'=list(
				aa='S',
				type='ORDINARY'
			),
			'AGA'=list(
				aa='R',
				type='ORDINARY'
			),
			'AGG'=list(
				aa='R',
				type='ORDINARY'
			),
			'GTT'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTC'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTA'=list(
				aa='V',
				type='ORDINARY'
			),
			'GTG'=list(
				aa='V',
				type='START'
			),
			'GCT'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCC'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCA'=list(
				aa='A',
				type='ORDINARY'
			),
			'GCG'=list(
				aa='A',
				type='ORDINARY'
			),
			'GAT'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAC'=list(
				aa='D',
				type='ORDINARY'
			),
			'GAA'=list(
				aa='E',
				type='ORDINARY'
			),
			'GAG'=list(
				aa='E',
				type='ORDINARY'
			),
			'GGT'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGC'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGA'=list(
				aa='G',
				type='ORDINARY'
			),
			'GGG'=list(
				aa='G',
				type='ORDINARY'
			)
		)
	)
);

# end of genetic code tables #

	table.id<-as.character(table.id);

	# Figure out the symbols set by excluding stop codons:

	symbols<-character();

	for (codon in names(CODON.TABLES[[table.id]]$trans)) {

			if(CODON.TABLES[[table.id]]$trans[[codon]]$type != "STOP") {
				symbols<-c(symbols,codon);
			}
	}

	this<-Alphabet(
		type=CODON.TABLES[[table.id]]$name,
		symbols=symbols
		);

	this<-extend(this,
		"CodonAlphabet",
		.table.id=table.id,
		.trans.table=CODON.TABLES[[table.id]]$trans,
		.is.codon.alphabet=TRUE
		);

		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="CodonAlphabet",
  function(
    this,
    ...
  ){ 

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

			if(!is.character(this$.table.id) | (length(this$.table.id) != 1) )	{
				throw(".table.id inconsistency!\n");
			}
			if(!is.list(this$.trans.table)){
				throw("Translation table is not a list!\n");
			}
			for (tmp in this$.trans.table){
					if (length(intersect(names(tmp),c("aa","type"))) != 2){
						throw("Translation table contains invalid entries!\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: getTableId
##  
###########################################################################/**
#
# @RdocMethod getTableId
# 
# @title "Get the genetic code id" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonAlphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create CodonAlphabet object
#	a<-CodonAlphabet()
#	# get genetic code id
#	getTableId(a)
#	# get genetic code id via virtual field
#	a$tableId
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getTableId",
  class="CodonAlphabet",
  function(
    this,
    ...
  ){

		this$.table.id;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: setTableId
##  
###########################################################################/**
#
# @RdocMethod setTableId
#
# @title "Forbidden action: setting the genetic code id"
#
# \description{
#       @get "title".
#	Use the \code{table.id} constructor argument to set the genetic code.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setTableId",
  class="CodonAlphabet",
  function(
    this,
		value,
    ...
  ){

		virtualAssignmentForbidden(this);	

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: translateCodon
##  
###########################################################################/**
#
# @RdocMethod translateCodon
# 
# @title "Translate a codon" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonAlphabet object.}
# 	\item{codon}{The codon to be translated.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector containing an amino acid IUPAC code.
# } 
# 
# \examples{
#	# create a CodonAlphabet object
#	a<-CodonAlphabet()
#	# translate a codon
#	translateCodon(a,"AGG")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "translateCodon",
  class="CodonAlphabet",
  function(
	this,
	codon,
	...
  ){

	if(!exists(x="PSIM_FAST")){
		if(missing(codon)){
			throw("No codon given!\n");
		}
		else if (!is.character(codon) | (length(codon) != 1)){
			throw("The codon argument must be a character vector of size 1!\n");
		}
		else if (length(intersect(names(this$.trans.table),codon)) != 1){
			throw("Codon not in translation table!\n");
		}
		else if (this$.trans.table[[codon]]$type == "STOP"){
			return("*");
		}
		else {
				return(this$.trans.table[[codon]]$aa);			
		}
	} else {

		return(this$.trans.table[[codon]]$aa);			
	}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: isStopCodon
##  
###########################################################################/**
#
# @RdocMethod isStopCodon
# 
# @title "Check if a codon is a stop codon" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonAlphabet object.}
# 	\item{codon}{The codon to be checked.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a CodonAlphabet object
#	a<-CodonAlphabet()
#	# check some codons
#	isStopCodon(a,"ATG")
#	isStopCodon(a,"TGA")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "isStopCodon",
  class="CodonAlphabet",
  function(
    this,
    codon,
    ...
  ){
	if(!exists(x="PSIM_FAST")){
		if(missing(codon)){
			throw("No codon given!\n");
		}
		else if (!is.character(codon) | (length(codon) != 1)){
			throw("The codon argument must be a character vector of size 1!\n");
		}
		else if (length(intersect(names(this$.trans.table),codon)) != 1){
			throw("Codon not in translation table!\n");
		}
	}	
		if (this$.trans.table[[codon]]$type == "STOP"){
			return(TRUE);
		}
		else {
				return(FALSE);			
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: isStartCodon
##  
###########################################################################/**
#
# @RdocMethod isStartCodon
# 
# @title "Check if a codon is a start codon" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonAlphabet object.}
# 	\item{codon}{The codon to be checked.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a CodonAlphabet object
#	a<-CodonAlphabet()
#	# check some codons
#	isStartCodon(a,"ATG")
#	isStartCodon(a,"TGA")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "isStartCodon",
  class="CodonAlphabet",
  function(
    this,
		codon,
    ...
  ){
	if(!exists(x="PSIM_FAST")){
		if(missing(codon)){
			throw("No codon given!\n");
		}
		else if (!is.character(codon) | (length(codon) != 1)){
			throw("The codon argument must be a character vector of size 1!\n");
		}
		else if (length(intersect(names(this$.trans.table),codon)) != 1){
			throw("Codon not in translation table!\n");
		}
	}
		
		if (this$.trans.table[[codon]]$type == "START"){
			return(TRUE);
		}
		else {
				return(FALSE);			
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: areSynonymous
##  
###########################################################################/**
#
# @RdocMethod areSynonymous
# 
# @title "Check whether two codons are synonymous" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonAlphabet object.} 
#	\item{codons}{A vector containing two codons.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a CodonAlphabet object
#	a<-CodonAlphabet()
#	areSynonymous(a,c("TCC","TCT"))	
#	areSynonymous(a,c("TCC","CCT"))	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "areSynonymous",
  class="CodonAlphabet",
  function(
	this,
	codons,
	...
  ){

	if(!exists(x="PSIM_FAST")){
		if(missing(codons)){
			throw("No codons given!\n");
		}
		else if (!is.character(codons) | (length(codons) != 2)){
			throw("The codons argument must be a character vector of size 2!\n");
		}
	}
		
		if (translateCodon(this,codons[1]) == translateCodon(this,codons[2])){
			return(TRUE);
		}
		else {
				return(FALSE);			
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .codonDiff
##  
setMethodS3(
  ".codonDiff",
  class="CodonAlphabet",
  function(
    this,
		codons,
    ...
  ){

	if(!exists(x="PSIM_FAST")){

		if(missing(codons)){
			throw("No codons given!\n");
		}
		else if (!is.character(codons) | (length(codons) != 2)){
			throw("The codons argument must be a character vector of size 2!\n");
		}
		else if (length(intersect(names(this$.trans.table),codons[1])) != 1){
			throw("Codon 1 is not in translation table!\n");
		}
		else if (length(intersect(names(this$.trans.table),codons[2])) != 1){
			throw("Codon 2 is not in translation table!\n");
		}
	}

			purines<-c("A","G");
			pyrimidines<-c("C","T");
			res<-character();

			codon1<-strsplit(codons[1],"",fixed=TRUE)[[1]];
			codon2<-strsplit(codons[2],"",fixed=TRUE)[[1]];

			for(i in c(1,2,3)){
					if(codon1[i] == codon2[i]) {
						res[i]<-0;
					}	
					else if ( length(intersect(purines,c(codon1[i],codon2[i]))) == 2 | length(intersect(pyrimidines,c(codon1[i],codon2[i]))) == 2 ){
						res[i]<-"TI";
					} else {
						res[i]<-"TV";
					}
			}
			return(res);	

  },
  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<-CodonAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="CodonAlphabet",
  function(
    object,
    ...
  ){

		NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: getTransTable
##  
###########################################################################/**
#
# @RdocMethod getTransTable
# 
# @title "Get the list storing the genetic code table" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonAlphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list.
# } 
# 
# \examples{
#	# create object
#	a<-CodonAlphabet()
#	# get genetic code table
#	getTransTable(a)
#	# get genetic code table via virtual field
#	a$transTable
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getTransTable",
  class="CodonAlphabet",
  function(
    this,
    ...
  ){

		this$.trans.table

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: setTransTable
##  
###########################################################################/**
#
# @RdocMethod setTransTable
#
# @title "Forbidden action: setting the genetic code table for a CodonAlphabet object"
#
# \description{
#       @get "title".
#	Use the \code{table.id} constructor argument to set the genetic code.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setTransTable",
  class="CodonAlphabet",
  function(
    this,
		value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: is.CodonAlphabet
##  
###########################################################################/**
#
# @RdocDefault is.CodonAlphabet
# 
# @title "Check if an object inherits from CodonAlphabet" 
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#		\item{this}{An object.}
#		\item{...}{Not used.}
#
# } 
# 
# \value{ 
#	TRUE of FALSE.
# } 
#
# \examples{
#	# create some objects
#	a<-CodonAlphabet()
#	p<-Process()
#	# check if they inherit from CodonAlphabet
#	is.CodonAlphabet(a)
#	is.CodonAlphabet(p)
# }
# 
# @author 
# 
#*/###########################################################################
setMethodS3(
  "is.CodonAlphabet",
  class="default",
  function(
    this,
    ...
  ){

    if(!is.PSRoot(this)) {return(FALSE)}
		else if(!is.null(this$.is.codon.alphabet)){return(TRUE)}
    else if ( inherits(this, "CodonAlphabet")) {
			this$.is.codon.alphabet<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	

##
## CodonUNREST
##
##########################################################################/** 
#
# @RdocClass CodonUNREST
# 
# @title "The CodonUNREST class"
# 
# \description{ 
#	This class implements a time-continuous Markov process acting on a state
#	space defined by the symbol set of a CodonAlphabet object. The rate matrix of this model
#	is unrestricted, so it can be used to implement empircal codon models or more
#	restricted mechanistic models.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
# 	\item{table.id}{The identifier of the genetic code table (see \code{CodonAlphabet}).}
# 	\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 a CodonUNREST object
#	p<-CodonUNREST(table.id=2)
#	# get object summary
#	summary(p)
# }
# 
# @author
#
# \seealso{ 
# 	GeneralSubstitution GY94
# }
# 
#*/###########################################################################
setConstructorS3(
  "CodonUNREST",
  function( 
		name="Anonymous", # name of the object
		table.id=1,	  # the id of the genetic code table to use
		rate.list=NA,	  # list of unscaled rates
		equ.dist=NA,      # equlibrium distribution
		... 
		)	{

		got.rate.list<-!missing(rate.list);
		got.equ.dist<-!missing(equ.dist);
		
			this<-NA;
			# Got rate list and equlibrium distribution:
			if(got.rate.list & got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=CodonAlphabet(table.id=table.id),
					rate.list=rate.list,
					equ.dist=equ.dist
				);	
			}
		
			# Got rate list	
			else if(got.rate.list & !got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=CodonAlphabet(table.id=table.id),
					rate.list=rate.list
				);	
			}
			
			# Got equlibrium distribution,
			# we set it, but it will be owerwritten anyway.
			else if(!got.rate.list & got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=CodonAlphabet(table.id=table.id),
					equ.dist=equ.dist
				);	
			}

			# Got nothing:
			else if(!got.rate.list & !got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=CodonAlphabet(table.id=table.id)
				);	
			}
				
			this<-extend(this, "CodonUNREST");

		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="CodonUNREST", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
	
				if(!inherits(this$alphabet, "CodonAlphabet")){
					throw("This object must have as alphabet a CodonAlphabet object!\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: is.CodonUNREST
##  
###########################################################################/**
#
# @RdocDefault is.CodonUNREST
# 
# @title "Check whether an object inherits from CodonUNREST" 
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#		\item{this}{An object.}
#		\item{...}{Not used.}
#
# } 
# 
# \value{ 
#	TRUE of FALSE.
# } 
#
# \examples{
#	# create some objects
#	p<-CodonUNREST()
#	pp<-GTR()
#	# check if they inherit from CodonUNREST
#	is.CodonUNREST(p)
#	is.CodonUNREST(pp)
# }
# 
# @author 
# 
#*/###########################################################################
setMethodS3(
  "is.CodonUNREST",
  class="default",
  function(
    this,
    ...
  ){

    if(!is.GeneralSubstitution(this)) {return(FALSE)}
    if ( inherits(this, "CodonUNREST")) {
      return(TRUE);
    } else {
      return(FALSE)
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## GY94
##
##########################################################################/** 
#
# @RdocClass GY94
# 
# @title "The GY94 class"
# 
# \description{ 
#	This class implements the codon substitution model of Goldman and Yang (1994). 
#	The transition/transversion rate ratio is stored in the \code{kappa} virtual field. 
# 	The nonsynonymous/synonymous substitution rate ratio (\code{omega}) is a site-process specific parameter 
#	with a default value of one.
#	Hence, after the attachment of the process the variation of omega ratios among sites follows 
#	the M0 model (see Yang et al. 2000).
#
#       The rate matrix of the \code{\link{GY94}} model is scaled in a way that the expected number
#       of potential substiutions per site is equal to one at equlibrium. 
#       The \emph{codeml} program from the PAML package scales the rate matrix in order to have 
#       the expected number of accepted substiutions per site equal to one. Use the
#	\code{\link{getOmegaScalingFactor.GY94}} method to claculate a branch length scaling factor
#	which allows to switch to a PAML-style scaling given an average omega.
#
#	If the \code{scale.nuc} constructor argument is TRUE, the rates of the returned \code{Event} objects
#	will be multiplied by \code{3} to obtain a process which has the expected number of nucleotide substitutions
#	(not \code{codon} substitutions) equal to one at equilibrium. This is useful when simulating
#	mixed sequences. This option doesn't affect the rate matrix in any way.
#
#	The M1-M4 models are implemented in the \code{omegaVarM[1-4].CodonSeqeunce} methods.
#	Simulations under more complex models (M5-M13) can be achieved by first discretizing them 
#	using the \code{M5-13} tool from the INDELible software 
#	package (\url{http://abacus.gene.ucl.ac.uk/software/indelible/}). 
#	After discretization, the M5-M13 models can be simulated through the M3 (discrete) model.
#
#	@classhierarchy
# }
#
# \references{
# Goldman, N., Yang, Z. (1994) A codon-based model of nucleotide substitution for protein-coding DNA sequences - Mol Biol Evol 11(5):725-36 \url{http://bit.ly/aSVEoa}
#
# Yang, Z., Nielsen, R., Goldman, N., Pedersen Krabbe, A-M. (2000) Codon-Substitution Models for Heterogeneous Selection Pressure at Amino Acid Sites - Genetics 155:431-449 \url{http://bit.ly/bvjucn}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Name of the object.}
#	\item{table.id}{The identifier of the genetic code table to use (1 by default).}
#	\item{kappa}{The transition/transversion rate ratio (1 by default).}
#	\item{omega.default}{The default value of the omega site-process specific parameter (1 by default).}
#	\item{codon.freqs}{A vector of codon frequencies.}
#	\item{scale.nuc}{Scale to nucleotide substitutions if TRUE (see above).}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a GY94 object
#	p<-GY94(kappa=2)
#	# check if inherits from GY94
#	is.GY94(p)
#	# get object summary
#	summary(p)
#	# display a bubble plot
#	plot(p)
#	# create a codon sequence, attach process
#	s<-CodonSequence(length=5, processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make first three positions invariable
#	setRateMultipliers(s,p,0,1:3)
#	# sample omega values from the M3 (discrete) model.
#	omegaVarM3(s,p,omegas=c(0,1,2,3),probs=c(2/5,1/5,1/5,1/5))
#	# get a histogram of omega values in s
#	omegaHist(s,p,breaks=50)
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#	# get the list of recorded per-branch event counts
#	getBranchEvents(sim)
#	# export the number of synonymous substitutions as a phylo object
#	syn.subst<-exportStatTree(sim,"nr.syn.subst")
#	syn.subst
#	# plot the exported phylo object
#	plot(syn.subst)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	CodonUNREST GeneralSubstitution CodonSequence GTR WAG
# }
# 
#*/###########################################################################
setConstructorS3(
  "GY94",
  function( 
		name="Anonymous", # name of the object
		table.id=1,	  # id of the genetic code table to use
		kappa=1,	  # transition/transversion rate ratio
		omega.default=1,  # the default value of the omega site-process specific parameter
		codon.freqs=NA,   # codon frequencies 
		scale.nuc=FALSE,  # scale Q matrix to nucleotide substitutions
		... 
		)	{

		# Create a CodonUNREST object.
		this<-CodonUNREST(table.id=table.id);

		# Set codon frequencies to uniform if they are not provided:
		if(missing(codon.freqs)){
			codon.freqs<-rep((1/this$alphabet$size),this$alphabet$size);
		}

		# Extend:
		this<-extend(
			this,
			"GY94",
			.kappa=NA,
			.is.ny98=TRUE,
			.scale.const=as.double(1.0),
			.syn.cache=NA
		);

		# Add the "omega" site-process specific parameter:
		.addSiteSpecificParameter(
      			this,
      			id="omega",
      			name="Omega",
      			value=as.double(omega.default),
      			type="numeric"
    );

		# Set the codon frequencies/equilibrium distribution.
		setEquDist(this,value=codon.freqs,force=TRUE);	
		# Set kappa:
		this$kappa<-kappa;
		
		# Scale to nucleotide if requested:
		if(scale.nuc){
			this$.scale.const<-as.double(3.0);
		}

		# Set object name:
		this$name<-name;

		 # Force clearing id cache:              
                this$name<-this$name;

                # create syn/nsyn matrix cache
                # Get translation table:
                trans.table<-this$.alphabet$.trans.table;
                symbols<-this$.alphabet$symbols;

                syn.cache<-matrix(nrow=this$.alphabet$size,ncol=this$.alphabet$size);
		colnames(syn.cache)<-symbols;
		rownames(syn.cache)<-symbols;

                for(i in symbols){
                        for(j in symbols){
                                if(i == j) { next }

                                 if( (trans.table[[i]]$aa) == (trans.table[[j]]$aa) ){
                                        syn.cache[i,j]<-1;
                                 }
                                 else{ 
                                        syn.cache[i,j]<-0;
                                 }
                        }
                }

                this$.syn.cache<-syn.cache;

		return(this);

  },
  enforceRCC=TRUE
);

##  
## Method: is.GY94
##  
###########################################################################/**
#
# @RdocDefault is.GY94
# 
# @title "Check whether an object inherits from GY94" 
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#		\item{this}{An object.}
#		\item{...}{Not used.}
# } 
# 
# \value{ 
#	TRUE of FALSE.
# } 
#
# \examples{
#	# create some objects
#	p<-CodonUNREST()
#	pp<-GY94()
#	# check if they inherit from CodonUNREST
#	is.GY94(p)
#	is.GY94(pp)
# }
# 
# @author 
# 
#*/###########################################################################
setMethodS3(
  "is.GY94",
  class="default",
  function(
    this,
    ...
  ){

    if(!is.PSRoot(this)) {return(FALSE)}
    if(!is.null(this$.is.ny98)){return(TRUE)}
    if ( inherits(this, "GY94")) {
      this$.is.process<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEventsAtSite.GY94
##	
###########################################################################/**
#
# @RdocMethod getEventsAtSite
# 
# @title "Generate the list of active Event objects for a given attached Site object" 
# 
# \description{ 
#       @get "title".
# 
# This method is almost an exact duplicate of the getEventsAtSite.GeneralSubstitution,
# with the exception of the portions dealing with the omega site-process specific parameter. 
#       
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A GY94 object.} 
#       \item{target.site}{A Site object. The GY94 object must be attached to the Site object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A list of the active Event objects.
# } 
# 
# 
# @author 
# 
# \seealso{ 
#       getEventsAtSite.GeneralSubstitution GeneralSubstitution
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventsAtSite", 
	class="GY94", 
	function(
		this,
		target.site,
		...
	){

	if (!exists(x="PSIM_FAST")) {

      			if(!is.Site(target.site)) {
      			  throw("Target site invalid!\n");
      			}
	 		
			if(is.na(this$.q.matrix)){
				throw("Cannot provide event objects because the rate matrix is not set!\n");	
			}
			if(!is.numeric(this$.equ.dist)){
				throw("Cannot provide event objects because the equilibrium frequencies are not defined!\n");	
			} 
		} 

			state<-as.character(target.site$.state);
		  	# Just return an empty list if the state is NA:
			if(is.na(state)){
				return(list());
			}

			 # Get rate matrix:
        		 rate.matrix<-this$.q.matrix$.rate.matrix;

			# Get translation table:
			trans.table<-target.site$.alphabet$.trans.table;
		
			# Get scaling constant:
			scale.const<-this$.scale.const;

			# get syn cache:
			syn.cache<-this$.syn.cache;

			symbols<-this$.alphabet$.symbols;
			rest<-symbols[ which(symbols != state) ];

			# Create the event objects:
			events<-list();
			  
			# The rate of the event is the product of the general rate and the
     			# site-process specific rate multiplier:
			rate.multiplier<-target.site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value;
			# Return empty list if the rate multiplier is zero.
     			if(rate.multiplier == 0 ) {
      				return(list());
     			}	
    
			# Get the omega site-process specific parameter: 
			omega<-target.site$.processes[[this$.id]]$site.params[["omega"]]$value;
			
			for(new.state in rest){
				
				# Get the base rate:
				base.rate<-rate.matrix[state,new.state];

				# Skip event if base rate is zero:
				if(base.rate == 0){
					next;
				}

			  	name<-paste(state,new.state,sep="->");
		 		# Clone the event template object:
     				event<-clone(this$.event.template);
     				# Set event name:
     				event$.name<-name;
     				# Set the generator process:
     				event$.process<-this;
     				# Set the target position passed in a temporary field,
				# Event objects are not aware of their posiitions in general!
     				event$.position<-target.site$.position;
     				# Set the target site:
     				event$.site<-target.site;

				# Figure out wether the event is a synonymous mutation ...
				
				if( syn.cache[state,new.state] ){
					# and ignore omega in that case
					event$.rate<-(scale.const * rate.multiplier * base.rate);		
					# Mark substitution as synonymous.
					event$.type<-"synonymous";
				} else {
					# incorporate omega otherwise
					event$.rate<-(scale.const * rate.multiplier * omega * base.rate);
					# Mark substitution as non-synonymous.
					event$.type<-"non-synonymous";
				}

				# Set the handler for the substitution event:
				event$.handler<-this$.handler.template;

				# Add to events list:	
				events<-c(events, list(event));

			}

			return(events);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## 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="GY94", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {

      # Check kappa:
      if(!is.numeric(this$.kappa)){
        throw("Kappa must be numeric!\n");
      }
      # Check codon.freqs
      this$codonFreqs<-this$codonFreqs;

			# Check rate sanity:
			symbols<-this$alphabet$symbols;
			alphabet<-this$alphabet;

			for(from in symbols){
				for(to in symbols){
		
				# Skip diagonal elements:
				if(from == to) {next()};
				
				# Figure out codon differences:
				diff<-sort(.codonDiff(alphabet, c(from,to)));					

				# Single transition:
				if( all(diff == sort(c(0,0,"TI"))) ){
					if( !PSRoot$my.all.equal ( this$.q.matrix$.orig.matrix[from, to], (this$.kappa * this$.equ.dist[1,to]) ) ){
							throw("GY94 rate inconsistency. From:",from," To:",to,"!\n");

						}
				}
				# Single transversion:
				else if( all(diff == sort(c(0,0,"TV"))) ){
					if( !PSRoot$my.all.equal ( this$.q.matrix$.orig.matrix[from, to], (this$.equ.dist[1,to]) ) ){
					  throw("GY94 rate inconsistency. From:",from," To:",to,"!\n");
					}
				}
				# Multiple nucleotide substitution:
				else {
					if( this$.q.matrix$.orig.matrix[from, to] != 0.0 ){
						throw("GY94 rate inconsistency. From:",from," To:",to,"!\n");
					}
				}
	
				} #/for to
			} #/for from
	
      }
      tryCatch(may.fail(this),finally=this$writeProtected<-wp);
			NextMethod();		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


###########################################################################/**
#
# @RdocMethod getOmegaScalingFactor
# 
# @title "Get the omega scaling factor" 
# 
# \description{ 
#	@get "title".
#
#       The rate matrix of the \code{\link{GY94}} model is scaled in a way that the expected number
#       of potential substiutions per site is equal to one at equlibrium. 
#       The \emph{codeml} program from the PAML package scales the rate matrix in order to have 
#       the expected number of accepted substiutions per site equal to one. 
#
#	This method calculates the branch length multiplier needed for switching 
#	to PAML-style scaling given a fixed omega.
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GY94 object.} 
#	\item{omega}{The value of omega.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# construct a GY94 process object
#	p<-GY94(kappa=4)
#	# Calculate scaling factor for omega=2
#	getOmegaScalingFactor(p,omega=2)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getOmegaScalingFactor", 
	class="GY94", 
	function(
		this,
		omega,
		...
	){

		if(missing(omega)){
			throw("No omega provided!");
		}
		if(!is.numeric(omega)){
			throw("Omega must be numeric!");
		}

		neutral.K<-0.0;

		K <- 0.0;
                # get the symbols:
                symbols<-this$.alphabet$symbols;

		# Get translation table and rate matrix:
                trans.table<-this$.alphabet$.trans.table;
		rate.matrix<-this$.q.matrix$.rate.matrix;

                # For every symbol:
                for (i in symbols) {

                # Get the equlibrium probability:
                i.equ<-this$.equ.dist[[ which(colnames(this$.equ.dist) == i) ]];
                for(j in symbols){
                        if(i == j){next}
				base.rate<-rate.matrix[i,j];
				neutral.K<- neutral.K + (i.equ * base.rate);

				if( (trans.table[[i]]$aa) == (trans.table[[j]]$aa) ){
                        		K <- K + (i.equ * base.rate);
				}
				else {
                        		K <- K + (i.equ * omega * base.rate);
				}
                        }

                }

		return(neutral.K/K);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .buildGY94Rates
##	
setMethodS3(
	".buildGY94Rates", 
	class="GY94", 
	function(
		this,
		...
	){

		
		# Wiping out the rate matrices to prevent rescaling after
		# modifying an individual rate. This could be more elegant.

		# Wiping out the original rate matrix:
		this$QMatrix$.orig.matrix[]<-NA;
		# Wiping out the scaled rate matrix:
		this$QMatrix$.rate.matrix[]<-NA;

		alphabet<-this$.alphabet;
		symbols<-alphabet$symbols;

		purines<-c("A","G");
    		pyrimidines<-c("C","T");

		for(i in symbols){
			for(j in symbols){

				# Split codons:
				nuc.i<-strsplit(i,"",fixed=TRUE)[[1]];
				nuc.j<-strsplit(j,"",fixed=TRUE)[[1]];
	
				diff<-which( (nuc.i == nuc.j) == FALSE);

				# Skip diagonal elements:
				if( i == j) { 
						next;
				}
				else if( length( diff ) > 1){
					# We have multiple nucleotiode substiutions:
					this$.q.matrix$.orig.matrix[i,j]<-0;
				}
				else if ( 
									length( intersect( purines, c(nuc.i[diff[1]],nuc.j[diff[1]])) ) == 2 |
									length( intersect( pyrimidines, c(nuc.i[diff[1]],nuc.j[diff[1]])) ) == 2
								){
					# We have a single transition:
					this$.q.matrix$.orig.matrix[i,j]<-(this$.kappa * this$.equ.dist[1,j]);
				} else {
					# The only possibility left is a single transversion:
					this$.q.matrix$.orig.matrix[i,j]<-(this$.equ.dist[1,j]);
				}

			} # /for j
		} # /for i

		# Set the new diagonal element in the original rates matrix:
		for(codon in symbols){
        	this$.q.matrix$.orig.matrix[codon, codon]<-.calculateDiagonal(this$.q.matrix, symbol=codon);
		}
		
		# Call rate rescaling, suppress equlibrium distribution guessing:
		.callRateRescaling(this$.q.matrix,guess.equ=FALSE);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: setRate
##  
###########################################################################/**
#
# @RdocMethod setRate
#
# @title "Set an unscaled rate for an event from a GY94 object" 
# 
# \description{ 
#       @get "title".
#       
#	See \code{\link{setRate.GeneralSubstitution}}.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A GeneralSubstitution object.} 
#       \item{name}{The name of the event.}
#       \item{from}{The initial state.}
#       \item{value}{The new value of the rate.}
#       \item{to}{Target state.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A Numeric vector of length one.
# } 
# 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setRate",
  class="GY94",
  function(
    this,
    name=NA,
    value,
    from=NA,
    to=NA,
    ...
  ){

    	.checkWriteProtection(this);
    	# Setting unscaled rate:
	if(!exists(x="PSIM_FAST")) {
    		if(!is.QMatrix(this$.q.matrix)){
      			throw("Cannot set rate as the rate matrix is undefined!\n");
    		}
	}
    
	if(!missing(name) & missing(from) & missing(to)){
      		return(setRate(this$.q.matrix, name=name, value=value,guess.equ=FALSE));
    	}
    	else if (missing(name) & !missing(from) & !missing(to)){
      		return(setRate(this$.q.matrix, from=from, to=to, value=value,guess.equ=FALSE));
    	}


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: getKappa
##  
###########################################################################/**
#
# @RdocMethod getKappa
# 
# @title "Get the transition/transversion rate ratio" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GY94 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94()
#	# set/get kappa
#	setKappa(p,2)
#	getKappa(p)
#	# set/get kappa via virtual field
#	p$kappa<-3
#	p$kappa
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getKappa",
  class="GY94",
  function(
    this,
    ...
  ){

		this$.kappa;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: setKappa
##  
###########################################################################/**
#
# @RdocMethod setKappa
# 
# @title "Set the transition/transversion rate ratio" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GY94 object.} 
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of kappa.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94()
#	# set/get kappa
#	setKappa(p,2)
#	getKappa(p)
#	# set/get kappa via virtual field
#	p$kappa<-3
#	p$kappa
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setKappa",
  class="GY94",
  function(
    this,
    value,
    ...
  ){
	
	.checkWriteProtection(this);		
	if(!exists(x="PSIM_FAST")){
			if(missing(value)){
				throw("No new value provided");
			}
			else if (length(value) != 1 | !is.numeric(value)){
				throw("The new value must be a numeric vector of length 1!\n");
			}
	}
			
			this$.kappa<-value;
			.buildGY94Rates(this);
			return(value);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: getCodonFreqs
##  
###########################################################################/**
#
# @RdocMethod getCodonFreqs
# 
# @title "Get codon frequencies" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GY94 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the codon frequencies.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94()	
#	# get codon frequencies
#	getCodonFreqs(p)
#	p$codonFreqs
#	# set codon frequencies
#	p$codonFreqs<-rep(c(1,2,3,4),length.out=61)
#	p$codonFreqs
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getCodonFreqs",
  class="GY94",
  function(
    this,
    ...
  ){

		this$.equ.dist;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: setCodonFreqs
##  
###########################################################################/**
#
# @RdocMethod setCodonFreqs
# 
# @title "Get codon frequencies" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GY94 object.} 
#	\item{value}{A vector of codon frequencies.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible)
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94()	
#	# get codon frequencies
#	getCodonFreqs(p)
#	p$codonFreqs
#	# set codon frequencies
#	p$codonFreqs<-rep(c(1,2,3,4),length.out=61)
#	p$codonFreqs
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setCodonFreqs",
  class="GY94",
  function(
    this,
    value,
    ...
  ){

		.checkWriteProtection(this);
		setEquDist(this,value,force=TRUE);
		.buildGY94Rates(this);
		return(invisible(value));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: summary.GY94
##  
###########################################################################/**
#
# @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<-GY94(kappa=2)
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="GY94",
  function(
    object,
    ...
  ){

    this<-object;
    .addSummaryNameId(this);
		this$.summary$"Kappa"<-this$.kappa;
		this$.summary$"Genetic code table id"<-this$.alphabet$tableId;
    .addSummaryAlphabet(this);
		this$.summary$"Unscaled rate matrix"<-"not shown";

    NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## 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")
);

			
##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass ContinuousDeletor
# 
# @title "The ContinuousDeletor class"
# 
# \description{ 
#	This class implements a process which performs deletions with
#       lengths sampled from a user-specified R expression returning a 
#	numeric value.
#       See \code{GeneralDeletor} for the how the deletion processes
#	works.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
# 	\item{rate}{The general rate.}
# 	\item{dist}{The length sampling expression.}
# 	\item{max.length}{Maximum event length.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
# 	# create a ContinuousDeletor process
#       o<-ContinuousDeletor(
#               name="Conty",
#               rate=0.25,
#		dist=expression(1),
#		max.length=2
#       )
#       # get object summary
#       summary(o)
#       # set/get length sampling expression
#       o$dist<-expression(rnorm(1,mean=3,sd=3))
#	o$dist
#       # set/get maximum event length
#	o$maxLength<-4
#	o$maxLength
#       # plot length density
#       plot(o)
#       
#       # The following code illustrates how to use
#       # a ContinuousDeletor process in a simulation
#       
#       # create a sequence object, attach process o
#       s<-NucleotideSequence(string="AAAAAAAAAAGGGGAAAAAAAAAA",processes=list(list(o)))
#       # set the deletion tolerance to zero in range 11:15
#       # creating a region rejecting all deletions
#       setDeletionTolerance(s,o,0,11:15)       
#       # get deletion tolerances
#       getDeletionTolerance(s,o)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # simulate
#       Simulate(sim)
#       # print resulting alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GeneralDeletor DiscreteDeletor GeneralInDel
# }
# 
#*/###########################################################################
setConstructorS3(
  "ContinuousDeletor",
  function( 
		name="Anonymous",
		rate=NA,
		dist=NA,
		max.length=NA,
		... 
		)	{

		this<-GeneralDeletor(
			 name=NA,
			 rate=rate,
			 propose.by=NA,
    	 accept.by=NA,
			...
		);
    this<-extend(
      this,
      "ContinuousDeletor",
			.dist=NA,
			.max.length=NA
    );
		# Using virtual field to clear Id cache:
		this$name<-name;

		STATIC<-TRUE;
		if(!missing(dist)) {
			this$dist<-dist;
			STATIC<-FALSE;
		}
		
		if(!missing(max.length)) {
			this$.max.length<-max.length;
			STATIC<-FALSE;
		}

		this$proposeBy<-function(process=NA,...){
			if(!exists(x="PSIM_FAST")){
				if(!is.expression(process$.dist)){
					throw("\"dist\" is undefined, so cannot propose deletion length!\n");
				}
				else if(is.na(process$.max.length)){
					throw("\"maxLength\" is undefined, so cannot propose deletion length!\n");
				}
			}
				tmp<-round(eval(process$.dist));
				while( tmp > process$.max.length | tmp < 1){  tmp<-round(eval(process$.dist)) };	
				return(tmp);
		}

    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="ContinuousDeletor",
  function(
    this,
    ...
  ){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

        if (!is.na(this$maxLength)) {
          this$maxLength<-this$maxLength;
        }

        if (is.expression(this$dist)) {
          this$dist<-this$dist;
        }
        else if (!is.na(this$dist)){
          throw("Deletion length sampler expression is invalid!\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: getDist
##	
###########################################################################/**
#
# @RdocMethod getDist
# 
# @title "Get the length sampling expression" 
# 
# \description{ 
#	@get "title".
#
#	The length sampling expression can be any valid R expression returning
#	a numeric vector of length one. The value returned by the expression will be 
#	rounded.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An R expression object.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousDeletor(rate=1)
#	# set/get length sampling expression
#	setDist(o, expression(rnorm(1,mean=3, sd=2)))
#	getDist(o)
#	# set/get length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	o$dist
#	# set maxLength
#	o$maxLength<-10
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getDist", 
	class="ContinuousDeletor", 
	function(
		this,
		...
	){

		this$.dist;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setDist
##	
###########################################################################/**
#
# @RdocMethod setDist
# 
# @title "Set the length sampling expression" 
# 
# \description{ 
#	@get "title".
#
#	The length sampling expression can be any valid R expression returning
#	a numeric vector of length one. The value returned by the expression will be 
#	rounded.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousDeletor object.} 
# 	\item{value}{An R expression.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An R expression object.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousDeletor(rate=1)
#	# set/get length sampling expression
#	setDist(o, expression(rnorm(1,mean=3, sd=2)))
#	getDist(o)
#	# set/get length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	o$dist
#	# set maxLength
#	o$maxLength<-10
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setDist", 
	class="ContinuousDeletor", 
	function(
		this,
		value,
		...
	){
		
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} 
		else if (length(value) != 1 ) {
			throw("Value vector size should be 1!\n");
		}
		else if(!is.expression(value)) {
			throw("The new value must be a valid expression!\n");
		} else {
			# Do a test sampling:
			tmp<-eval(value);
			if( length(tmp) != 1 ) {
				throw("The return value of the length sampler expression must be of length 1!\n");
			}
			if (!is.numeric(tmp)) {
				throw("The return value of the length sampler expression must be numeric!\n");
			}
			else {
				this$.dist<-value;
			}
		}
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getMaxLength
##	
###########################################################################/**
#
# @RdocMethod getMaxLength
# 
# @title "Get the maximum length" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousDeletor(rate=1)
#	# set length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	# set/get maxLength
#	setMaxLength(o, 3)
#	getMaxLength(o)
#	# set/get maxLength via virtual field
#	o$maxLength<-10
#	o$maxLength
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getMaxLength", 
	class="ContinuousDeletor", 
	function(
		this,
		...
	){

		this$.max.length;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setMaxLength
##	
###########################################################################/**
#
# @RdocMethod setMaxLength
# 
# @title "Set the maximum length" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousDeletor object.} 
#	\item{value}{A numeric (integer) vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new maximum length.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousDeletor(rate=1)
#	# set length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	# set/get maxLength
#	setMaxLength(o, 3)
#	getMaxLength(o)
#	# set/get maxLength via virtual field
#	o$maxLength<-10
#	o$maxLength
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setMaxLength", 
	class="ContinuousDeletor", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} 
		else if (length(value) != 1 ) {
			throw("Value vector size should be 1!\n");
		}
		else if (!is.numeric(value)) {
			throw("Value vector size should be numeric!\n");
		}
		else if( round(value) != value ) {
			throw("maxLength must be integer!\n");
		} else {
			this$.max.length<-value;
		}
		return(invisible(this$.max.length));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: plot
##
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Plot the density of proposed lengths" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A ContinuousDeletor object.} 
# 	\item{sample.size}{Number of lengths sampled for the plot.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The process object (invisible).
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousDeletor(rate=1)
#	# set length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=10,sd=4))
#	# set maxLength
#	setMaxLength(o, 30)
#	# plot density
#	plot(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "plot",
  class="ContinuousDeletor",
  function(
    x,
    sample.size=NA,
    ...
  ){

		this<-x;		
		if( !is.numeric(this$maxLength) | !is.expression(this$dist) ){
				warning("Deletion length distribution is not defined properly! Nothing to plot here!\n");
				return();
		}
		size<-(this$maxLength * 10);
		if(!missing(sample.size)){
				if(!is.numeric(sample.size) | ( length(sample.size)) !=1 ) {
					throw("Sample size paramter must be a numeric vector of size 1!\n");
				} else {
					size<-round(sample.size);
				}
		}

			sample<-apply(as.array(0:size),1,function(...){this$.propose.by(this)});
      plot.default(
				density(sample,from=0,to=this$maxLength),
        			main=paste("Estimated deletion size density for:",this$id),
				sub=paste("Sample size:", size),
				type='l',
        			xlab="Size",
        			ylab="Density",
				xlim=c(1,this$maxLength),
				col="blue",
				lwd=1.5,
				xaxt="n"
      );
			 axis(side=1, at=c(0:this$maxLength), labels=c(0:this$maxLength));
			 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<-ContinuousDeletor(rate=1,dist=expression(rnorm(1,mean=5,sd=3)), max.length=10)
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="ContinuousDeletor",
  function(
    object,
    ...
  ){
    
    this<-object;
    .addSummaryNameId(this);

    this$.summary$"Length sampling expression"<-deparse(this$dist);
    this$.summary$"Maximum deletion length"<-this$maxLength;
    NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass ContinuousInsertor
# 
# @title "The ContinuousInsertor class"
# 
# \description{ 
#       This class implements a process which performs insertions with
#       lengths sampled from a user-specified R expression returning a 
#       numeric value.
#       See \code{GeneralInsertor} for the how the insertion process
#	works.
#
#       @classhierarchy
# }
#       
# @synopsis
#       
# \arguments{
#       \item{name}{The name of the object.}
#       \item{rate}{The general rate.}
#       \item{dist}{The length sampling expression.}
#       \item{max.length}{Maximum event length.}
#       \item{...}{Additional arguments.}
#       }
# 
# \section{Fields and Methods}{ 
#       @allmethods
# }
# 
# \examples{ 
#       # create a ContinuousInsertor process
#       o<-ContinuousInsertor(
#               name="Conty",
#               rate=0.1,
#               dist=expression(1),
#               max.length=2
#       )
#	# set template sequence
#	o$templateSeq<-NucleotideSequence(string="CAC")
#       # get object summary
#       summary(o)
#       # set/get length sampling expression
#       o$dist<-expression(rnorm(1,mean=3,sd=3))
#       o$dist
#       # set/get maximum event length
#       o$maxLength<-4
#       o$maxLength
#       # plot length density
#       plot(o)
#       
#       # The following code illustrates how to use
#       # a ContinuousInsertor process in a simulation
#       
#       # create a sequence object, attach process o
#       s<-NucleotideSequence(string="AAAAAAAAAAGGGGAAAAAAAAAA",processes=list(list(o)))
#       # set the insertion tolerance to zero in range 11:15
#       # creating a region rejecting all insertions
#       setInsertionTolerance(s,o,0,11:15)       
#       # get insertion tolerances
#       getInsertionTolerance(s,o)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # simulate
#       Simulate(sim)
#       # print resulting alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
#       GeneralInsertor DiscreteInsertor GeneralInDel
# }
# 
#*/###########################################################################
setConstructorS3(
  "ContinuousInsertor",
  function( 
		name="Anonymous",
		rate=NA,
		dist=NA,
		max.length=NA,
		... 
		)	{

		this<-GeneralInsertor(
			 name=NA,
			 rate=rate,
			 propose.by=NA,
    	 accept.by=NA,
			...
		);
    this<-extend(
      this,
      "ContinuousInsertor",
			.dist=NA,
			.max.length=NA
    );
		# Using virtual field to clear Id cache:
		this$name<-name;

		STATIC<-TRUE;
		if(!missing(dist)) {
			this$dist<-dist;
			STATIC<-FALSE;
		}
		
		if(!missing(max.length)) {
			this$.max.length<-max.length;
			STATIC<-FALSE;
		}

		this$proposeBy<-function(process=NA,...){
			if(!exists(x="PSIM_FAST")){
				if(!is.expression(process$.dist)){
					throw("\"dist\" is undefined, so cannot propose insertion length!\n");
				}
				else if(is.na(process$.max.length)){
					throw("\"maxLength\" is undefined, so cannot propose insertion length!\n");
				}
			}
				tmp<-round(eval(process$.dist));
				while( tmp > process$.max.length | tmp < 1){  tmp<-round(eval(process$.dist)) };	
				return(tmp);
		}

    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="ContinuousInsertor",
  function(
    this,
    ...
  ){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

        if (!is.na(this$maxLength)) {
          this$maxLength<-this$maxLength;
        }

        if (is.expression(this$dist)) {
          this$dist<-this$dist;
        }
        else if (!is.na(this$dist)){
          throw("Insertion length sampler expression is invalid!\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: getDist
##	
###########################################################################/**
#
# @RdocMethod getDist
# 
# @title "Get the length sampling expression" 
# 
# \description{ 
#	@get "title".
#
#	The length sampling expression can be any valid R expression returning
#	a numeric vector of length one. The value returned by the expression will be 
#	rounded.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An R expression object.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousInsertor(rate=1)
#	# set/get length sampling expression
#	setDist(o, expression(rnorm(1,mean=3, sd=2)))
#	getDist(o)
#	# set/get length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	o$dist
#	# set maxLength
#	o$maxLength<-10
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getDist", 
	class="ContinuousInsertor", 
	function(
		this,
		...
	){

		this$.dist;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setDist
##	
###########################################################################/**
#
# @RdocMethod setDist
# 
# @title "Set the length sampling expression" 
# 
# \description{ 
#	@get "title".
#
#	The length sampling expression can be any valid R expression returning
#	a numeric vector of length one. The value returned by the expression will be 
#	rounded.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousInsertor object.} 
# 	\item{value}{An R expression.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An R expression object.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousInsertor(rate=1)
#	# set/get length sampling expression
#	setDist(o, expression(rnorm(1,mean=3, sd=2)))
#	getDist(o)
#	# set/get length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	o$dist
#	# set maxLength
#	o$maxLength<-10
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setDist", 
	class="ContinuousInsertor", 
	function(
		this,
		value,
		...
	){
		
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} 
		else if (length(value) != 1 ) {
			throw("Value vector size should be 1!\n");
		}
		else if(!is.expression(value)) {
			throw("The new value must be a valid expression!\n");
		} else {
			# Do a test sampling:
			tmp<-eval(value);
			if( length(tmp) != 1 ) {
				throw("The return value of the length sampler expression must be of length 1!\n");
			}
			if (!is.numeric(tmp)) {
				throw("The return value of the length sampler expression must be numeric!\n");
			}
			else {
				this$.dist<-value;
			}
		}
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getMaxLength
##	
###########################################################################/**
#
# @RdocMethod getMaxLength
# 
# @title "Get the maximum length" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousInsertor(rate=1)
#	# set length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	# set/get maxLength
#	setMaxLength(o, 3)
#	getMaxLength(o)
#	# set/get maxLength via virtual field
#	o$maxLength<-10
#	o$maxLength
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getMaxLength", 
	class="ContinuousInsertor", 
	function(
		this,
		...
	){

		this$.max.length;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setMaxLength
##	
###########################################################################/**
#
# @RdocMethod setMaxLength
# 
# @title "Set the maximum length" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ContinuousInsertor object.} 
#	\item{value}{A numeric (integer) vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new maximum length.
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousInsertor(rate=1)
#	# set length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=6,sd=3))
#	# set/get maxLength
#	setMaxLength(o, 3)
#	getMaxLength(o)
#	# set/get maxLength via virtual field
#	o$maxLength<-10
#	o$maxLength
#	# propose a length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setMaxLength", 
	class="ContinuousInsertor", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} 
		else if (length(value) != 1 ) {
			throw("Value vector size should be 1!\n");
		}
		else if (!is.numeric(value)) {
			throw("Value vector size should be numeric!\n");
		}
		else if( round(value) != value ) {
			throw("maxLength must be integer!\n");
		} else {
			this$.max.length<-value;
		}
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: plot
##
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Plot the density of proposed lengths" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A ContinuousInsertor object.} 
#       \item{sample.size}{Number of lengths sampled for the plot.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The process object (invisible).
# } 
# 
# \examples{
#	# create object
#	o<-ContinuousInsertor(rate=1)
#	# set length sampling expression via virtual field
#	o$dist<-expression(rnorm(1,mean=10,sd=4))
#	# set maxLength
#	setMaxLength(o, 30)
#	# plot density
#	plot(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "plot",
  class="ContinuousInsertor",
  function(
    x,
    sample.size=NA,
    ...
  ){

		this<-x;		
		if( !is.numeric(this$maxLength) | !is.expression(this$dist) ){
				warning("Insertion length distribution is not defined properly! Nothing to plot here!\n");
				return();
		}
		size<-(this$maxLength * 10);
		if(!missing(sample.size)){
				if(!is.numeric(sample.size) | ( length(sample.size)) !=1 ) {
					throw("Sample size paramter must be a numeric vector of size 1!\n");
				} else {
					size<-round(sample.size);
				}
		}

			sample<-apply(as.array(0:size),1,function(...){this$.propose.by(this)});
      plot.default(
				density(sample,from=0,to=this$maxLength),
        main=paste("Estimated insertion size density for:",this$id),
				sub=paste("Sample size:", size),
				type='l',
        xlab="Size",
        ylab="Density",
				col="red",
				lwd=1.5,
				xaxt="n"
      );
			axis(side=1, at=(0:this$maxLength), labels=(0:this$maxLength));

  },
  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<-ContinuousInsertor(rate=1,dist=expression(rnorm(1,mean=5,sd=2)),max.length=7)
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="ContinuousInsertor",
  function(
    object,
    ...
  ){

    this<-object;	
    .addSummaryNameId(this);

    this$.summary$"Length sampling expression"<-deparse(this$dist);
    this$.summary$"Maximum insertion length"<-this$maxLength;
    NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass DiscreteDeletor
# 
# @title "The DiscreteDeletor class"
# 
# \description{ 
#	This class implements a process which performs deletions with
#	lengths sampled from a user-specified discrete distribution.
#	See \code{GeneralDeletor} for how the deletion process works.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
# 	\item{rate}{The general rate.}
#	\item{sizes}{The deletion sizes to propose.}
#	\item{probs}{A vector with the probabilites of the deletion sizes.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a DiscreteDeletor process
#	d<-DiscreteDeletor(
#		name="M.D.",
#		rate=0.25,
#		sizes=c(1,2),
#		probs=c(1/2,1/2)
# 	)
#	# get object summary
#	summary(d)
#	# set/get deletions sizes
#	d$sizes<-1:3
#	d$sizes
#	# set/get length probabilities
#	d$probs<-c(3,2,1)/6
#	d$probs
#	# plot length distribution
#	plot(d)
#	
#	# The following code illustrates how to use
#	# a DiscreteDeletor process in a simulation
#	
#	# create a sequence object, attach process d
#	s<-NucleotideSequence(string="AAAAAAAAAAGGGGAAAAAAAAAA",processes=list(list(d)))
#	# set the deletion tolerance to zero in the range 11:15
#	# creating a region rejecting all deletions
#	setDeletionTolerance(s,d,0,11:15)	
#	# get deletion tolerances
#	getDeletionTolerance(s,d)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# simulate
#	Simulate(sim)
#	# print resulting alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GeneralDeletor ContinuousDeletor GeneralInDel
# }
# 
#*/###########################################################################
setConstructorS3(
  "DiscreteDeletor",
  function( 
		name="Anonymous",
		rate=NA,
		sizes=NA,
		probs=NA,
		... 
		)	{

		this<-GeneralDeletor(
			 name=NA,
			 rate=rate,
			 propose.by=NA,
    	 accept.by=NA,
			...
		);
    this<-extend(
      this,
      "DiscreteDeletor",
			.sizes=NA,
			.probs=NA
    );
		# Using virtual field to clear Id cache:
		this$name<-name;

		STATIC<-TRUE;
		if(!missing(sizes)) {
			this$sizes<-sizes;
			STATIC<-FALSE;
		}
		
		if(!missing(probs)) {
			this$probs<-probs;
			STATIC<-FALSE;
		}

		this$proposeBy<-function(process=NA,...){
			if(!exists(x="PSIM_FAST")){
			if( !is.numeric(process$.sizes) | !is.numeric(process$.probs) ){
				throw("Cannot propose deletion length because the length distribution is not defined properly!\n");
			}
			}
			if(length(process$.sizes) == 1){
				return(process$.sizes[[1]]);
			} else {
				return(sample(x=process$.sizes,size=1,replace=FALSE,prob=process$.probs));
			}
		}

    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="DiscreteDeletor",
  function(
    this,
    ...
  ){

          wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {
				
        if (is.numeric(this$sizes)) {
          this$sizes<-this$sizes;
        } 
				else if (!is.na(this$sizes)){
					throw("Deletion size vector is invalid!\n");
				}

        if (is.numeric(this$probs)) {
          this$probs<-this$probs;
        }
				else if (!is.na(this$probs)){
					throw("Deletion size probability vector is invalid!\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: getSizes
##	
###########################################################################/**
#
# @RdocMethod getSizes
# 
# @title "Get the sizes of the proposed deletions" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A DiscreteDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A vector of integers.
# } 
# 
# \examples{
#	# create a DiscreteDeletor object
#	d<-DiscreteDeletor(rate=1)
#	# set deletion sizes      
#	setSizes(d,c(1,2,3))
#	# get deletion sizes
#	getSizes(d)
#	# set/get sizes via virtual field
#	d$sizes<-1:10
#	d$sizes	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSizes", 
	class="DiscreteDeletor", 
	function(
		this,
		...
	){

		this$.sizes;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSizes
##	
###########################################################################/**
#
# @RdocMethod setSizes
# 
# @title "Set the sizes of the proposed deletions" 
# 
# \description{ 
#	@get "title".
#	
#	The provided numeric vector is rounded.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A DiscreteDeletor object.} 
# 	\item{value}{A numeric vector.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A vector of integers (invisible).
# } 
# 
# \examples{
#	# create a DiscreteDeletor object
#	d<-DiscreteDeletor(rate=1)
#	# set deletion sizes      
#	setSizes(d,c(1,2,3))
#	# get deletion sizes
#	getSizes(d)
#	# set/get sizes via virtual field
#	d$sizes<-1:10
#	d$sizes	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSizes", 
	class="DiscreteDeletor", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} else if (!is.numeric(value)) {
			throw("The new value must be numeric vector!\n");
		} else {
			if(length(value) == 0 ) {
				warning("Deletion size vector has zero length!\n");
			}
			this$.sizes<-round(value);	
		}
		return(invisible(this$.sizes));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getProbs
##	
###########################################################################/**
#
# @RdocMethod getProbs
# 
# @title "Get the deletion length probabilities" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A DiscreteDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector with the deletion length probabilities.
# } 
# 
# \examples{
#	# create a DiscreteDeletor object
#	d<-DiscreteDeletor(rate=1, sizes=1:3)
#	# set/get length probabilities
#	setProbs(d,c(1/3,1/3,1/3)) # equal probabilites
#	getProbs(d)
#	# set/get length probabilities via virtual field
#	x<-c(2,2,1)
#	# normalize x
#	x<-x/sum(x)
#	d$probs<-x
#	d$probs
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getProbs", 
	class="DiscreteDeletor", 
	function(
		this,
		...
	){

		this$.probs;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setProbs
##	
###########################################################################/**
#
# @RdocMethod setProbs
# 
# @title "Set the deletion length probabilities" 
# 
# \description{ 
#	@get "title".
#
#	The \code{sizes} virtual field must be set before setting the length probabilities.
#	The length of the provided numeric vector must match with the length of the vector
#	stored in the \code{sizes} virtual field. The vector is rescaled if the values do not
#	sum to one and a warning is issued.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A DiscreteDeletor object.} 
#	\item{value}{A numeric vector containg the length probabilities.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The vector of probabilities.
# } 
# 
# \examples{
#	# create a DiscreteDeletor object
#	d<-DiscreteDeletor(rate=1, sizes=1:3)
#	# set/get length probabilities
#	setProbs(d,c(1/3,1/3,1/3)) # equal probabilites
#	getProbs(d)
#	# set/get length probabilities via virtual field
#	x<-c(2,2,1)
#	# normalize x
#	x<-x/sum(x)
#	d$probs<-x
#	d$probs
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setProbs", 
	class="DiscreteDeletor", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} 
		else if(!is.numeric(this$.sizes)) {
			throw("Cannot set probabilities because indel size vector is not defined!\n");
		}
		else if (!is.numeric(value)) {
			throw("The new value must be a numeric vector!\n");
		}
		else if(length(value) != length(this$.sizes)) {
			throw("The length of the probabilities vector must be the same as the length of the deletion sizes vector");	
		} 
		else if( length(value[value < 0 ]) != 0 ) {
			throw("The elements of the probability vector must not be negative!\n");
		}
		else {
  		if(!isTRUE(all.equal(sum(value),1.0))){
        		value<-value/sum(value);
        		warning("The provided values were rescaled in order to sum to one!\n");
    		}
			this$.probs<-value;
		}
		
	},
	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<-DiscreteDeletor(rate=1,sizes=c(1,2),probs=c(1/2,1/2))
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="DiscreteDeletor", 
	function(
		object,
		...
	){

		this<-object;
		.addSummaryNameId(this);

		expected.length<-NA;	
		sd<-NA;
		if( is.numeric(this$sizes) & is.numeric(this$probs)) {
		expected.length<-weighted.mean(this$sizes, this$probs);		
		sd<-sqrt(sum( (this$sizes - expected.length)^2 * this$probs ));
		}

		this$.summary$"Expected deletion length"<-expected.length;
		this$.summary$"Standard deviation of deletion length"<-format(sd);
		NextMethod();
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: plot
##	
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Plot the deletion length distribution" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A DiscreteDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The DiscreteDeletor object (invisible).
# } 
# 
# \examples{
#	d<-DiscreteDeletor(
#		name="MyDiscDel",
#		sizes=1:6,
#		probs=c(0.25000000, 0.16666667, 0.08333333, 0.08333333, 0.16666667, 0.25000000)
#	)
#	# plot the deletion length distribution
#	plot(d)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"plot", 
	class="DiscreteDeletor", 
	function(
		x,
		...
	){
			this<-x;
			if( !is.numeric(this$sizes) | !is.numeric(this$probs) ){
				warning("Deletion length distribution is not defined properly! Nothing to plot here!\n");
				return();
			}
			plot.default(	
				x=this$sizes,
				y=this$probs,
				col=c("blue"),
				lwd=2,
				type="h",
				main=paste("Deletion size distribution for:",this$id), 
				xlab="Size",
				ylab="Probability",
				ylim=c(0,1),
				xaxt="n"
			);
			axis(side=1, at=this$sizes, labels=this$sizes);
			return(invisible(this));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass DiscreteInsertor
# 
# @title "The DiscreteInsertor class"
# 
# \description{ 
#       This class implements a process which performs insertions with
#       lengths sampled from a user-specified discrete distribution.
#       See \code{GeneralInsertor} for how the insertion process works.
#
#       @classhierarchy
# }
#       
# @synopsis
#       
# \arguments{
#       \item{name}{The name of the object.}
#       \item{rate}{The general rate.}
#       \item{sizes}{The insertion sizes to propose.}
#       \item{probs}{A vector with the probabilites of the insertion sizes.}
#       \item{...}{Additional arguments.}
#       }
# 
# \section{Fields and Methods}{ 
#       @allmethods
# }
# 
# \examples{ 
#       # create a DiscreteInsertor process
#       i<-DiscreteInsertor(
#               name="Mii",
#               rate=0.25,
#               sizes=c(1,2),
#               probs=c(1/2,1/2)
#       )
#	# set template sequence
#	i$templateSeq<-NucleotideSequence(string="C")	
#       # get object summary
#       summary(i)
#       # set/get insertion sizes
#       i$sizes<-1:3
#	i$sizes
#       # set/get length probabilities
#       i$probs<-c(3,2,1)/6
#       i$probs
#       # plot length distribution
#       plot(i)
#       
#       # The following code illustrates how to use
#       # a DiscreteInsertor process in a simulation
#       
#       # create a sequence object and attach process i to it
#       s<-NucleotideSequence(string="AAAAAAAAAAGGGGAAAAAAAAAA",processes=list(list(i)))
#       # set the insertion tolerance to zero in range 11:15
#       # creating a region rejecting all insertions
#       setInsertionTolerance(s,i,0,11:15)       
#       # get insertion tolerances
#       getInsertionTolerance(s,i)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # simulate
#       Simulate(sim)
#       # print resulting alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
#       GeneralInsertor ContinuousInsertor GeneralInDel
# }
# 
#*/###########################################################################
setConstructorS3(
  "DiscreteInsertor",
  function( 
		name="Anonymous",
		rate=NA,
		sizes=NA,
		probs=NA,
		... 
		)	{

		this<-GeneralInsertor(
			 name=NA,
			 rate=rate,
			 propose.by=NA,
    	 accept.by=NA,
			 generate.by=NA,
			 ...
		);
    this<-extend(
      this,
      "DiscreteInsertor",
			.sizes=NA,
			.probs=NA
    );
		# Using virtual field to clear Id cache:
		this$name<-name;

		STATIC<-TRUE;
		if(!missing(sizes)) {
			this$sizes<-sizes;
			STATIC<-FALSE;
		}
		
		if(!missing(probs)) {
			this$probs<-probs;
			STATIC<-FALSE;
		}

		this$proposeBy<-function(process=NA,...){
			 if( !is.numeric(process$.sizes) | !is.numeric(process$.probs) ){
        throw("Cannot propose insert length because the length distribution is not defined properly!\n");
      }
			if(length(process$.sizes) == 1){
				return(process$.sizes[[1]]);
			} else {
				return(sample(x=process$.sizes,size=1,replace=FALSE,prob=process$.probs));
			}
		}

    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="DiscreteInsertor",
  function(
    this,
    ...
  ){

          wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

        if (is.numeric(this$sizes)) {
          this$sizes<-this$sizes;
        }
        else if (!is.na(this$sizes)){
          throw("Insertion size vector is invalid!\n");
        }

        if (is.numeric(this$probs)) {
          this$probs<-this$probs;
        }
        else if (!is.na(this$probs)){
          throw("Insertion size probability vector is invalid!\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: getSizes
##
###########################################################################/**
#
# @RdocMethod getSizes
# 
# @title "Get the sizes of the proposed insertions" 
# 
# \description{ 
#       @get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A DiscreteInsertor object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A vector of integers.
# } 
# 
# \examples{
#       # create a DiscreteInsertor object
#       i<-DiscreteInsertor(rate=1)
#       # set insertion sizes      
#       setSizes(i,c(1,2,3))
#       # get insertion sizes
#       getSizes(i)
#       # set/get sizes via virtual field
#       i$sizes<-1:10
#       i$sizes 
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSizes", 
	class="DiscreteInsertor", 
	function(
		this,
		...
	){

		this$.sizes;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSizes
##	
###########################################################################/**
#
# @RdocMethod setSizes
# 
# @title "Set the sizes of the proposed insertions" 
# 
# \description{ 
#       @get "title".
#       
#       The provided numeric vector is rounded.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A DiscreteInsertor object.} 
#       \item{value}{A numeric vector.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A vector of integers (invisible).
# } 
# 
# \examples{
#       # create a DiscreteInsertor object
#       i<-DiscreteInsertor(rate=1)
#       # set insertion sizes      
#       setSizes(i,c(1,2,3))
#       # get insertion sizes
#       getSizes(i)
#       # set/get sizes via virtual field
#       i$sizes<-1:10
#       i$sizes 
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSizes", 
	class="DiscreteInsertor", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} else if (!is.numeric(value)) {
			throw("The new value must be numeric vector!\n");
		} else {
			if(length(value) == 0 ) {
				warning("Deletion size vector has zero length!\n");
			}
			this$.sizes<-round(value);	
		}
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getProbs
##	
###########################################################################/**
#
# @RdocMethod getProbs
# 
# @title "Get the insertion length probabilities" 
# 
# \description{ 
#       @get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A DiscreteInsertor object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A numeric vector with the insertion length probabilities.
# } 
# 
# \examples{
#       # create a DiscreteInsertor object
#       i<-DiscreteInsertor(rate=1, sizes=1:3)
#       # set/get length probabilities
#       setProbs(i,c(1/3,1/3,1/3)) # equal probabilites
#       getProbs(i)
#       # set/get length probabilities via virtual field
#       x<-c(2,2,1)
#       # normalize x
#       x<-x/sum(x)
#       i$probs<-x
#       i$probs
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getProbs", 
	class="DiscreteInsertor", 
	function(
		this,
		...
	){

		this$.probs;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setProbs
##	
###########################################################################/**
#
# @RdocMethod setProbs
# 
# @title "Set the insertion length probabilities" 
# 
# \description{ 
#       @get "title".
#
#       The \code{sizes} virtual field must be set before setting the length probabilities.
#       The length of the provided numeric vector must match with the length of the vector
#       stored in the \code{sizes} virtual field. The vector is rescaled if the values do not
#       sum to one and a warning is issued.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A DiscreteInsertor object.} 
#       \item{value}{A numeric vector containg the length probabilities.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The vector of probabilities.
# } 
# 
# \examples{
#       # create a DiscreteInsertor object
#       i<-DiscreteInsertor(rate=1, sizes=1:3)
#       # set/get length probabilities
#       setProbs(i,c(1/3,1/3,1/3)) # equal probabilites
#       getProbs(i)
#       # set/get length probabilities via virtual field
#       x<-c(2,2,1)
#       # normalize x
#       x<-x/sum(x)
#       i$probs<-x
#       i$probs
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setProbs", 
	class="DiscreteInsertor", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);
		if (missing(value)) {
			throw("No new value provided!\n");
		} 
		else if(!is.numeric(this$.sizes)) {
			throw("Cannot set probabilities because insert sizes vector is not defined!\n");
		}
		else if (!is.numeric(value)) {
			throw("The new value must be a numeric vector!\n");
		}
		else if(length(value) != length(this$.sizes)) {
			throw("The length of the probabilities vector must be the same as the length of the insertion sizes vector");	
		} 
		else if( length(value[value < 0 ]) != 0 ) {
			throw("The elements of the probability vector must not be negative!\n");
		}
		else {
			if(!isTRUE(all.equal(sum(value),1.0))){
				value<-(value/sum(value));	
				warning("The provided values were rescaled in order to sum to one!\n");
		}
			this$.probs<-value;
		}
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: plot
##	
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Plot the insertion length distribution" 
# 
# \description{ 
#       @get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{x}{A DiscreteInsertor object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The DiscreteInsertor object (invisible).
# } 
# 
# \examples{
#       i<-DiscreteInsertor(
#               name="MyDiscIns",
#               sizes=1:6,
#               probs=c(0.25000000, 0.16666667, 0.08333333, 0.08333333, 0.16666667, 0.25000000)
#       )
#       # plot the insertion length distribution
#       plot(i)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"plot", 
	class="DiscreteInsertor", 
	function(
		x,
		...
	){
			this<-x;
			if( !is.numeric(this$sizes) | !is.numeric(this$probs) ){
				warning("Insertion length distribution is not defined properly! Nothing to plot here!\n");
				return();
			}
			plot.default(	
				x=this$sizes,
				y=this$probs,
				col=c("red"),
				lwd=2,
				type="h",
				main=paste("Insertion size distribution for:",this$id), 
				xlab="Size",
				ylab="Probability",
				ylim=c(0,1),
				xaxt="n"
			);
			axis(side=1, at=this$sizes, labels=this$sizes);
		
	},
	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<-DiscreteInsertor(rate=1,sizes=c(1,2),probs=c(1/2,1/2))
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="DiscreteInsertor",
  function(
    object,
    ...
  ){

    this<-object;
    .addSummaryNameId(this);

    expected.length<-NA;
    sd<-NA;
    if( is.numeric(this$sizes) & is.numeric(this$probs)) {
    expected.length<-weighted.mean(this$sizes, this$probs);

    sd<-sqrt(sum( (this$sizes - expected.length)^2 * this$probs ));
    }

    this$.summary$"Expected insertion length"<-expected.length;
    this$.summary$"Standard deviation of insertion length"<-format(sd);
    NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	

##
## ECMrest
##
##########################################################################/** 
#
# @RdocClass ECMrest
# 
# @title "The ECMrest empirical codon substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Kosiol C., Holmes I., Goldman, N. (2007) An empirical codon model for protein sequence evolution -
# Mol Biol Evol. 24(7):1464-79 DOI: 10.1093/molbev/msm064 \url{http://bit.ly/1ia8gWm}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-ECMrest()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-CodonSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	CodonSubst GeneralSubstitution CodonUNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "ECMrest",
  function(
		equ.dist=NA,
    		...
  ){

		this<-CodonSubst$newMatrix(
			name="ECMrest",
			paml.file="ECMrest.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);

##
## ECMunrest
##
##########################################################################/** 
#
# @RdocClass ECMunrest
# 
# @title "The ECMunrest empirical codon substitution model"
# 
# \description{ 
#
#
#	@classhierarchy
# }
#
# \references{
# Kosiol C., Holmes I., Goldman, N. (2007) An empirical codon model for protein sequence evolution -
# Mol Biol Evol. 24(7):1464-79 DOI: 10.1093/molbev/msm064 \url{http://bit.ly/1ia8gWm}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{equ.dist}{Equilibrium distribution.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution model object 
#	p<-ECMunrest()
#	# get object summary	
#	summary(p)
#	# display a bubble plot
#	plot(p)
#
#       # The following code demonstrates how to use 
#       # the process in a simulation.
#	
#	# create a sequence, attach process p
#	s<-CodonSequence(length=10,processes=list(list(p)) )
#	# sample states
#	sampleStates(s)
#       # make the first three positions invariable
#       setRateMultipliers(s,p,0,1:3)
#       # get rate multipliers
#       getRateMultipliers(s,p)
#       # create a simulation object
#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#       # run simulation
#       Simulate(sim)
#       # print alignment
#       sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	CodonSubst GeneralSubstitution CodonUNREST
# }
# 
#*/###########################################################################
setConstructorS3(
  "ECMunrest",
  function(
		equ.dist=NA,
    		...
  ){

		this<-CodonSubst$newMatrix(
			name="ECMunrest",
			paml.file="ECMunrest.dat",
			equ.dist=equ.dist
		);

		return(this);

  },
  enforceRCC=FALSE
);



##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass Event
# 
# @title "The Event class"
# 
# \description{ 
#	
#	This is the class representing an event. Event objects usually are generated by the \code{getEventsAtSite.*}
#	methods based on the state of attached Site object and the properties of the generating Process object.
#
#	The Perform method will refuse to modify target objects if the position field is not set. The Perform method can 
#	be called only once for any Event object.
#	
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the Event object. Often stores useful information.}
# 	\item{rate}{The rate of the event.}
# 	\item{site}{The associated Site object.}
# 	\item{position}{The position of associated Site object in the enclosing Sequence object (if any).}
#	\item{process}{The generator Process object.}
#	\item{handler}{The handler function for the Event object. It will be called by \code{Perform.Event} with the Event object as an argument to make the changes corresponding to the event.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# Note: the following examples are not very useful
#	# unless you want to implement your own process.
#
#	# create a Sequence object and a Process object
#	seq<-NucleotideSequence(string="A");
#	p<-Process(alphabet=NucleotideAlphabet())
#	# get the Site object from the Sequence object
#	s<-seq$sites[[1]]
#	# attach p to s
#	attachProcess(s,p)
#	# create an Event object
#	e<-Event(name="A->G",rate=0.1,site=s,process=p,position=1)
#	# get object summary
#	summary(e)
#	# get event name
#	e$name
#	# set/get event rate
#	e$rate<-0.2
#	e$rate
#	# get site
#	e$site
#	# set/get event handler
#	e$.handler<-function(this){this$.site$state<-"G"}
#	e$handler
#	# perform the event
#	Perform(e)
#	# check the state of the target site
#	s$state
# }
# 
# @author
#
# \seealso{ 
# 	Site Process Sequence getEventsAtSite.GeneralSubstitution
# }
# 
#*/###########################################################################
setConstructorS3(
	"Event",
	function( 
		name=NA,
		rate=NA,
		site=NA,
		position=NA,
		process=NA,
		handler=NA,
		... 
		){

		this<-extend(
			PSRoot(),
			"Event",
			.name="Anonymous",
			.rate=NA,
			.process=NA,
			.handler=NA,
			.site=NA,
			.position=NA,
			.write.protected=FALSE,
			.is.event=TRUE
		);

		STATIC<-TRUE;
						
		if(!missing(name)) {
			this$name<-name;
			STATIC<-FALSE;
		}
		
		if(!missing(rate)) {
			this$rate<-rate;
			STATIC<-FALSE;
		}	

		if(!missing(process)) {
			this$process<-process;
			STATIC<-FALSE;
		}	
		
		if(!missing(site)) {
			this$site<-site;
			STATIC<-FALSE;
		}	
		
		if(!missing(position)) {
			this$position<-position;
			STATIC<-FALSE;
		}	
		
		# The site object was passed through a getField method,
		# which disabled the virtual fields, so we have to enable them:
		if (!is.na(this$.site)){
				this$.site<-enableVirtual(this$.site);
		}
		this;
	},
	enforceRCC=TRUE
);

##
## Method: is.Event
##
###########################################################################/**
#
# @RdocDefault is.Event
# 
# @title "Check whether an object inherits from the class Event" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create some objects
#	e<-Event(); a<-Alphabet()
#	# check if they inherit from Event
#	is.Event(e)
#	is.Event(a)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "is.Event",
  class="default",
  function(
    this,
    ...
  ){

    if(!is.PSRoot(this)) {return(FALSE)}
   	if(!is.null(this$.is.event)){return(TRUE)}
    if ( inherits(this, "Event")) {
      this$.is.event<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getName
##	
###########################################################################/**
#
# @RdocMethod getName
# 
# @title "Get the name of an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create an Event object
#	e<-Event(name="MyEvent")
#	# get event name 
#	getName(e)
#	# get name via virtual field
#	e$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getName", 
	class="Event", 
	function(
		this,
		...
	){
		
		this$.name;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setName
##	
###########################################################################/**
#
# @RdocMethod setName
# 
# @title "Set the name of an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{new.name}{A character vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new name (invisible).
# } 
# 
# \examples{
#	# create an Event object
#	e<-Event()
#	# set event name
#	setName(e,"Insertion")
#	# get event name
#	e$name
#	# set name via virtual field
#	e$name<-"Deletion"
#	e$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setName", 
	class="Event", 
	function(
		this,
		new.name,
		...
	){
		.checkWriteProtection(this);	
		if(!exists(x="PSIM_FAST")){
		
		if(missing(new.name)){throw("No new name provided!\n")}
		new.name<-as.character(new.name);	
		if (new.name == "") {throw("Cannot set empty name!\n")}
		
		}
		this$.name<-new.name;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRate
##	
###########################################################################/**
#
# @RdocMethod getRate
# 
# @title "Get the rate of an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create an Event object
#	e<-Event(rate=0.1)
#	# get rate
#	getRate(e)
#	# get rate via virtual field
#	e$rate
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRate", 
	class="Event", 
	function(
		this,
		...
	){
		
		this$.rate;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRate
##	
###########################################################################/**
#
# @RdocMethod setRate
# 
# @title "Set the rate of an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{value}{The event rate.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the rate (invisible).
# } 
# 
# \examples{
#	# create an Event object
#	e<-Event(rate=0.1)
#	# set  a new rate
#	setRate(e,0.2)
#	# get rate via virtual field
#	e$rate
#	# set rate via virtual field
#	e$rate<-0.5
#	e$rate
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRate", 
	class="Event", 
	function(
		this,
		value,
		...
	){
	
		.checkWriteProtection(this);	
		if(!exists(x="PSIM_FAST")){
		
		if(missing(value)){throw("No new rate provided!\n")}
		else if (!is.numeric(value)){throw("The rate must be numeric!\n")}
		
		}
		this$.rate<-value;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getProcess
##	
###########################################################################/**
#
# @RdocMethod getProcess
# 
# @title "Get the Process object which generated an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Process object.
# } 
# 
# \examples{
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#	e<-s$sites[[1]]$events[[1]]
#	# get the generator process for e
#	e$process
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getProcess", 
	class="Event", 
	function(
		this,
		...
	){
		
		this$.process;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setProcess
##	
###########################################################################/**
#
# @RdocMethod setProcess
# 
# @title "Set the generator process for an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{new.proc}{A valid Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Process object.
# } 
# 
# \examples{
#	# create an Event object
#	e<-Event()
#	# set a generator process for e
#	setProcess(e,Process())
#	# get generator process
#	e$process
#	# set process via virtual field
#	e$process<-K80()
#	e$process
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setProcess", 
	class="Event", 
	function(
		this,
		new.proc,
		...
	){
		
		.checkWriteProtection(this);	
		if(!exists(x="PSIM_FAST")){
		
		if(missing(new.proc)){throw("No new rate provided!\n")}
		else if (!is.Process(new.proc)){throw("Process object invalid!\n")}
		
		}
		this$.process<-new.proc;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getHandler
##	
###########################################################################/**
#
# @RdocMethod getHandler
# 
# @title "Get the handler function of an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A function object.
# } 
# 
# \examples{
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#   # only Sequence methods set .position, 
#   # so s$sites[[1]]$events[[1]] wouldn't work.
#	e<-getEvents(s,1)[[1]]	
#	# het the handler of e
#	getHandler(e)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getHandler", 
	class="Event", 
	function(
		this,
		...
	){
		
		this$.handler;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setHandler
##	
###########################################################################/**
#
# @RdocMethod setHandler
#
# @title "Forbidden action: setting the handler function of an Event object"
#
# \description{
#       @get "title".
#	The handler function is tipically set by a \code{getEventsAtSite.*} method generating the Event object
#	by directly modifying the this$.handler field or by the \code{.setHandler()} method.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setHandler", 
	class="Event", 
	function(
		this,
		value,
		...
	){
		
		virtualAssignmentForbidden(this);
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSite
##	
###########################################################################/**
#
# @RdocMethod getSite
# 
# @title "Get the Site object associated with an Event object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Site object.
# } 
# 
# \examples{
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#	e<-s$sites[[1]]$events[[1]]
#	# get the site associated with e
#	getSite(e)
#	# get site via virtual field
#	e$site
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSite", 
	class="Event", 
	function(
		this,
		...
	){
		
		this$.site;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getPosition
##	
###########################################################################/**
#
# @RdocMethod getPosition
# 
# @title "Get the position of the Site object associated to an Event object in the enclosing Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#	e<-getEvents(s,1)[[1]]
#	# get the position of the site associated with e
#	getPosition(e)
#	# get position via virtual field
#	e$position
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getPosition", 
	class="Event", 
	function(
		this,
		...
	){
		
		this$.position;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setPosition	A function object.
##	
###########################################################################/**
#
# @RdocMethod setPosition
# 
# @title "Set the position of the Site object associated to an Event object" 
# 
# \description{ 
#	@get "title".
#	
#	The position field is usually not modified directly, but set by the \code{getEvents.Sequence} method. 
#	The position is *not* set by Site methods as \code{getEventsAtSite.Site}.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{value}{The position.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new position (invisible).
# } 
# 
# \examples{
#	# Note: the following example is not too useful	
#
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#	e<-getEvents(s,1)[[1]]
#	# get event position
#	e$position
#	# set the position of the site associated with e
#	setPosition(e,2)
#	# get position via virtual field
#	e$position
#	# set position via virtual field
#	e$position<-1
#	e$position
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setPosition", 
	class="Event", 
	function(
		this,
		value,
		...
	){

	if(!exists(x="PSIM_FAST")){
		if(is.na(this$.site)){
			throw("There is no associated Site object!\n");
		}	
		if(is.na(this$.site$.sequence)){
			throw("The site is not part of any sequence!\n");	
		}
		if(value > this$.site$.sequence$.length | value < 1) {
			throw("Invalid position!\n");
		}
	}
		this$.position<-value;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSite
##	
###########################################################################/**
#
# @RdocMethod setSite
# 
# @title "Assotiate an Event object with a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{new.site}{A valid Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new associated Site object (invisible).
# } 
# 
# \examples{
#	# create an Event object
#	e<-Event()
#	# create some Site objects
#	s1<-Site(alphabet=NucleotideAlphabet(),state="A")
#	s2<-clone(s1); s2$state<-"T"
#	# assotiate s1 with e
#	setSite(e,s1)
#	e$site
#	# assotiate s2 with e via virtual field
#	e$site<-s2
#	e$site
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSite", 
	class="Event", 
	function(
		this,
		new.site,
		...
	){
			
		.checkWriteProtection(this);	
	if(!exists(x="PSIM_FAST")){
		if (!is.Site(new.site)) {throw("Site object invalid!\n")}
		new.site<-enableVirtual(new.site);
		if(missing(new.site)) {throw("No site given")}

		else if (!is.na(this$process)){
				if (this$.process$.alphabet != new.site$.alphabet){
					throw("The site and process alphabets are incompatible!\n");
			}
		}
	}
		this$.site<-new.site;
		invisible(this$.site)
		
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: Perform
##	
###########################################################################/**
#
# @RdocMethod Perform
# 
# @title "Perform an event" 
# 
# \description{ 
#
#	Performing an event means that the modifications described by the Event object are actually made by calling
#	the event handler function as returned by \code{getHandler} with the Event object as the first argument.
#
#	The event won't be performed if the handler function is invalid, if there is no associated Site object, 
#	if the site position is undefined, if the rate is undefined, or if the generator process is invalid.
#
#	The handler function will be overwritten after performing an event, so the Perform method should be called
#	only once for every Event object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The value returned by the handler function.
# } 
# 
# \examples{
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#   #only Sequence methods set .position, 
#   #so s$sites[[1]]$events[[1]] wouldn't work.
#	e<-getEvents(s,1)[[1]]	
#	# perform e
#	Perform(e)
#	# check the effect of the event on s
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"Perform", 
	class="Event", 
	function(
		this,
		...
	){
	
	if(!exists(x="PSIM_FAST")){
		if(!is.function(this$.handler)){throw("Event handler is not a function!\n")}		
		else if (!is.Site(this$.site)){throw("The site associated with the event is not valid!\n")}
		else if(is.null(this$.position)){throw("The target site position is unknown!Refusing to perform event!\n")}
		else if (!is.Process(this$.process)) {
			throw("The event has no generator process. Refusing to perform!\n");
		}
		else if (is.na(this$.rate)) {
			throw("The event has no rate. Refusing to perform!\n");
		}
	}
			# Better not perform anything on a dirty object!
			if(this$.site$.sequence$.cumulative.rate.flag) {
				.recalculateCumulativeRates(this$.site$.sequence);
			}
			# Do NOT flag cumulative rate! The event should take care of that!

			# Flag site if we deal with substitutions:
			if( is.GeneralSubstitution( getProcess(this) ) ) {
				this$.site$.sequence$.flagged.sites<-c(this$.site$.sequence$.flagged.sites, this$.position);
			}

			# Call the event handler to perform event:
			output<-this$.handler(this);

			# Event will self-destruct to prevent trouble:
			
			if(!exists(x="PSIM_FAST")){
			
			this$.handler<-function(event=this) { throw("You can perform an event only once!\n") };
			}

			return(output);
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: .setHandler
##	
setMethodS3(
	".setHandler", 
	class="Event", 
	function(
		this,
		new.handler,
		...
	){
		if(!exists(x="PSIM_FAST")){
		if(missing(new.handler)){throw("No new handler provided!\n")}
		else if (!is.function(new.handler)){throw("The handler must be a function!\n")}
		}
		this$.handler<-new.handler;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getWriteProtected
##
###########################################################################/**
#
# @RdocMethod getWriteProtected
#  
# @title "Check if the object is write protected" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#
#       # create an object
#       o<-Event()
#       # toggle write protection
#       o$writeProtected<-TRUE
#       # check if it's write protected
#       getWriteProtected(o)
#       # check write protection via virtual field
#       o$writeProtected
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getWriteProtected",
  class="Event",
  function(
    this,
    ...
  ){

    this$.write.protected;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setWriteProtected
##
###########################################################################/**
#
# @RdocMethod setWriteProtected
#  
# @title "Set the write protection field for an object" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{value}{A logical vector of size one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or FALSE.
# } 
# 
# \examples{
#
#	# create an object
#	o<-Event()
#	# toggle write protection
#	setWriteProtected(o,TRUE)
#	# check write protection
#	o$writeProtected
#	# set write protection via virtual field
#	o$writeProtected<-FALSE
#	o$writeProtected
#	
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setWriteProtected",
  class="Event",
  function(
    this,
    value,
    ...
  ){

    if(!exists(x="PSIM_FAST")){
    	if(!is.logical(value)) {throw("The new value must be logical!\n")}
    }
    this$.write.protected<-value;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkWriteProtection
##
setMethodS3(
  ".checkWriteProtection",
  class="Event",
  function(
    this,
    value,
    ...
  ){

    if(exists(x="PSIM_FAST")){return(FALSE)}
    if(this$writeProtected) {throw("Cannot set value because the object is write protected!\n")}
    else {return(FALSE)}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## 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="Event",
  function(
    this,
    ...
  ){
		
		wp<-this$writeProtected;
		if(wp) {
			this$writeProtected<-FALSE;
		}

		may.fail<-function(this) {

			if (is.null(this$.name)){
				throw("Event name is NULL!\n");
			}
			else if (!is.na(this$.name))	{
				this$name<-this$name;
			}

			if (is.null(this$.rate)){
				throw("Event rate is NULL!\n");
			}
			else if (!is.na(this$.rate))	{
				this$rate<-this$rate;
			}


			if (is.null(this$.process)){
				throw("Event rate is NULL!\n");
			}
			else if (!is.na(this$.process))	{
				this$process<-this$process;
			}

			if (is.null(this$.site)){
				throw("Event site is NULL!\n");
			}
			else if (!is.na(this$.site))	{
				this$site<-this$site;
			}

		}
		tryCatch(may.fail(this), finally=this$writeProtected<-wp);

		return(invisible(TRUE))	

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: as.character.Event
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Get the character representation of an Event object" 
# 
# \description{ 
#	@get "title".
#
#	The character represenation of an Event object has the following format: 
#	"event name" ("event rate") <-- "generator process id", like \code{"A->T (0.333333333333333) <-- JC69:Anonymous:44780832"}.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{An Event object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a sequence and attach a process
#	s<-NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	# get the first active event from the first site
#	e<-s$sites[[1]]$events[[1]]
#	# get the character representation of e
#	as.character(e)
#	# or more simply
#	e
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="Event", 
	function(
		x,
		...
	){
		
		this<-x;
		procid<-NA;
		if(!is.na(this$.process)){
			procid<-this$.process$.id;
		}	
		paste(this$.name," (",this$.rate,")"," <-- ",procid,sep="");	
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: summary.Event
##	
###########################################################################/**
#
# @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
#       e<-Event()
#       # get a summary
#       summary(e)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="Event", 
	function(
		object,
		...
	){
		
		this<-object;	
		this$.summary$"Name"<-this$.name;	
		this$.summary$"Rate"<-this$.rate;	

		procid<-NA;
		if(!is.na(this$.process)){
			procid<-this$.process$id;
		}	
		this$.summary$"Generator process"<-procid;
		
		site.state<-NA;
		if(!is.na(this$.site)){
			site.state<-getState(this$.site);
		}	
		
		this$.summary$"Target site state"<-site.state;
		if(this$writeProtected) {
			this$.summary$"Write protected"<-TRUE;
		}
		
		NextMethod();		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass FastFieldDeletor
# 
# @title "The FastFieldDeletor class"
# 
# \description{ 
#	The \code{\link{DiscreteDeletor}} and \code{\link{ContinuousDeletor}} processes
#	generate deletion event objects with rates determined by the general rate of the 
#	process and the "rate.multiplier" parameter. The probability of rejecting an event
#	is determined by the product of the "deletion.tolerance" parameters from the affected sites.
#	If the majority of the sites have low deletion tolerance most of the events are rejected, which
#	slows down the simulation without performing much events. 
#
#	The \code{FastFieldDeletor} process scales down the rate and length distribution of the proposed 
#	events based on the highest insertion tolerance value observed in the root sequence 
#	(see the package vignette for details), thus making the simulation more efficient.
#
#	The available length distributions are (see also the package vignette):
#	\itemize{
#		\item Geometric (default) - \code{lengthParam1} is \emph{Lambda}.
#		\item Poisson+1 - \code{lengthParam1} is \emph{Lambda}.
#		\item Conway-Maxwell Poisson+1 - \code{lengthParam1} is \emph{Lambda}, \code{lengthParam2} is \emph{nu}
#		\item Negative Binomial+1 - \code{lengthParam1} is \emph{Lambda}, \code{lengthParam2} is \emph{r}
# 	}
#	
#	Insertion proceses can insert sites with deletion tolerance higher than the largest
#	deletion tolerance observed in the root sequence. The user can specify the largest expected 
#	tolerance value through the \code{toleranceMargin} virtual field. The process is then scaled by
#	max(initial_highest_tolerance, \code{toleranceMargin}).
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
# 	\item{type}{Type of the process (see above).}
# 	\item{length.param.1}{Object name.}
# 	\item{length.param.2}{Object name.}
# 	\item{tolerance.margin}{Object name.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a FastFieldDeletor object, default (geometric) type
#	# length.param.1 is "lambda"
#	p<-FastFieldDeletor(rate=1,length.param.1=0.9, tolerance.margin=0.8)
#	# get type
#	p$type
#	# get object summary
#	summary(p)
#	# set/get lambda	
#	p$lengthParam1<-0.8
#	p$lengthParam1
#	# set/get tolerance margin
#	p$toleranceMargin<-0.5
#	p$toleranceMargin
#	# create a nucleotide sequence, attach process
#	s<-NucleotideSequence(length=30,processes=list(list(p)))
#	# set state pattern
#	s$states<-c("A","A","T","T","G","G","C","C")
#	# sample deletion tolerances
#	setDeletionTolerance(s,p,sample(seq(from=0,to=0.8,by=0.01),30,replace=TRUE))
#	# plot deletion tolerance
#	plotParametersAtSites(s,p,"deletion.tolerance")
#	# simulate
#	sim<-PhyloSim(root.seq=s, phylo=rcoal(2))
#	Simulate(sim)
#	# show alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	@seeclass 
# }
# 
#*/###########################################################################
setConstructorS3(
  "FastFieldDeletor",
  function( 
		name="Anonymous",
		type="geometric",
		length.param.1=NA,	# mostly "Lambda"
		length.param.2=NA,	
		tolerance.margin=0,	# minimum tolerance value used for scaling.
		... 
	)	{

			# supported types
			ALLOWED.TYPES=c("geometric","poisson","neg.binomial","compoisson");

			# Creating a GeneralDeletor Process.
			this<-GeneralDeletor(
				...
			);

			# Check if the specified type is valid:
			if(length(intersect(ALLOWED.TYPES,type)) != 1){
				throw("The specified field model type is invalid!\n");
			}

			# Extending as FastFieldDeletor:
    	this<-extend(
      	this,
      	"FastFieldDeletor",
				.type=type, 		# field model flavour
				.tolerance.margin=NA,	# minimum tolerance used for scaling
				.tolerance.max=NA,	# maximum tolerance obseved at first call of 
							# getEventAtSites
				.d=NA,			 # is max(.tolerance.max, .tolerance.margin)
				.field.scaling.factor=NA,# the precalculated scaling factor
				.length.param.1=NA,	 # mostly "Lambda"
				.length.param.2=NA,	 
				.ALLOWED.TYPES=ALLOWED.TYPES # supported types
    	);

			# Set length parameter 1 if not missing:
			if(!missing(length.param.1)){
				this$lengthParam1<-length.param.1;
			}
		
			# Set length parameter 2 if not missing:
			if(!missing(length.param.2)){
				this$lengthParam2<-length.param.2;
			}

			# Set tolerance margin:
			setToleranceMargin(this, tolerance.margin);

			# Using virtual field to clear Id cache:
			this$name<-name;

			# Set the function proposing deletion lengths:
	  	this$proposeBy<-function(process=NA,seq=NA,pos=NA){

					# Check the length parameters:
					.checkLengthParams(this);				

					# Check if this$.d is defined:
					if(is.na(this$.d)){
						throw("thid$.d is NA! This shouldn't happen!");;
					}
					d<-this$.d;
	
					# Type specific length sampling expressions:

					# Geometric + 1:	
					if(this$.type == "geometric"){
						express<-expression(1 + rgeom(1,prob=( 1 - ( this$.length.param.1 * d) ) ) );
					}
				
					# Poisson+1:	
					else if(this$.type == "poisson"){
						express<-expression( 1 + rpois(1,lambda=(this$.length.param.1 * d) ) );
					}
					
					# Negative Binomial + 1:
					else if(this$.type == "neg.binomial"){
						express<-expression(1 + rnbinom(1,this$.length.param.2,prob=( 1 - ( this$.length.param.1 * d))) );
					}
					
					# Conway-Maxwell Poisson + 1:
					else if(this$.type == "compoisson"){
						express<-expression(1 + rcom(1,lambda=( this$.length.param.1 * d), nu = this$.length.param.2));
					}
					
					return( round( eval(express) ) );

			} # /proposeBy
		
			# Set the function performing the accept/reject step:
			this$acceptBy<-function(process=NA,sequence=NA,range=NA){

        del.tol<-c();
        for(site in sequence$.sites[range]){
            # Reject if the range contains a site which is not attached to 
            # the process:
            if(!isAttached(site, process)){
              return(FALSE);
            }
            del.tol<-c(del.tol, getParameterAtSite(process, site, "deletion.tolerance")$value);
        }

				# Calculate acceptance probability:			
        accept.prob<-( prod(as.numeric(del.tol)) / this$.d );

        # Accept/reject:
        return( sample(c(TRUE,FALSE),replace=FALSE,prob=c(accept.prob,(1-accept.prob)),size=1) );
    }

    return(this);

  },
  enforceRCC=TRUE
);

##	
## Method: .checkLengthParams
##	
setMethodS3(
  ".checkLengthParams",
  class="FastFieldDeletor",
  function(
    this,
    ...
  ){

					# Check length parameter 1:
					if(is.na(this$.length.param.1)){
						throw("Length parameter 1 is NA! Cannot generate events or propose lengths!\n");
					}
					# Check length parameter 2:
					if(length(intersect(c("neg.binomial","compoisson"),this$.type)) != 0) {
						if(is.na(this$.length.param.2)){
							throw("Length parameter 1 is NA! Cannot generate events or propose lengths!\n");
						}
					}

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## 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="FastFieldDeletor",
  function(
    this,
    ...
  ){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {
				
				# Check if the type is valid:
				if(length(intersect(this$.ALLOWED.TYPES, this$.type)) != 1){
					throw("The specified field model type is invalid!\n");
				}
				if((!is.numeric(this$.tolerance.margin) & !is.na(this$.tolerance.margin))){
					throw("Tolerance margin is invalid!\n");
				}
				if((!is.numeric(this$.tolerance.max) & !is.na(this$.tolerance.max))){
					throw(".tolerance.max is invalid!\n");
				}
				if((!is.numeric(this$.d) & !is.na(this$.d))){
					throw(".d is invalid!\n");
				} else if(!is.na(this$.tolerance.margin) & !is.na(this$.tolerance.max)) {
						if(this$.d != max(this$.tolerance.margin, this$.tolerance.max)){
							throw(".d is inconsistent!\n");
						}
				}
				if((!is.numeric(this$.field.scaling.factor) & !is.na(this$.field.scaling.factor))){
					throw(".field.scaling.factor is invalid!\n");
				}
				if((!is.numeric(this$.length.param.1) & !is.na(this$.length.param.1))){
					throw("Length parameter 1 is invalid!\n");
				}
				if((!is.numeric(this$.length.param.2) & !is.na(this$.length.param.2))){
					throw("Length parameter 2 is invalid!\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: summary.FastFieldDeletor
##	
###########################################################################/**
#
# @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<-FastFieldDeletor()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="FastFieldDeletor",
  function(
    object,
    ...
  ){

		this<-object;
		.addSummaryNameId(this);
		this$.summary$"Type"<-this$.type;
		this$.summary$"Tolerance margin"<-this$.tolerance.margin;
		this$.summary$"Length parameter 1"<-this$.length.param.1;
		this$.summary$"Length parameter 2"<-this$.length.param.2;
		this$.summary$"Scaling factor"<-this$.field.scaling.factor;
    NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: getEventsAtSite
##  
###########################################################################/**
#
# @RdocMethod getEventsAtSite
# 
# @title "Generate a deletion event object given the state of the target site" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A FastFieldDeletor object.} 
#       \item{target.site}{A Site object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Event objects.
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	GeneralDeletor getEventsAtSite.GeneralDeletor
# } 
# 
#*/###########################################################################
setMethodS3(
  "getEventsAtSite",
  class="FastFieldDeletor",
  function(
    this,
    target.site,
    ...
  ){

  if(!exists(x="PSIM_FAST")){
      if(missing(target.site)) {
         throw("No target site provided!\n");
      }
      if(!is.Site(target.site)) {
        throw("Target site invalid!\n");
      }
      else if(!is.function(this$.propose.by)) {
        throw("proposeBy is not set, cannot propose deletion!\n");
      }
      else if (!is.function(this$.accept.by)){
        throw("acceptBy is not set, cannot generate deletion event deletion!\n");
      }

      # Complain if sequence has a zero length:
      if(target.site$.sequence$.length == 0) {
       throw("Sequence has zero length so there is nothing to delete! How did you get here anyway?\n");
      }
    
    } 

     # Clone the event template object:
     deletion.event<-clone(this$.event.template);
     # Set the target position passed in a temporary field:
     deletion.event$.position<-target.site$.position;
     # Set the target site:
     deletion.event$.site<-target.site;
     # Set event name:
     deletion.event$.name<-"Deletion";
     # Set the generator process:
     deletion.event$.process<-this;

		 # Calculate the field model specific scaling factor if it is not yet calculated:
		 if(is.na(this$.field.scaling.factor)){
				this$.field.scaling.factor<-.getScalingFactor(this,process=this,seq=target.site$.sequence);
		 }

     # Event rate is the product of the general rate, the field model scaling factor and the 
     # site specific rate multiplier:
     deletion.event$.rate<-(this$.rate * (target.site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value) * this$.field.scaling.factor);

     # Set the handler for the deletion event:
     deletion.event$.handler<-this$.handler.template;

    # Return the event object in a list:
    list(deletion.event);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getType
##	
###########################################################################/**
#
# @RdocMethod getType
# 
# @title "Get the type of a FastFieldDeletor object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a FastFieldDeletor, default type (geometric)
#	p<-FastFieldDeletor()
#	# get type
#	getType(p)
#	# create a FastFieldDeletor, poisson type
#	p<-FastFieldDeletor(type="poisson")
#	p$type
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getType",
  class="FastFieldDeletor",
  function(
    this,
    ...
  ){

		this$.type;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setType
##	
###########################################################################/**
#
# @RdocMethod setType
#
# @title "Forbidden action: setting the type of a FastFieldDeletor object"
#
# \description{
#       @get "title".
#	
#	The type can be set only through the \code{type} constructor argument.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setType",
  class="FastFieldDeletor",
  function(
    this,
    value,
    ...
  ){

		throw("The type of the FastFieldDeletor process cannot be modified. Please set it by the constructor argument.");

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getLengthParam1
##	
###########################################################################/**
#
# @RdocMethod getLengthParam1
# 
# @title "Get the first length parameter" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a geometric FastFieldDeletor
#	p<-FastFieldDeletor()
#	# set/get the first length parameter
#	setLengthParam1(p,0.5)
#	getLengthParam1(p)
#	# set/get the first length parameter via virtual field
#	p$lengthParam1<-0.2
#	p$lengthParam1
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getLengthParam1",
  class="FastFieldDeletor",
  function(
    this,
    ...
  ){

		this$.length.param.1;
;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getLengthParam2
##	
###########################################################################/**
#
# @RdocMethod getLengthParam2
# 
# @title "Get the second length parameter" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a geometric FastFieldDeletor
#	p<-FastFieldDeletor()
#	# set/get the second length parameter
#	setLengthParam2(p,0.5)
#	getLengthParam2(p)
#	# set/get the second length parameter via virtual field
#	p$lengthParam2<-0.2
#	p$lengthParam2
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getLengthParam2",
  class="FastFieldDeletor",
  function(
    this,
    ...
  ){

		this$.length.param.2;
;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setLengthParam1
##	
###########################################################################/**
#
# @RdocMethod setLengthParam1
# 
# @title "Set the first length parameter" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{value}{A numeric vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible).
# } 
# 
# \examples{
#	# create a geometric FastFieldDeletor
#	p<-FastFieldDeletor()
#	# set/get the first length parameter
#	setLengthParam1(p,0.5)
#	getLengthParam1(p)
#	# set/get the first length parameter via virtual field
#	p$lengthParam1<-0.2
#	p$lengthParam1
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setLengthParam1",
  class="FastFieldDeletor",
  function(
    this,
		value,
    ...
  ){

		if(missing(value)){
			throw("No new length parameter value specified!\n");
		}	
		else if ((!is.numeric(value)) | (length(value) != 1 ) ) {
			throw("The new value must be a numeric vector of length 1!\n");
		}
		else {
			# First set the scaling factor to NA to force the recalculation:
			this$.field.scaling.factor<-NA;
			this$.length.param.1<-value;
		}
		return(invisible(value));


  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setLengthParam2
##	
###########################################################################/**
#
# @RdocMethod setLengthParam2
# 
# @title "Set the second length parameter" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{value}{A numeric vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible).
# } 
# 
# \examples{
#	# create a geometric FastFieldDeletor
#	p<-FastFieldDeletor()
#	# set/get the second length parameter
#	setLengthParam2(p,0.5)
#	getLengthParam2(p)
#	# set/get the second length parameter via virtual field
#	p$lengthParam2<-0.2
#	p$lengthParam2
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setLengthParam2",
  class="FastFieldDeletor",
  function(
    this,
    value,
    ...
  ){

		if(missing(value)){
			throw("No new length parameter value specified!\n");
		}	
		else if ((!is.numeric(value)) | (length(value) != 1 ) ) {
			throw("The new value must be a numeric vector of length 1!\n");
		}
		else {
			# First set the scaling factor to NA to force the recalculation:
			this$.field.scaling.factor<-NA;
			this$.length.param.2<-value;
		}
		return(invisible(value));


  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getToleranceMargin
##	
###########################################################################/**
#
# @RdocMethod getToleranceMargin
# 
# @title "Get the tolerance margin" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a geometric FastFieldDeletor
#	p<-FastFieldDeletor()
#	# set/get tolerance margin
#	setToleranceMargin(p,0.8)
#	getToleranceMargin(p)
#	# set/get tolerance margin via virtual field
#	p$toleranceMargin<-0.75
#	p$toleranceMargin
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getToleranceMargin",
  class="FastFieldDeletor",
  function(
    this,
    ...
  ){

		this$.tolerance.margin;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setToleranceMargin
##	
###########################################################################/**
#
# @RdocMethod setToleranceMargin
# 
# @title "Set the tolerance margin" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A FastFieldDeletor object.} 
# 	\item{value}{A numeric vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	value (invisible).
# } 
# 
# \examples{
#	# create a geometric FastFieldDeletor
#	p<-FastFieldDeletor()
#	# set/get tolerance margin
#	setToleranceMargin(p,0.8)
#	getToleranceMargin(p)
#	# set/get tolerance margin via virtual field
#	p$toleranceMargin<-0.75
#	p$toleranceMargin
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setToleranceMargin",
  class="FastFieldDeletor",
  function(
    this,
		value,
    ...
  ){

		if(missing(value)){
			throw("No new length parameter value specified!\n");
		}	
		else if ((!is.numeric(value)) | (length(value) != 1 ) ) {
			throw("The new value must be a numeric vector of length 1!\n");
		}
		else {
			# First set the scaling factor to NA to force the recalculation:
			this$.field.scaling.factor<-NA;
			this$.tolerance.margin<-value;
		}
		return(invisible(value));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .getScalingFactor
##	
setMethodS3(
  ".getScalingFactor",
  class="FastFieldDeletor",
  function(
    		this,
		process,
		seq,
    		...
  ){

		# Check if the length parameters needed for rate scaling are present:
		.checkLengthParams(this);				

		if(is.na(this$.tolerance.max)){

			# Get all deletion tolerance parameters for this process:					
			deletion.tolerance<-c();

			for(site in seq$.sites){
					if(isAttached(site, process)){
						deletion.tolerance<-c(deletion.tolerance, getParameterAtSite(process, site, id="deletion.tolerance")$value);
						}
					} # for site

			# Get the maximal tolerance value:
			this$.tolerance.max<-max(deletion.tolerance);

		}
		
		d<-max(this$.tolerance.max, this$.tolerance.margin);
		this$.d<-d;

		# The type specific rate scaling factors:		
		exp<-expression();

		# Geometric:
		if(this$.type=="geometric"){
			exp<-expression(d * (1 - this$.length.param.1) / (1 - (d * this$.length.param.1)) );
		}
	
		# Poisson+1:	
		else if(this$.type=="poisson"){
			exp<-expression(d * exp( - ( this$.length.param.1 * (1 - d ) ) ) );
		}

		# Negative Binomial + 1:
		else if(this$.type=="neg.binomial"){
			exp<-expression( d * ( ( (1 - this$.length.param.1) / (1 - (d * this$.length.param.1))) ^ this$.length.param.2) );
		}
	
		# Conway-Maxwell Poisson	+ 1:
		else if(this$.type=="compoisson"){
			exp<-expression( d * (com.compute.z(lambda=this$.length.param.1,nu=this$.length.param.2 ) / com.compute.z(lambda=(d * this$.length.param.1),nu=this$.length.param.2 )) );
		}
			
		return(eval(exp));	

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setParameterAtSite.FastFieldDeletor
##
setMethodS3(
  "setParameterAtSite",
  class="FastFieldDeletor",
  function(
    this,
    site,
    id,
    value,
    ...
  ){
			if(value < 0 | value > 1)	{
				throw("The field deletion model accepts deletion tolerance only from the [0,1] interval!\n");
			}
			NextMethod();
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass GeneralInDel
# 
# @title "The GeneralInDel class"
# 
# \description{ 
#
#	This is a class implementing the methods which are needed by both the 
#	GeneralInsertor and GeneralDeletor process.
#	
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
#	\item{rate}{The general rate of the object.}
#	\item{propose.by}{A function used to propose events.}
#	\item{accept.by}{A function used to accept/reject events.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a GeneralInDel object
#	# rejecting half of the events
#	# and proposing sizes in the range 1:10
#	o<-GeneralInDel(
#                   rate=1,
#                   propose.by=function(process){sample(1:10,1)},
#                   accept.by=function(){sample(c(TRUE,FALSE),1)}
#                   );
#	# check if inherits from GeneralInDel
#	is.GeneralInDel(o)
#	# check if it has undefined rates
#	hasUndefinedRate(o)
#	# get object summary
#	summary(o)
#	# set/get proposeBy function via virtual field
#	o$proposeBy<-function(process){return(3)}	# fixed event length
#	o$proposeBy
#	# set/get acceptBy function via virtual field
#	o$acceptBy<-function(){return(TRUE)}		# accept all events
#	o$acceptBy
#	# get/set general rate
#	o$rate
#	o$rate<-2	# double the rate
#	# propose event length
#	proposeLength(o)
# }
# 
# @author
#
# \seealso{ 
# 	Process GeneralInsertor GeneralDeletor GeneralSubstitution 
# }
# 
#*/###########################################################################
setConstructorS3(
  "GeneralInDel",
  function( 
		name="Anonymous", 
		rate=NA,
		propose.by=NA,
		accept.by=NA,
		... 
		)	{

		any.alphabet<-AnyAlphabet();
		this<-Process(
			alphabet=any.alphabet
		);
    this<-extend(
      			this,
      			"GeneralInDel",
			.rate=rate,
			.propose.by=NA,
			.accept.by=NA,
			.is.general.indel=TRUE
    );

		# Using virtual field to clear Id cache:
		this$name<-name;
		# setting propose.by
		if(!missing(propose.by) && is.function(propose.by)){
			this$proposeBy<-propose.by;
		}
		# setting accept.by
		if(!missing(accept.by) && is.function(accept.by)){
			this$acceptBy<-accept.by;
		}

    		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="GeneralInDel", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

        if (!is.na(this$rate)) {
          this$rate<-this$rate;
        }

				if(!is.function(this$proposeBy)){
					if(!is.na(this$proposeBy)){
						throw("proposeBy is invalid!\n");
					}
				}
				
				if(!is.function(this$acceptBy)){
					if(!is.na(this$acceptBy)){
						throw("acceptBy is invalid!\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: getRate
##	
###########################################################################/**
#
# @RdocMethod getRate
# 
# @title "Get the general rate" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	o<-GeneralInDel(rate=0.5)
#	# get/set general rate
#	getRate(o)
#	setRate(o, 1.5)
#	# get/set rate via virtual field
#	o$rate
#	o$rate<-0.3
#	o$rate
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRate", 
	class="GeneralInDel", 
	function(
		this,
		...
	){

		this$.rate;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: hasUndefinedRate
##	
###########################################################################/**
#
# @RdocMethod hasUndefinedRate
# 
# @title "Check whether the general rate of a GeneralInDel object is undefined" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	o<-GeneralInDel()
#	# check if the general rate is undefined
#	hasUndefinedRate(o)
#	# set general rate
#	o$rate<-1
#	# check rate again
#	hasUndefinedRate(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"hasUndefinedRate", 
	class="GeneralInDel", 
	function(
		this,
		...
	){

		return(is.na(this$.rate));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRate
##	
###########################################################################/**
#
# @RdocMethod setRate
# 
# @title "Set the general rate" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
#	\item{value}{The new general rate (a numeric vector of length one).}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new general rate.
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	o<-GeneralInDel(rate=0.5)
#	# get/set general rate
#	getRate(o)
#	setRate(o, 1.5)
#	# get/set rate via virtual field
#	o$rate
#	o$rate<-0.3
#	o$rate
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRate", 
	class="GeneralInDel", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)) {
			throw("No new value provided!\n");}
		else if(!is.numeric(value)) {
			throw("Rate must be numeric!\n");
		} 
	}	
		this$.rate<-value;
		return(this$.rate);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getProposeBy
##	
###########################################################################/**
#
# @RdocMethod getProposeBy
# \alias{getProposeBy.GeneralInsertor}
# 
# @title "Get the function used for proposing indel lengths" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A function object.
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	# proposing events with a constant length of 5
#	o<-GeneralInDel(rate=1, propose.by=function(process){return(5)});
#	# set/get the proposeBy function
#	setProposeBy(o,value=function(process){return(6)})
#	getProposeBy(o)
#	# set/get proposeBy function via virtual field
#	o$proposeBy<-function(process){return(3)}
#	o$proposeBy
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getProposeBy", 
	class="GeneralInDel", 
	function(
		this,
		...
	){

		this$.propose.by;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setProposeBy
##	
###########################################################################/**
#
# @RdocMethod setProposeBy
# \alias{setProposeBy.GeneralInsertor}
# 
# @title "Set the function used for proposing indel lengths" 
# 
# \description{ 
#	@get "title".
#
#	The function must return a numeric vector of length one. The function must have an
#	argument named "process" which will hold the calling process object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
#	\item{value}{A function object returning a numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The function object (invisible).
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	# proposing events with a constant length of 5
#	o<-GeneralInDel(rate=1, propose.by=function(process){return(5)});
#	# set/get the proposeBy function
#	setProposeBy(o,value=function(process){return(6)})
#	getProposeBy(o)
#	# set/get proposeBy function via virtual field
#	o$proposeBy<-function(process){return(3)}
#	o$proposeBy
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setProposeBy", 
	class="GeneralInDel", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)) {
				throw("No new value provided!\n");	
		}
		else if(!is.function(value)){
			 throw("The value of proposeBy must be a function.!\n");	
		}
	}
		this$.propose.by<-value;
		return(invisible(this$.propose.by));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAcceptBy
##	
###########################################################################/**
#
# @RdocMethod getAcceptBy
# \alias{getAcceptBy.GeneralInsertor}
# 
# @title "Get the function used for accepting/rejecting indel events" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A function object.
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	# rejecting half of the events
#	o<-GeneralInDel(
#                   rate=1,
#                   propose.by=function(process){return(5)},
#                   accept.by=function( ){sample(c(TRUE,FALSE),1)}
#                   );
#	# set/get the acceptBy function
#	setAcceptBy(o,value=function(){return(FALSE)})	# reject all events
#	getAcceptBy(o)
#	# set/get acceptBy function via virtual field
#	o$acceptBy<-function(){return(TRUE)}		# accept all events
#	o$acceptBy
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAcceptBy", 
	class="GeneralInDel", 
	function(
		this,
		...
	){

		this$.accept.by;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAcceptBy
##	
###########################################################################/**
#
# @RdocMethod setAcceptBy
# \alias{setAcceptBy.GeneralInsertor}
# 
# @title "Set the function used for accepting/rejecting indel events" 
# 
# \description{ 
#	@get "title".
#
#	The function object must have the following arguments: process (the caller process), sequence (the target sequence), 
#	window (a vector containing the positions affecting acceptance).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
#	\item{value}{A function object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The function object (invisible).
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	# rejecting half of the events
#	o<-GeneralInDel(
#                   rate=1, 
#                   propose.by=function(process){return(5)},
#                   accept.by=function( ){sample(c(TRUE,FALSE),1)}
#                   );
#	# set/get the acceptBy function
#	setAcceptBy(o,value=function( ){return(FALSE)})	# reject all events
#	getAcceptBy(o)
#	# set/get acceptBy function via virtual field
#	o$acceptBy<-function(){return(TRUE)}		# accept all events
#	o$acceptBy
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAcceptBy", 
	class="GeneralInDel", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)) {
				throw("No new value provided!\n");	
		}
		else if(!is.function(value)){
			 throw("The value of acceptBy must be a function.!\n");	
		}
	}
		this$.accept.by<-value;
		return(invisible(this$.accept.by));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: proposeLength
##	
###########################################################################/**
#
# @RdocMethod proposeLength
# 
# @title "Propose indel length" 
# 
# \description{ 
#	@get "title".
#
#	This method simply calls the function returned by the \code{getProposeBy} method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInDel object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one (the indel length).
# } 
# 
# \examples{
#	# create a GeneralInDel object
#	# proposing event lengths in the range 1:10
#	o<-GeneralInDel(rate=1, propose.by=function(process){sample(c(1:10),1)});
#	# propose indel length
#	proposeLength(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"proposeLength", 
	class="GeneralInDel", 
	function(
		this,
		...
	){

		return( this$.propose.by(this));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: is.GeneralIndel
##	
###########################################################################/**
# @RdocDefault is.GeneralInDel
# 
# @title "Check if an object inherits from the GeneralInDel class" 
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#		\item{this}{An object.}
#		\item{...}{Not used.}
#
# } 
# 
# \value{ 
#	TRUE or FALSE.
# } 
#
# \examples{
#	# create some objects
#	o<-GeneralInDel(rate=1, propose.by=function(process){sample(c(1:10),1)});
#	x<-GTR()
#	# check if they inherit from GeneralInDel
#	is.GeneralInDel(o)
#	is.GeneralInDel(x)
# } 
# 
# 
# @author 
# 
#*/###########################################################################
setMethodS3(
	"is.GeneralInDel", 
	class="default", 
	function(
		this,
		...
	){

    if(!is.PSRoot(this)) {return(FALSE)}
    if(!is.null(this$.is.general.indel)){return(TRUE)}
    if ( inherits(this, "GeneralInDel")) {
      this$.is.general.indel<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }


	},
	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<-GeneralInDel(rate=1,propose.by=function(process){sample(c(1,2,3),1)})
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="GeneralInDel", 
	function(
		object,
		...
	){
	
		.addSummaryNameId(object);
		object$.summary$"General rate"<-object$rate;
		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

###########################################################################
# Class:GeneralInsertor
##########################################################################/** 
#
# @RdocClass GeneralInsertor
# 
# @title "The GeneralInsertor class"
# 
# \description{ 
#
#	This is a class implementing a process generating insertion events.
#	The rate of each event is calculated as the product of the general rate of the process 
#       and the "rate.multiplier" site-process specific parameter.
#	The simulation code calls the \code{Perform} method on the selected insertion event objects,
#	which call their insertion event handler to perform the insertion.
#
#	The insert lengths are proposed by the function stored in the \code{proposeBy} 
#	virtual field. The function must have the following arguments:
#	process (the insertion process object).
#
#	The insertion events are accepted or rejected by the function stored in the \code{acceptBy} virtual field.
#	The function must have the following arguments: process (the insertion process object), sequence (the target sequence object), 
#	window (a vector of positions affecting acceptance).
#	The probability of accepting an insertion is calculated as the product of the site-process-specific 
#	"insertion.tolerance" parameters of the sites neighboring the insertion. 
#	The number of sites considered is determined by the \code{acceptWin} virtual field.
#
#	The insert is generated by the \code{generateInsert} method by calling the function stored in the \code{generateBy} virtual field.
#	The default generator function truncates/duplicates the sequence object stored in the \code{templateSeq} virtual field to get a sequence
#	having the sampled length. After constructing the Sequence object, it  calls the \code{sampleStates.Sequence} method on the resulting object. 
#	That means that if we start with a template sequence which has NA states, but has a substitution process attached, then the resulting sequence
#       will be different every time.
#
#	Before inserting the sequence returned by \code{generateInsert}, the handler function will pass the object through the function stored in the
#	\code{insertHook} virtual field. This allows to perform arbitrary modifications on the inserted Sequence object.
#
#	The sequence is inserted randomly on the left or the right of the target position.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
#	\item{rate}{The general rate of the object (no default).}
#       \item{propose.by}{A function used to propose events (no default).}
#       \item{accept.by}{A function used to accept/reject events (no default).}
#	\item{template.seq}{A Sequence object used as a template for generating insertions (no default).}
#	\item{insert.hook}{A function object, see \code{setInsertHook} (no default).}
#	\item{accept.win}{A window of sites affecting the acceptance of insert events.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		name="GIN",
#		rate=1,
#		propose.by=function(process){4}, # fixed insert length
#		acceptBy=function(process,sequence,window){TRUE},# always accept insertions
#		template.seq=NucleotideSequence(string="A"),# a boring template sequence
#		insert.hook=function(seq){ return(seq)},# a boring insert hook
#		accept.win=2 #4 sites affecting acceptance
#	)
#	i
#	# check if object inherits from GeneralInsertor
#	is.GeneralInsertor(i)
#	# get object summary
#	summary(i)
#	# set/get general rate
#	i$rate<-0.5
#	i$rate
#	# set/get name
#	i$name<-"Ins"
#	i$name
#	# set/get proposeBy
#	# sample insertion length between 1 and 10
#	i$proposeBy<-function(process){sample(1:10,1)}
#	i$proposeBy
#	# set/get acceptBy
#	# reject half of the insertions
#	i$acceptBy<-function(process, sequence, window){ sample(c(TRUE,FALSE), 1) }
#	i$acceptBy
#	# get generateBy
#	i$generateBy
#	# set/get acceptWin
#	i$acceptWin<-1;
#	# set/get insert hook
#	i$insertHook<-function(
#                           seq, 
#                           target.seq,
#                           event.pos,
#                           insert.pos
#                           ){ attachProcess(seq, GTR() );seq} 
#	i$insertHook
#	# set/get template sequence
#	i$templateSeq<-NucleotideSequence(
#                                       length=5,
#                                       processes=list(list(JC69()))
#                                   ) # length: 5, states: NA
#	i$templateSeq
#	# generate an insert sequence
#	generateInsert(i)
#	# create a sequence object and attach the process i
#	s<-NucleotideSequence(string="AAAAA",processes=list(list(i)))
#       # set rate multiplier
#       setRateMultipliers(s,i,2)
#       # get the list of active events from site 2
#       events<-getEventsAtSite(i,s$sites[[2]])
#       events
#       # set postition for event
#       e<-events[[1]]
#       e$.position<-2  
#       # print sequence
#       s
#       # perform event
#       Perform(e)
#       # check sequence again
#       s
# }
# 
# @author
#
# \seealso{ 
# 	GeneralInDel DiscreteInsertor ContinuousInsertor BrownianInsertor
# }
# 
#*/###########################################################################
setConstructorS3(
  "GeneralInsertor",
  function( 
		name="Anonymous", 
		rate=NA,
		propose.by=NA,
		accept.by=NA,
		template.seq=NA,
		insert.hook=NA,
		accept.win=NA,
		... 
		)	{

		this<-GeneralInDel(
			rate=rate,
			propose.by=propose.by,
			accept.by=accept.by
		);

    this<-extend(
      this,
      "GeneralInsertor",
			.generate.by=NA,
			.handler.template=NA,
			.template.seq=NA,
			.insert.hook=NA,
			.accept.win=1,
			.is.general.insertor=TRUE
    );
		# Using virtual field to clear Id cache:
		this$name<-name;

		# Adding insertion tolerance parameter.
    .addSiteSpecificParameter(
      this,
      id="insertion.tolerance",
      name="Insertion tolerance parameter",
      value=as.double(1), # Accept all by default
      type="numeric"
    );
	
		if(!missing(template.seq)){
			this$templateSeq<-template.seq;
		}

		this$acceptBy<-function(process=NA,sequence=NA,range=NA){
			
				accept.prob<-c();
				for(site in sequence$.sites[range]){
						# Discard the site if the process is not attached to it:
						if(!isAttached(site, process)){
							next();
						}
						else {
							accept.prob<-c(accept.prob, getParameterAtSite(process, site, "insertion.tolerance")$value);
						}
				}
				accept.prob<-prod(as.numeric(accept.prob));


			  # Accept/reject:
				return( sample(c(TRUE,FALSE),replace=FALSE,prob=c(accept.prob,(1-accept.prob)),size=1) );
		}

	###	

	 this$generateBy<-function(process=NA,length=NA,target.seq=NA,event.pos=NA,insert.pos=NA){

		if(!exists(x="PSIM_FAST")){	
			if(is.na(length) | (length(length) == 0) | length == 0){
				throw("Invalid insert length!\n");
			}	
			else if(is.na(process$.template.seq)){
				throw("Cannot generate insert without template sequence!\n");
			}
		}

			times<-( ceiling( length/this$.template.seq$.length) );
			to.delete<-( ( (this$.template.seq$.length) * times) - length);

			tmp<-clone(this$.template.seq);
		
			if( (times-1) > 0){
				for(i in 1:(times-1)){
					insertSequence(tmp,process$.template.seq,tmp$length);
				}
			}

			if(to.delete > 0){
				deleteSubSequence(tmp,(tmp$length - to.delete + 1):tmp$length);
			}
			return(tmp);
				
	 }

	if(!missing(insert.hook)){
		this$insertHook<-insert.hook;
	}

	###	
	 this$.handler.template<-function(event=NA) {

				if(!is.na(event)){

					 WINDOW.SIZE<-this$.accept.win;
					 # Using temporary varibales for clarity:
					 position<-event$.position;
					 process<-event$.process;
					 sequence<-event$.site$.sequence;
					 details<-list();
					 details$type<-"insertion";

					 # Propose the direction:
					 direction<-sample(c("LEFT","RIGHT"),replace=FALSE,size=1);

					 # Set insertion tolerance window:
					 window<-integer();
					 insert.pos<-position;
					 if(direction == "LEFT") {
							window<-(position-WINDOW.SIZE):position;
					 		insert.pos<-(position-1);
					 }
					 else if (direction == "RIGHT"){
							window<-position:(position+WINDOW.SIZE);
					 }
					 else {
						throw("You should never see this message!\n");
					}

					details$position<-insert.pos;
					details$accepted<-FALSE;

					# Discard illegal positions:
					window<-window[ window > 0 & window <= sequence$.length];
				  if(process$.accept.by(process=process,sequence,window)){
							details$accepted<-TRUE;
							insert<-generateInsert(process,target.seq=sequence,event.pos=position,insert.pos=insert.pos);
							details$length<-insert$length;
							# Call the insert hook:
							if(is.function(this$.insert.hook)){
								insert<-this$.insert.hook(seq=insert,target.seq=sequence,event.pos=position,insert.pos=insert.pos);
							}
							insertSequence(sequence,insert, insert.pos,process=process);
					}
					return(details);
					
				}
		 }
		###

    return(this);
  },
  enforceRCC=TRUE
);

##	
## Method: is.GeneralInsertor
##	
###########################################################################/**
#
# @RdocDefault is.GeneralInsertor
# 
# @title "Check whether an object inherits from GeneralInsertor" 
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#		\item{this}{An object.}
#		\item{...}{Not used.}
#
# } 
# 
# \value{ 
#	TRUE or FALSE.
# } 
#
# \examples{
#	# create some objects
#	d<-GeneralDeletor()
#	i<-GeneralInsertor()
#	# check if they inherit from GeneralInsertor
#	is.GeneralInsertor(i)
#	is.GeneralInsertor(d)
# }
# 
# @author 
# 
#*/###########################################################################
setMethodS3(
	"is.GeneralInsertor", 
	class="default", 
	function(
		this,
		...
	){

    if(!is.PSRoot(this)) {return(FALSE)}
    if(!is.null(this$.is.general.insertor)){return(TRUE)}
    if ( inherits(this, "GeneralInsertor")) {
      this$.is.general.insertor<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## 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="GeneralInsertor", 
	function(
		this,
		...
	){

		      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {

        if (!is.na(this$templateSeq)) {
          this$templateSeq<-this$templateSeq;
        }

        if(!is.function(this$generateBy)){
          if(!is.na(this$generateBy)){
            throw("generateBy is invalid!\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: getEventsAtSite
##	
###########################################################################/**
#
# @RdocMethod	getEventsAtSite
# 
# @title "Generate insertion event object given the state of the target site" 
# 
# \description{ 
#	@get "title".
#	
#	This method generates a list with one insertion event. The rate of the 
#	event is calculated as the product of the general rate of the process 
#	and the "rate.multiplier" site-process specific parameter. An empty list is
#	returned if the rate is zero or NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
# 	\item{target.site}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Event objects.
# } 
# 
# \examples{
#	# create a sequence object
#	s<-NucleotideSequence(string="AAAA")
#	# create a GeneralInsertor process, provide template sequence.
#	# propsed insert lengths:3, always accept.
#	i<-GeneralInsertor(
#		rate=0.5,
#		template.seq=NucleotideSequence(string="GGG"),
#		propose.by=function(process){3},
#		accept.by=function(process,sequence,window){TRUE}
#	)
#	# attach process to site
#	s$processes<-list(list(i));
#	# set rate multiplier
#	setRateMultipliers(s,i,2)
#	# get the list of active events from site 2
#	events<-getEventsAtSite(i,s$sites[[2]])
#	events
#	# set postition for event
#	e<-events[[1]]
#	e$.position<-2	
#	# print sequence
#	s
#	# perform event
#	Perform(e)
#	# check sequence again
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	GeneralInsertor GeneralInDel Process Event
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventsAtSite", 
	class="GeneralInsertor", 
	function(
		this,
		target.site,
		...
	){

	if(!exists(x="PSIM_FAST")){
		if(missing(target.site)) {
			throw("No target site provided!\n");
		}
		if(!is.Site(target.site)) {
			throw("Target site invalid!\n");
		}
		else if(!is.function(this$.propose.by)) {
			throw("proposeBy is not set, cannot propose insertion!\n");
		} 
		else if (!is.function(this$.accept.by)){
			throw("acceptBy is not set, cannot generate insertion event!\n");
		}
	}

		# Just return an empty list if the rate is undefined or zero:
		if( is.na(this$.rate) | this$.rate == 0) {
			return(list());
		}

		 # Clone the event template object:
		 insertion.event<-clone(this$.event.template);
		 # Set the target position passed in a temporary field:
		 insertion.event$.position<-target.site$.position;
		 # Set the target site:
		 insertion.event$.site<-target.site;
		 # Set event name:
		 insertion.event$.name<-"Insertion";
		 # Set the generator process:
		 insertion.event$.process<-this;
		
		 # Event rate is the product of the general rate and the 
		 # site specific rate multiplier:
		 rate.multiplier<-target.site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value;
		 if(rate.multiplier == 0 ) {
			return(list());
		 }
		 insertion.event$.rate<-(this$.rate * rate.multiplier );

		 # Set the handler for the insertion event:
		 insertion.event$.handler<-this$.handler.template;

		# Return the event object in a list:
		list(insertion.event);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: generateInsert
##	
###########################################################################/**
#
# @RdocMethod generateInsert
# 
# @title "Generate an insert" 
# 
# \description{ 
#	@get "title".
#
#	This method uses the function stgored in the \code{proposeBy} virtual field to
#	sample the insert length and then calls the function stored in the \code{generateBy}
#	field to generate the insert. 	
#
#	The default \code{generateBy} function set by the GeneralInsertor constructor truncates/repeats
#	the template sequence stored in the \code{templateSeq} field to have the sequence with the right size
#	and then calls the \code{sampleStates} method on the resulting object. That means that if we start with a
#	template sequence which has NA states, but has a substitution process attached, then the resulting sequence
#	will be different every time the \code{generateInsert} method is called.
#
#	The \code{generateBy}, \code{proposeBy} and \code{templateSeq} fields must be set in order to use this method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
#	\item{length}{Generate an insert with the specified length if this argument is present.}
#	\item{target.seq}{The Sequence object targeted by the insertion (optional). This argument is passed to the \code{generateBy} method.}
#	\item{event.pos}{The position of the site proposing the insertion (optional). This argument is passed to the \code{generateBy} method.}
#	\item{insert.pos}{The position of the insertion in the target sequence (optional). This argument is passed to the \code{generateBy} method.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Sequence object.
# } 
# 
# \examples{
#	# build the template sequence
#	ts<-NucleotideSequence(length = 10,processes=list(list(JC69())));
#	# fix some site states
#	setStates(ts,"A",c(1,2));
#	setStates(ts,"T",c(5,6));
#	setStates(ts,"C",c(9,10));
#	# print template sequence
#	ts
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		template.seq=ts,
#		propose.by=function(process){sample(c(5:50),1)}, # inserts between 5 and 50
#	)
#	# generate some inserts
#	generateInsert(i)
#	generateInsert(i)
#	generateInsert(i)
#	generateInsert(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"generateInsert", 
	class="GeneralInsertor", 
	function(
		this,
		length=NA,
		target.seq=NA,
		event.pos=NA,
		insert.pos=NA,
		...
	){

		if(missing(length)){
			length<-this$.propose.by(process=this);
		}
		insert<-this$.generate.by(process=this,length=length,target.seq=target.seq,event.pos=event.pos,insert.pos=insert.pos);
		sampleStates(insert);	
		return(insert);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getGenerateBy
##	
###########################################################################/**
#
# @RdocMethod getGenerateBy
# 
# @title "Get the function object used for generating inserts" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A function object.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		propose.by=function(process){sample(c(5:10),1)}, # inserts between 5 and 10
#		template.seq=NucleotideSequence(string="AAAAAAA")
#	)
#
#	# save insert generator
#	old.gen<-getGenerateBy(i)
#	# set a new insert generator
#	i$generateBy<-function(
#                           process,
#                           length, 
#                           target.seq,
#                           event.pos,
#                           insert.pos
#                        ){ 
#                           return(NucleotideSequence(string="AATTGGCC"))
#                           }
#	# get the generator function
#	i$generateBy
#	# generate insert
#	generateInsert(i)
#	# restore old generator
#	i$generateBy<-old.gen
#	# generate insert
#	generateInsert(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getGenerateBy", 
	class="GeneralInsertor", 
	function(
		this,
		...
	){

		this$.generate.by;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setGenerateBy
##
###########################################################################/**
#
# @RdocMethod setGenerateBy
# 
# @title "Set the function object used for generating inserts" 
# 
# \description{ 
#	@get "title".
#	The provided function must return a Sequence object whne called and must have the
#	following arguments: process, length, target.seq, event.pos, insert.pos (see \code{generateInsert.GeneralInsertor}).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
#	\item{value}{A function object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The function object.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		propose.by=function(process){sample(c(5:10),1)}, # inserts between 5 and 10
#		template.seq=NucleotideSequence(string="AAAAAAA")
#	)
#
#	# save insert generator
#	old.gen<-getGenerateBy(i)
#	# set a new insert generator
#	i$generateBy<-function(
#                           process,
#                           length,
#                           target.seq,
#                           event.pos,
#                           insert.pos){ 
#                   return(NucleotideSequence(string="AATTGGCC"))
#                   }
#	# get the generator function
#	i$generateBy
#	# generate insert
#	generateInsert(i)
#	# restore old generator
#	i$generateBy<-old.gen
#	# generate insert
#	generateInsert(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setGenerateBy", 
	class="GeneralInsertor", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)) {
				throw("No new value provided!\n");	
		}
		else if(!is.function(value)){
			 throw("The value of generateBy must be a function.!\n");	
		}
	}
		this$.generate.by<-value;
		return(this$.generate.by);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getTemplateSeq
##	
###########################################################################/**
#
# @RdocMethod getTemplateSeq
# 
# @title "Get the template sequence object" 
# 
# \description{ 
#	@get "title".
#	The template sequence object is used by the default \code{generateBy} function
#	to generate insert sequences.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Sequence object or NA.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		propose.by=function(process){sample(c(5:10),1)}, # inserts between 5 and 10
#		template.seq=NucleotideSequence(string="AAAAAAA")
#	)
#	# get template sequence
#	getTemplateSeq(i)
#	# get template sequence via virtual field
#	i$templateSeq
#	# set template sequence
#	setTemplateSeq(i, NucleotideSequence(string="C"));
#	# generate insert
#	generateInsert(i)
#	# set template sequence via virtual field
#	i$templateSeq<-NucleotideSequence(string="G")
#	# generate insert
#	generateInsert(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getTemplateSeq", 
	class="GeneralInsertor", 
	function(
		this,
		...
	){

		this$.template.seq;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setTemplateSeq
##	
###########################################################################/**
#
# @RdocMethod setTemplateSeq
# 
# @title "Set the template sequence object" 
# 
# \description{ 
#	@get "title".
#	The template sequence object is used by the default \code{generateBy} function
#	to generate insert sequences.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
#	\item{value}{A Sequence object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		propose.by=function(process){sample(c(5:10),1)}, # inserts between 5 and 10
#		template.seq=NucleotideSequence(string="AAAAAAA")
#	)
#	# get template sequence
#	getTemplateSeq(i)
#	# get template sequence via virtual field
#	i$templateSeq
#	# set template sequence
#	setTemplateSeq(i, NucleotideSequence(string="C"));
#	# generate insert
#	generateInsert(i)
#	# set template sequence via virtual field
#	i$templateSeq<-NucleotideSequence(string="G")
#	# generate insert
#	generateInsert(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setTemplateSeq", 
	class="GeneralInsertor", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)) {
				throw("No new template sequence provided!\n");	
		}
		else if(!is.Sequence(value)){
			 throw("Sequence object is invalid!\n");	
		}
		else if(value$length == 0) {
			throw("Cannot set template sequence of length zero!\n");
		}
	}
		this$.template.seq<-clone(value);
		for (site in this$.template.seq$.sites){
			site$.ancestral<-this;
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAcceptWin
##	
###########################################################################/**
#
# @RdocMethod getAcceptWin
# 
# @title "Get the size of the acceptance window" 
# 
# \description{ 
#	@get "title"
#
#	This parameter determines the number of sites neighbouring the position (from left and right) of the insertion considered when accepting/rejecting 
#	a proposed insertion. The "insertion.tolerance" parameter is retrived from sites falling in the window specified by this parameter.
#	The default value is 1, so the two neighbouring sites are considered by default.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(rate=0.5);
#	# get acceptance window size
#	getAcceptWin(i)
#	# get acceptance window size via virtual field
#	i$acceptWin
#	# set acceptance window size
#	setAcceptWin(i,2)
#	# set acceptance window size via virtual field
#	i$acceptWin<-3
#	i$acceptWin
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAcceptWin", 
	class="GeneralInsertor", 
	function(
		this,
		...
	){

		this$.accept.win;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAcceptWin
##	
###########################################################################/**
#
# @RdocMethod setAcceptWin
# 
# @title "Set the size of the acceptance window" 
# 
# \description{ 
#	@get "title"
#
#	This parameter determines the number of sites neighbouring the position (from left and right) of the insertion considered when accepting/rejecting 
#	a proposed insertion. The "insertion.tolerance" parameter is retrived from sites falling in the window specified by this parameter.
#	The default value is 1, so the two neighbouring sites are considered by default.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
#	\item{value}{An integer vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(rate=0.5);
#	# get acceptance window size
#	getAcceptWin(i)
#	# get acceptance window size via virtual field
#	i$acceptWin
#	# set acceptance window size
#	setAcceptWin(i,2)
#	# set acceptance window size via virtual field
#	i$acceptWin<-3
#	i$acceptWin
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAcceptWin", 
	class="GeneralInsertor", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)){
			throw("No new value provided");
		}
		else if(!all(is.numeric(value)) | (length(value) != 1)){
			throw("The new value must be a numeric vector of length one.");
		}
	}
		this$.accept.win<-floor(value);
		return(this$.accept.win);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getInsertHook
##	
###########################################################################/**
#
# @RdocMethod getInsertHook
# 
# @title "Get the insert hook function" 
# 
# \description{ 
#	@get "title".
#
#	The insert hook allows to make various modifications on the insert before performing the insertion.
#
#	The insert hook function is called by the insertion event handler function. The insert hook takes the 
#	sequence generated by the \code{generateInsert} method throught the "seq" argument. The function
#	must return a Sequnece object, which will be inserted in the target sequence.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A function object.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		propose.by=function(process){sample(c(5:10),1)}, # inserts between 5 and 10
#		template.seq=NucleotideSequence(length=5,processes=list(list(JC69())))
#	)
#	# set a dummy insert hook
#	setInsertHook(i,function(seq){return(seq)})
#	# set a new insert hook via virtual field
#	i$insertHook<-function(seq){
#		seq$processes<-list(list(GTR())) # replace the subsitution process
#		return(seq)
#	}
#	# get the insert hook via virtual field
#	i$insertHook
#	# get the insert hook
#	getInsertHook(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getInsertHook", 
	class="GeneralInsertor", 
	function(
		this,
		...
	){

		this$.insert.hook;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setInsertHook
##	
###########################################################################/**
#
# @RdocMethod setInsertHook
# 
# @title "Set the insert hook function" 
# 
# \description{ 
#	@get "title".
#
#	The insert hook allows to make various modifications on the insert before performing the insertion.
#	The function must have the following arguments: seq (the sequence object to insert), target.seq (the target Sequence object), 
#	event.pos (the position of the site which generated the insertion event), insert.pos (the position of the insertion).
#
#	The insert hook function is called by the insertion event handler function. The insert hook takes the 
#	sequence generated by the \code{generateInsert} method throught the "seq" argument. The function
#	must return a Sequnece object, which will be inserted in the target sequence.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralInsertor object.} 
# 	\item{value}{A function object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The function object.
# } 
# 
# \examples{
#	# create a GeneralInsertor object
#	i<-GeneralInsertor(
#		rate=0.5,
#		propose.by=function(process){sample(c(5:10),1)}, # inserts between 5 and 10
#		template.seq=NucleotideSequence(length=5,processes=list(list(JC69())))
#	)
#	# set a dummy insert hook
#	setInsertHook(i,function(seq){return(seq)})
#	# set a new insert hook via virtual field
#	i$insertHook<-function(seq){
#		seq$processes<-list(list(GTR())) # replace the subsitution process
#		return(seq)
#	}
#	# get the insert hook via virtual field
#	i$insertHook
#	# get the insert hook
#	getInsertHook(i)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setInsertHook", 
	class="GeneralInsertor", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
		if(!is.Sequence(this$.template.seq)){
			throw("Cannot set insert hook because the template sequence is not defined!\n");
		}
		if(missing(value)) {
				throw("No new value provided!\n");	
		}
		else if(!is.function(value)){
			 throw("The insert hook must be a function.!\n");	
		}
		else if( length(intersect(names(formals(value)), "seq")) == 0 ){
      throw("The insert hook function must have a an argument named \"seq\"");
		}
		else if(!is.Sequence(value(generateInsert(this,length=1)))){
			throw("The insert hook function must return a Sequence object!\n");	
		} else {
			this$.insert.hook<-value;
		}
		return(this$.insert.hook);

	},
	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<-GeneralInsertor(rate=1)
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="GeneralInsertor", 
	function(
		object,
		...
	){

		.addSummaryNameId(object);
		object$.summary$"Accept window size"<-object$.accept.win;
		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
###########################################################################
# Class:GeneralDeletor
##########################################################################/** 
#
# @RdocClass GeneralDeletor
# 
# @title "The GeneralDeletor class"
# 
# \description{ 
#	This is the class implementing a process generating deletion events.
#	The rates of the deletion events are calculated as the product of the general rate
#	of the process and the "rate.multiplier" site-process-specific parameter.
#
#	The simulation code calls the \code{Perform} method on the selected 
#	deletion event objects,	which call their handler function to perform the deletion.
#
#	The deletion lengths are proposed by the function stored in the \code{proposeBy} virtual field.
#	The function must have the following arguments: process (the process object), sequence (the target sequence), 
#	position (the position of the site which generated the event).
#
#	The deletion randomly affects the sites from the left or from the right of the target position (but never both).
#	Positions which are out of range are discarded.
#
#	The proposed deletions are accepted or rejected by the function stored in the \code{acceptBy} virtual field.
#	The function must have the following arguments: process (the deletion prcoess), sequence (the target sequence), range (a vector of positions
#	affected by the deletion).
#
#	The probability of accepting a deletion is calculated as the product of the "deletion.tolerance" site-process-specific 
#	parameters from the sites affected by the deletion event.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
#	\item{rate}{The general rate of the object.}
#	\item{propose.by}{A function used to propose events.}
#	\item{accept.by}{A function used to accept/reject events.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
# 	# create a GeneralDeletor object
#       # proposed deletion length: 4, always accept
#       d<-GeneralDeletor(
#                       name = "DEL",
#                       rate = 1,
#                       propose.by=function(process, sequence, position){ 4 },
#                       accept.by=function(process, sequence, range){ TRUE }
#       )
#	d
#	# check if object inherits from GeneralDeletor
#	is.GeneralDeletor(d)
#	# get object summary
#	summary(d)
#	# set/get name
#	d$name<-"Del Bosque"
#	d$name
#	# set/get rate
#	d$rate<-0.5
#	d$rate
#	# set/get proposeBy
#	# propose deletion lengths between 3 and 6
#	d$proposeBy<-function(process, sequence, position){ sample(3:6,1) }
#	d$proposeBy
#	# set/get acceptBy
#   # reject half of the events
#	d$acceptBy<-function(process, sequence, range){ sample(c(TRUE, FALSE), 1)} 
#	d$acceptBy
#	# create a sequence object, attach process
#	s<-NucleotideSequence(string="AATTGGCCCCGGTTAA", processes=list(list(d)))
#	# set the rate multiplier
#       setRateMultipliers(s,d,2)
#       # get the list of active events at site 6
#       events<-getEventsAtSite(d,s$sites[[6]])
#       events;
#       # print sequence 
#       s
#       # set the position for the event object
#       e<-events[[1]];
#       e$.position<-6;
#       # perform the deletion event
#       Perform(e)
#       # check the results
#       s
# }
# 
# @author
#
# \seealso{ 
# 	GeneralInDel DiscreteDeletor ContinuousDeletor FastFieldDeletor
# }
# 
#*/###########################################################################
setConstructorS3(
  "GeneralDeletor",
  function( 
		name="Anonymous", 
		rate=NA,
		propose.by=NA,
		accept.by=NA,
		... 
		)	{

		this<-GeneralInDel(
			rate=rate,
			propose.by=propose.by,
			accept.by=accept.by
		);

    this<-extend(
      this,
      "GeneralDeletor",
			.handler.template=NA,
			.is.general.deletor=TRUE
    );
		# Using virtual field to clear Id cache:
		this$name<-name;

		# Adding insertion tolerance parameter.
    .addSiteSpecificParameter(
      this,
      id="deletion.tolerance",
      name="Deletion tolerance parameter",
      value=as.double(1), # Accept all by default
      type="numeric"
    );

		this$acceptBy<-function(process=NA,sequence=NA,range=NA){

				accept.prob<-c();
				for(site in sequence$.sites[range]){
						# Reject if the range contains a site which is not attached to 
						# the process:
						if(!isAttached(site, process)){
							return(FALSE);
						}
						accept.prob<-c(accept.prob, getParameterAtSite(process, site, "deletion.tolerance")$value);
				}

				# Calculate the product of the per-site 
				# acceptance probabilities.
				accept.prob<-prod(as.numeric(accept.prob));

			  # Accept/reject:
				return( sample(c(TRUE,FALSE),replace=FALSE,prob=c(accept.prob,(1-accept.prob)),size=1) );
		}
		
	 this$.handler.template<-function(event=NA) {

				if(!is.na(event)){

					 # Using temporary varibales for clarity:
					 position<-event$.position;
					 process<-event$.process;
					 sequence<-event$.site$.sequence;
					 details<-list();
					 details$type<-"deletion";
					 details$accepted<-FALSE;

					 # Propose a sequence length:
					 length<-process$.propose.by(process=process,seq=sequence, pos=position);

					 # Propose the direction:
					 direction<-sample(c("LEFT","RIGHT"),replace=FALSE,size=1);

					 # Calculate the sites to delete:
					 range<-numeric();	
					 if(direction == "RIGHT") {
							range<-position:(position+length-1);
					 } else if(direction == "LEFT") {
						  range<-(position-length+1):position;
					 } else {
							throw("You should never see this message!\n");
					 }

					 # Discard potential negative values and values larger than the sequence length:
					 range<-range[ range > 0 & range <= sequence$.length];
					 details$range<-c(min(range),max(range));
					 
					 # Perform the deletion if it is accepted:
					 if (process$.accept.by(process=process,sequence=sequence,range=range) == TRUE) {
						details$accepted<-TRUE;
					 	deleteSubSequence(sequence,range);
					}					
			
					# Return event details:	
					return(details);

				}
		 }

    return(this);
  },
  enforceRCC=TRUE
);

##	
## Method: is.GeneralDeletor
##	
###########################################################################/**
#
# @RdocDefault is.GeneralDeletor
# 
# @title "Check whether an object inherits from GeneralDeletor" 
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#		\item{this}{An object.}
#		\item{...}{Not used.}
#
# } 
# 
# \value{ 
#	TRUE or FALSE.
# } 
#
# \examples{
#	# create some objects
#	d<-GeneralDeletor()
#	i<-GeneralInsertor()
#	# check if they inherit from GeneralDeletor
#	is.GeneralDeletor(d)
#	is.GeneralDeletor(i)
# } 
# 
# 
# @author 
# 
#*/###########################################################################
setMethodS3(
	"is.GeneralDeletor", 
	class="default", 
	function(
		this,
		...
	){

    if(!is.PSRoot(this)) {return(FALSE)}
    if(!is.null(this$.is.general.deletor)){return(TRUE)}
    if ( inherits(this, "GeneralDeletor")) {
      this$.is.general.deletor<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## 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="GeneralDeletor",
  function(
    this,
    ...
  ){
      NextMethod();

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: getEventsAtSite
##	
###########################################################################/**
#
# @RdocMethod getEventsAtSite
# 
# @title "Title" 
# 
# \description{ 
#	@get "title".
#
#	This method generates a list containing a single deletion event object. The rate
#	of the event is calculated as the product of the general rate of the process and the 
#	"rate.multiplier" site-process specific parameter. An empty list is
#       returned if the rate is zero or NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralDeletor object.} 
#	\item{target.site}{The target Site object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of event objects.
# } 
# 
# \examples{
#	# create the Sequence object
#	s<-NucleotideSequence(string="ATGCCCGGCGGATTTATTA");
#	# create a GeneralDeletor object
#	# proposed deletion length: 4, always accept
#	d<-GeneralDeletor(
#			name = "Del Bosque",
#			rate = 0.5,
#			propose.by=function(process, sequence, position){ 4 },
#			accept.by=function(process, sequence, range){ TRUE }
# 	)
#	# attach process to site
#	attachProcess(s,d);
#	# set the rate multiplier
#	setRateMultipliers(s,d,2)
#	# get the list of active events at site 6
#	events<-getEventsAtSite(d,s$sites[[6]])
#	events;
#	# print sequence 
#	s
#	# set the position for the event object
#	e<-events[[1]];
#	e$.position<-6;
#	# perform the deletion event
#	Perform(e)
#	# check the results
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventsAtSite", 
	class="GeneralDeletor", 
	function(
		this,
		target.site,
		...
	){
		if(!exists(x="PSIM_FAST")){
			if(missing(target.site)) {
				throw("No target site provided!\n");
			}
			if(!is.Site(target.site)) {
				throw("Target site invalid!\n");
			}
			else if(!is.function(this$.propose.by)) {
				throw("proposeBy is not set, cannot propose deletion!\n");
			} 
			else if (!is.function(this$.accept.by)){
				throw("acceptBy is not set, cannot generate deletion event deletion!\n");
			}

		 	# Complain if sequence has a zero length:
		 	if(target.site$.sequence$.length == 0) {
				 throw("Sequence has zero length so there is nothing to delete! How did you get here anyway?\n");
		 	}

		}
		 # Clone the event template object:
		 deletion.event<-clone(this$.event.template);
		 # Set the target position passed in a temporary field:
		 deletion.event$.position<-target.site$.position;
		 # Set the target site:
		 deletion.event$.site<-target.site;
		 # Set event name:
		 deletion.event$.name<-"Deletion";
		 # Set the genrator process:
		 deletion.event$.process<-this;
		
		
		 # Event rate is the product of the general rate and the 
		 # site specific rate multiplier:
	         rate.multiplier<-target.site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value; 
		 deletion.event$.rate<-(this$.rate * rate.multiplier);

		 # Set the handler for the deletion event:
		 deletion.event$.handler<-this$.handler.template;		

		# Return the event object in a list:
		list(deletion.event);

	},
	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<-GeneralDeletor(rate=1,name="Del Bosque")
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="GeneralDeletor", 
	function(
		object,
		...
	){

		.addSummaryNameId(object);
		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass GeneralSubstitution
# 
# @title "The GeneralSubstitution class"
# 
# \description{ 
#	This a class representing a continuous-time Markov process acting
#	on the state space defined by the symbols stored in the Alphabet object
#	passed to the object constructor. 
#
#	The GeneralSubstitution objects generate
#	Event objects corresponding to substitution events based on the state of the 
#	attached Site objects.
#
#	The GeneralSubstitution objects aggregate a QMatrix object, which stores the 
#	unscaled and scaled rate matrices. The scaled rate matrices, along with the
#	site-process specific rate multiplier parameters define the rates of the generated
#	Event objects.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
#	\item{alphabet}{The alphabet on which the process acts (Alphabet object).}
#	\item{rate.list}{A list with the substitution rates. It will be passed to \code{setRateList} method.}
#	\item{equ.dist}{The equilibrium distribution (see \code{setEquDist.GeneralSubstitution}).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# Create a GeneralSubstitution object
#	# also provide an Alphabet objects 
#	# and the list of unscaled rates
#	a<-BinaryAlphabet()
#	gs<-GeneralSubstitution(
#			name="MyBinarySubst",
#			alphabet=a,
#			rate.list=list("0->1"=2,"1->0"=1)
#		)
#	# check if inherits from GeneralSubstitution
#	is.GeneralSubstitution(gs)
#	# get an object summary
#	summary(gs)
#	# get a bubble plot
#	plot(gs)
#	# get unscaled rate for "0->1" by event name
#	getRate(gs,"0->1")
#	# get unscaled rate for "0->1" by states
#	getRate(gs,from="0", to="1")
#	# get scaled rate for "0->1" by name
#	getEventRate(gs,"0->1")
#	# get the list of unscaled event rates
#	gs$rateList
#	# set the \emph{unscaled} rates
#	gs$rateList<-list("0->1"=1,"1->0"=1)
#	# reset equilibrium distribution
#	gs$equDist<- 5 * gs$equDist
#	# get the equilibrium distribution
#	gs$equDist
#	# sample a state form the equilibrium distribution
#	sampleState(gs)
#	# get the associated QMatrix object
#	gs$qMatrix
#	# create a site object
#	s<-Site(alphabet=a, state="0")
#	# attach gs to s
#	s$processes<-list(gs)
#	# set rate multiplier for s and gs
#	setParameterAtSite(gs,s,id="rate.multiplier",value=2)
#	# get site specific rate for "0->1"
#	getEventsAtSite(gs,s,"0->1")
#	# get the list of active event objects given the state of s
#	getEventsAtSite(gs,s)
#	# get the associated Alphabet object 
#	gs$alphabet
#	# clone the object
#	gsc<-clone(gs)
#	# modify the alphabet of gsc
#	gsc$alphabet<-NucleotideAlphabet()
#	summary(gsc)
#	# check if gsc has undefined rates
#	hasUndefinedRate(gsc)
# }
# 
# @author
#
# \seealso{ 
# 	Process QMatrix Event Site GeneralIndel GTR WAG
# }
# 
#*/###########################################################################
setConstructorS3(
  "GeneralSubstitution",
  function( 
		name="Anonymous", 
		alphabet=NA,
		rate.list=NA,	
		equ.dist=NA,
		... 
		)	{

	
		# Set an empty alphabet by default
		# to satisfy the static instance:
		if(missing(alphabet)){
			alphabet<-Alphabet(name="Undefined");
		}

		this<-Process(
			name=name,
			alphabet=alphabet
		);
    		this<-extend(
      			this,
      			"GeneralSubstitution",
			.q.matrix=NA,
			.equ.dist=NA,
			.handler.template=NA,
			.is.general.substitution=TRUE
    		);

		# Initialize with NA-s equDist:
		if (missing(equ.dist)){
			.initEquDist(this);
		} else {
			# or set if we have one:
			this$equDist<-equ.dist;
		}

		# Create the QMatrix object:
		qm<-QMatrix(name=name, alphabet=alphabet);
	
		# Set the rates:	
		if(!missing(rate.list)){
			qm$rateList<-rate.list;
		}
		
		# Attach the QMatrix to the process:
		this$.q.matrix<-qm;
		this$.q.matrix$process<-this;

		# Try to guess the equlibrium distribution:
		if (missing(equ.dist) & !missing(rate.list)){
			if(.setEquDistFromGuess(this)){
				# and perfrom rescaling if suceeded:
				rescaleQMatrix(this);
			}
		}

		# Using virtual field to clear Id cache:
		this$name<-name;

		# Set the template for handling substitution events:
		this$.handler.template<-function(event=NA){
				# Just set the new state base on the event name:
				setState(event$.site, strsplit(event$.name,split="->",fixed=TRUE)[[1]][[2]]);
				# The name *should* be valid and correct, so no more checking is needed.

				# Return details:
				return(
					list(
						type="substitution",
                        accepted=TRUE
					)
				);	
		}	

    		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="GeneralSubstitution", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {
			
			# The process must have a valid alphabet object:	
			if(!is.Alphabet(this$.alphabet)){
				throw("Alphabet object is invalid!\n");
			}
		
			# Name:
			if(!is.na(this$name)){
				this$name<-this$name;
			}
		
			# EquDist:
			if(!any(is.na(this$.equ.dist))){
				this$equDist<-this$equDist;
			}
			# Negative rates are impossible:
			if(all(!is.na(this$rateList)) & any(as.numeric(this$rateList) < 0 )){
				throw("The rate matrix has negative off-diagonal elements!\n");	
			}
			
			# QMatrix should never be NA!
			this$QMatrix<-this$QMatrix;
		
			# Further checks if survived the one above:
			checkConsistency(this$.q.matrix,check.process=FALSE);

			if(is.Process(this$.q.matrix$.process)){
              		# Check for alphabet compatibility:
              		if(this$.alphabet != this$.q.matrix$.process$alphabet){
                		throw("Process/QMatrix alphabet mismatch!\n");
              		}
              		# Check if the parent process QMatrix is this object:
              		if(!equals(this$.q.matrix$.process, this) ){
                		throw("QMatrix process is not identical with self!\n");
              		}
			} else if(!is.na(this$.q.matrix$.process)){
					throw("QMatrix process entry is invalid!\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: getEventsAtSite
##	
###########################################################################/**
#
# @RdocMethod	getEventsAtSite
# 
# @title "Generate the list of active Event objects for a given attached Site object" 
# 
# \description{ 
#	@get "title".
#	
#	This is the single most important method in the \code{GeneralSubstitution} class. It generates a list of the active
#	Event objects given the transition rate matrix (Q matrix) and the "rate.multiplier" Site-Process specific parameter.
#	It returns an empty list if the state of the site is "NA".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{target.site}{A Site object. The GeneralSubstitution object must be attached to the Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of the active Event objects.
# } 
# 
# \examples{
#	# create an Alphabet object
#	a<-BinaryAlphabet()
#	# create a Site object
#	s<-Site(alphabet=a);
#	# create a GeneralSubstitution object
#	p<-GeneralSubstitution(alphabet=a,rate.list=list("0->1"=1,"1->0"=1))
#	# attach process p to site object s
#	attachProcess(s,p)	
#	# get the rate of active events
#	getEventsAtSite(p,s)	# empty list
#	# set the state of s
#	s$state<-1;
#	# get the rate of active events
#	getEventsAtSite(p,s)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventsAtSite", 
	class="GeneralSubstitution", 
	function(
		this,
		target.site,
		...
	){

	# The main method of this class,
	# generating a list of event objects given the 
	# state of the target site.
	if(!exists(x="PSIM_FAST")){
	
	if(missing(target.site)) {
      		throw("No target site provided!\n");
    	} 
	
	}
	
	# The following code is commented out to
	# increase speed
		
	#else if (!sloppy) {
	# Additional checks. They can be
	# disabled by sloppy=TRUE			

      	#if(!is.Site(target.site)) {
      	#  throw("Target site invalid!\n");
      	#}
	#else if(!is.QMatrix(this$.q.matrix)){
	#	throw("Cannot provide event objects because the rate matrix is not set!\n");	
	#}
	#else if(!is.numeric(this$.equ.dist)){
	#	throw("Cannot provide event objects because the equilibrium frequencies are not defined!\n");	
	#} 
	#} 

	state<-as.character(target.site$.state);
	# Just return an empty list if the state is NA:
	if(is.na(state)){
		return(list());
	}
	
	# The rate of the event is the product of the general rate and the
     	# site specific rate multiplier:
     	rate.multiplier<-target.site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value;
		
	# Return empty list if the rate multiplier is zero.
     	if(rate.multiplier == 0 ) {
      		return(list());
     	}	
	
	# Get rate matrix:
	rate.matrix<-this$.q.matrix$.rate.matrix;

	symbols<-this$.alphabet$.symbols;
	rest<-symbols[ which(symbols != state) ];

	# Create the event objects:
	events<-list();
	for(new.state in rest){
		
		name<-paste(state,new.state,sep="->");
	 	# Clone the event template object:
     		event<-clone(this$.event.template);
     		# Set event name:
     		event$.name<-name;
     		# Set the generator process:
     		event$.process<-this;
     		# Set the target position passed in a temporary field,
		# Event objects are not aware of their posiitions in general!
     		event$.position<-target.site$.position;
     		# Set the target site:
     		event$.site<-target.site;
			
		# Set the event rate:	
		event$.rate<-(rate.multiplier * (rate.matrix[state,new.state]));
		# Set the handler for the substitution event:
     		event$.handler<-this$.handler.template;
		
		# Add to events list:	
		events<-c(events, list(event));

	}

	return(events);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setEquDist
##
###########################################################################/**
#
# @RdocMethod setEquDist
# \alias{setEquDist.AminoAcidSubst}
#
# @title "Set the equilibrium distribution for a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	In the case the equlibrium distribution cannot be guessed from the rate matrix one should provide
#	a valid equilibrium distribution. The equilibrium distribution must be compatible with the rate matrix.
#	The provided numeric vector will be resacled in the case the sum of the elemnts is not one.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{value}{A numeric vector containing the equlibrium symbol frequencies. The order of the frequencies must be the same as in the symbol vector of the attached Alphabet object.}
#	\item{force}{Do not check compatibility with thr rate matrix.}
#	\item{silent}{Do not print out warnings.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new equlibrium distribution (invisible).
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(
#                           alphabet=BinaryAlphabet(),
#                           rate.list=list("1->0"=1,"0->1"=1)
#                           )
#	# get equlibrium distribution 
#	getEquDist(p)
#	# get equilibrium distribution via virtual field
#	p$equDist
#	# re-set the equilibrium distribution
#	dist<-p$equDist * 3
#	dist
#	setEquDist(p,dist)
#	p$equDist
#	# re-set equilibrium distribution via virtual field
#	p$equDist<-p$equDist * 2
#	p$equDist
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setEquDist",
  class="GeneralSubstitution",
  function(
    this,
    value,
    force=FALSE,
    silent=FALSE,
    ...
  ){

    .checkWriteProtection(this);
if(!exists(x="PSIM_FAST")){

    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");
    }
}
    if(length(value) != this$alphabet$size){
      throw("The new value must be a vector of length ",this$alphabet$size,"!\n");
    }
    if(!PSRoot$my.all.equal(sum(value), 1.0)) {
				value<-(value/sum(value));
				if (silent == FALSE){
					warning("The provided probabilities have been rescaled in order to sum to one!\n");
				}
    }

if(!exists(x="PSIM_FAST")){
	# Check if the provided equlibrium distribution is
	# compatible with the rate matrix:
	if( !.checkEquMatCompat(this, rbind(value)) & force==FALSE){
				throw("The provided equlibrium distribution: ",paste(value,collapse=" ")," is not compatible with the rate matrix! Use force=TRUE to set it anyway!\n");
	}
}
	# Set the value:
      this$.equ.dist<-rbind(value);
			# Set dimnames:
      colnames(this$.equ.dist)<-(this$alphabet$symbols);
      rownames(this$.equ.dist)<-c("Prob:");
 	return(invisible(this$.equ.dist));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: .setEquDistFromGuess
##
setMethodS3(
  ".setEquDistFromGuess",
  class="GeneralSubstitution",
  function(
    this,
    ...
  ){
			
	# Try to guess equlibrium distribution:
	tmp<-.guessEquDist(this);
	# Take care with the condition here!
	# We can get in trouble with any()
	# if the first value is zero!
	if( length(tmp) == 1 & all(tmp == FALSE) ){
		warning("The equlibrium distribution of the substitution process could not be determined based on the rate matrix!\n You have to set yourself the proper distribution in order to use the process!");
		return(FALSE);
	}
	else {
		this$equDist<-tmp;
		return(TRUE);
	}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkEquMatCompat
##
setMethodS3(
  ".checkEquMatCompat",
  class="GeneralSubstitution",
  function(
    this,
    value,
    ...
  ){

    if(missing(value)) {
      throw("No equlibrium distribution provided!\n")
		}
		else if ( length(value) != dim(this$.q.matrix$.orig.matrix)[[2]] ){
				throw("Value vector length should be",dim(this$.q.matrix$.orig.matrix)[[2]],"!\n");	
		}
		else {
			# The following matrix product of the equlibrium distribution
			# and the rate matrix should give the zero vector:
			tmp<-(rbind(value) %*% as.matrix(this$.q.matrix$.orig.matrix));
			if(PSRoot$my.all.equal(tmp, rep(0.0, times=length(tmp))) ){
				return(invisible(TRUE));
			} else {
				return(FALSE);
			}
		}


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .guessEquDist
##	
setMethodS3(
	".guessEquDist", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){

		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot guess equilibrium distribution because the Q matrix is not set!\n");
		}
		
		# Refuse to guess if the rate matrix has zero entries:
		if(length(which(this$.q.matrix$.orig.matrix == 0)) != 0 ){
			warning("Cannot guess equilibrium distribution because the rate matrix has zero entries!\n");
			return(FALSE);
		}

		# Get the left eigenvalues and eigenvectors of the rate matrix:
		eigen<-eigen(t(this$.q.matrix$.orig.matrix));
		dist<-numeric(0);

		if( length(intersect(is.complex(eigen$values),TRUE)) == 0 ) {
			# if all  eigenvalues are real:
			# Choose the largest eigenvalue (which should be zero):
			index<-which( eigen$values == max(eigen$values));
			# Choose the correspondign eigenvector:
			dist<-rbind(eigen$vectors[ ,index]);
		}
		else {
			# If we have complex eigenvalues:
			# Choose the eigenvalue (l) with maximum |e^(l)|  
			tmp<-abs(exp(eigen$values));
			index<-which(tmp == max(tmp));
			# ... and the corresponding eigenvector:
			dist<-as.double(eigen$vectors[,index]);
		}	

		# Normalize the eigenvector:
		return(dist/sum(dist));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
				

##	
## Method: .initEquDist
##	
setMethodS3(
	".initEquDist", 
	class="GeneralSubstitution", 
	function(
		this,
		dummy=NA, # to satisfy method classification
		...
	){

		if(!isEmpty(this$.alphabet)){
			# Fill in with NA-s
			this$.equ.dist<-rbind(rep(NA,times=this$.alphabet$size));
			# Set the dimnames:
			colnames(this$.equ.dist)<-this$.alphabet$symbols;
			rownames(this$.equ.dist)<-c("Prob:");
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEquDist
##	
###########################################################################/**
#
# @RdocMethod getEquDist
# 
# @title "Get the equilibrium distribution from a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{dummy}{Not used.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new equlibrium distribution (invisible).
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(
#                           alphabet=BinaryAlphabet(),
#                           rate.list=list("1->0"=1,"0->1"=1)
#                         )
#	# get equlibrium distribution 
#	getEquDist(p)
#	# get equilibrium distribution via virtual field
#	p$equDist
#	# re-set the equilibrium distribution
#	dist<-p$equDist * 3
#	dist
#	setEquDist(p,dist)
#	p$equDist
#	# re-set equilibrium distribution via virtual field
#	p$equDist<-p$equDist * 2
#	p$equDist
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEquDist", 
	class="GeneralSubstitution", 
	function(
		this,
		dummy=NA, # to satisfy method classification
		...
	){

		this$.equ.dist;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: sampleState
##	
###########################################################################/**
#
# @RdocMethod	sampleState
# 
# @title "Sample a state from the equlibrium distribution of a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get equlibrium distribution 
#	getEquDist(p)
#	# get equilibrium distribution via virtual field
#	p$equDist
#	# sample from equilibrium distribution
#	sampleState(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"sampleState", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){

	if(!exists(x="PSIM_FAST")){
		if(any(is.na(this$.equ.dist))){
			throw("Cannot sample state because the equlibrium distribution is not defined!\n");
		}
		else if (!is.Alphabet(this$.alphabet)){
			throw("Cannot sample state because the alphabet is not valid! That is strange as equlibrium distribution is defined!\n");	
		}
	}
	
	if(this$.alphabet$size == 0){
		throw("The process alphabet is empty, nothing to sample here!\n");
	}
	if(this$.alphabet$size == 1){
	# Special case: single letter in the alphabet:
		return(this$.alphabet$symbols[[1]]);
	}
	else {
	# Sample from the equlibrium distribution:
		sample(x=this$.alphabet$.symbols, size=1, replace=FALSE, prob=this$.equ.dist);
	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getQMatrix
##	
###########################################################################/**
#
# @RdocMethod getQMatrix
# 
# @title "Get the QMatrix object aggregated by a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method is mostly used internally.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A QMatrix object.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the QMatrix object
#	getQMatrix(p)
#	# get the QMatrix object via virtual field
#	q<-p$qMatrix
#	# tweak with the QMatrix
#	setRate(q,"0->1",2)
#	# set a new QMatrix for p
#	setQMatrix(p,q)
#	summary(p)
#	# set new QMatrix via virtual field
#	setRate(q,"1->0",2)
#	p$qMatrix<-q
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getQMatrix", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){

		this$.q.matrix;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setQMatrix
##	
###########################################################################/**
#
# @RdocMethod setQMatrix
# 
# @title "Set the QMatrix object aggregated by a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method is mostly used internally.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{value}{A QMatrix object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The QMatrix object.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the QMatrix object
#	getQMatrix(p)
#	# get the QMatrix object via virtual field
#	q<-p$qMatrix
#	# tweak with the QMatrix
#	setRate(q,"0->1",2)
#	# set a new QMatrix for p
#	setQMatrix(p,q)
#	summary(p)
#	# set new QMatrix via virtual field
#	setRate(q,"1->0",2)
#	p$qMatrix<-q
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setQMatrix", 
	class="GeneralSubstitution", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)){
			throw("No new value provided!\n");
		}
		else if(!is.QMatrix(value)){
			throw("The provided object is not a QMatrix!\n");
		}
		else if (!is.Alphabet(getAlphabet(this))){
			throw("Cannot set QMatrix because process alphabet is not defined!\n");
		}
		else if(!is.Alphabet(value$alphabet)){
			throw("Cannot set QMatrix because the alphabet of the provided QMatrix object is not set!\n");	
		}
		else if(getAlphabet(this) != value$alphabet){
			throw("Alphabet mismatch! Cannot set QMatrix!\n");	
		}
	}
		this$.q.matrix<-value;
		return(this$.q.matrix)

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAlphabet
##	
###########################################################################/**
#
# @RdocMethod	setAlphabet
# 
# @title "Set the Alphabet object aggregated by a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method also sets the alphabet for the associated QMatrix object, which will set all rates to NA.
#	This method will also re-initialize the equlibrium distribution by setting all frequencies to NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{value}{An Alphabet object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Alphabet object.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object with an attached BinaryAlphabet object
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet())
#	# get object summary
#	summary(p)
#	# get alphabet
#	getAlphabet(p)
#	# get alphabet via virtual field
#	p$alphabet
#	# set a new alphabet
#	setAlphabet(p,NucleotideAlphabet())
#	summary(p)
#	# set alphabet via virtual field
#	p$alphabet<-BinaryAlphabet()
#	p$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAlphabet", 
	class="GeneralSubstitution", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)){
			throw("No new value provided!\n");
		}
		else if (!is.Alphabet(value)){
			throw("Alphabet object is invalid!\n");
		}
	}
		this$.alphabet<-value;
		# Set the QMatrix alphabet
		if(is.QMatrix(this$.q.matrix)){
			setAlphabet(this$.q.matrix, value);
		}
		.initEquDist(this);
		return(this$.alphabet);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAlphabet
##	
###########################################################################/**
#
# @RdocMethod	getAlphabet
# 
# @title "Get the Alphabet object aggregated by a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method also sets the alphabet for the associated QMatrix object, which will set all rates to NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An Alphabet object.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object with an attached BinaryAlphabet object
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet())
#	# get object summary
#	summary(p)
#	# get alphabet
#	getAlphabet(p)
#	# get alphabet via virtual field
#	p$alphabet
#	# set a new alphabet
#	setAlphabet(p,NucleotideAlphabet())
#	summary(p)
#	# set alphabet via virtual field
#	p$alphabet<-BinaryAlphabet()
#	p$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAlphabet", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){
		
		# Just to satisfy method classification:
		this$.alphabet;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: hasUndefinedRate
##	
###########################################################################/**
#
# @RdocMethod hasUndefinedRate
# 
# @title "Check if a GeneralSubstitution object has undefined rates" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet())
#	# check if it has undefined rates
#	hasUndefinedRate(p)	# TRUE
#	# set the missing rates
#	p$rateList<-list("0->1"=1,"1->0"=2)
#	# check for undefined rates again
#	hasUndefinedRate(p)	# FALSE
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"hasUndefinedRate", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){
		
		if( any(is.na(this$.q.matrix$.orig.matrix)) | any(is.na(this$.q.matrix$.rate.matrix))){
			return(TRUE);
		}
		else {
			return(FALSE);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: getEventRate
##	
###########################################################################/**
#
# @RdocMethod getEventRate
# 
# @title "Get the scaled rate of an event from a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method return the element from the scaled rate matrix stored in the associated QMatrix object corresponding to
#	a given event. The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	This method doesn't take into account the site specific rate multipliers in any way.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the scaled rate of "0->1" by name
#	getEventRate(p,"0->1")	
#	# get the scaled rate of "0->1" by states
#	getEventRate(p,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventRate", 
	class="GeneralSubstitution", 
	function(
		this,
		name=NA,
		from=NA,
		to=NA,
		...
	){

		# For getting the scaled event rate:
	if(!exists(x="PSIM_FAST")){
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate as the rate matrix is undefined!\n");
		}
	}
		else if(!missing(name) & missing(from) & missing(to)){
			return(getEventRate(this$.q.matrix, name=name));
		}
		else if (missing(name) & !missing(from) & !missing(to)){
			return(getEventRate(this$.q.matrix, from=from, to=to));
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
		
##
## Method: getEventRateAtSite
##
###########################################################################/**
#
# @RdocMethod getEventRateAtSite
# 
# @title "Get the site spcific rate of an event from a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method return the element from the associated QMatrix object corresponding to
#	a given event multiplied by the "rate.multiplier" site-process specific parameter stored in the specified site object.
#	The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object. It must be attached to the provided Site object.} 
# 	\item{site}{A Site object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# create a Site object
#	s<-Site(alphabet=BinaryAlphabet())
#	# attach process p to site s
#	s$processes<-list(p)
#	# set the rate multiplier for s and p
#       setParameterAtSite(p,s,id="rate.multiplier",value=2)
#	# get the site specific rate of "0->1" by name
#	getEventRateAtSite(p,s,"0->1")	
#	# get the site specific rate of "0->1" by states
#	getEventRateAtSite(p,s,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getEventRateAtSite",
  class="GeneralSubstitution",
  function(
    this,
    site,
    name=NA,
    from=NA,
    to=NA,
    ...
  ){

if(!exists(x="PSIM_FAST")){

      if(missing(site)){
        throw("No site provided");
      }
      else if (!isAttached(site, process=this)){
        throw("The process is not attached to the specified site!\n");
      }
}

      global.rate<-numeric();
			
			# Event specified by name:
      if(!missing(name) & missing(from) & missing(to)){
          global.rate<-getEventRate(this$.q.matrix, name=name);
      }
			# Event specified by from= and to=
      else if(missing(name) & !missing(from) & !missing(to)){
          global.rate<-getEventRate(this$.q.matrix, from=from, to=to);
      }
      else {
        throw("The substitution should be specified by name or by the \"from\" and \"to\" arguments!\n");
      }

      return(global.rate * site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value );

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);
	
##	
## Method: getRate
##	
###########################################################################/**
#
# @RdocMethod getRate
# 
# @title "Get an unscaled rate of an event from a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method gets the element corresponding to a given event form the unscaled Q matrix.
#	a given event. The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	The rescaled rates (used during simulations) are returned by the \code{getEventRate} method.
#
#	This method doesn't take into account the site specific rate multipliers in any way.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the unscaled rate of "0->1" by name
#	getRate(p,"0->1")	
#	# get the unscaled rate of "0->1" by states
#	getRate(p,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRate", 
	class="GeneralSubstitution", 
	function(
		this,
		name=NA,
		from=NA,
		to=NA,
		...
	){

	if(!exists(x="PSIM_FAST")){
	
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate as the rate matrix is undefined!\n");
		}
	}
		if(!missing(name) & missing(from) & missing(to)){
			return(getRate(this$.q.matrix, name=name));
		}
		else if (missing(name) & !missing(from) & !missing(to)){
			return(getRate(this$.q.matrix, from=from, to=to));
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: setRate
##	
###########################################################################/**
#
# @RdocMethod setRate
#
# @title "Set an unscaled rate for an event from a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method sets the element corresponding to a given event in the unscaled Q matrix.
#	The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	Modifying any rate in the unscaled Q matrix will trigger the re-scaling of the whole matrix.
#	The rescaled rates (used during simulations) are returned by the \code{getEventRate} method.
#
#	This method doesn't modify the site specific rate multipliers.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{value}{The new value of the rate.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# set the unscaled rate by event name
#	setRate(p,"0->1",2)
#	# get the unscaled rate of "0->1" by name
#	getRate(p,"0->1")	
#	# set the unscaled rate by states
#	setRate(p,"0->1",0.5)
#	# get the unscaled rate of "0->1" by states
#	getRate(p,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRate", 
	class="GeneralSubstitution", 
	function(
		this,
		name=NA,
		value,
		from=NA,
		to=NA,
		...
	){
		
		.checkWriteProtection(this);
		# Setting unscaled rate:
	if(!exists(x="PSIM_FAST")){
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot set rate as the rate matrix is undefined!\n");
		}
	}
		if(!missing(name) & missing(from) & missing(to)){
			return(setRate(this$.q.matrix, name=name, value=value));
		}
		else if (missing(name) & !missing(from) & !missing(to)){
			return(setRate(this$.q.matrix, from=from, to=to, value=value));
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateList
##	
###########################################################################/**
#
# @RdocMethod	getRateList
# 
# @title "Get a list of events and their unscaled rates from a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method returns the list of event rates from the \emph{unscaled} Q matrix (as returbed bvy the \code{getEventRate} method). 
#	The returned list contains the rates associated with the corresponding event names.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of event rates.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the event rates from the unscaled Q matrix
#	getRateList(p)
#	# get rates from the unscaled rate matrix via virtual field
#	p$rateList
#	# set rates in the unscaled rate matrix
#	setRateList(p, list("0->1"=1,"1->0"=1))
#	p$rateList
#	# set rates in the unscaled rate matrix via virtual field
#	p$rateList<-list("0->1"=3,"1->0"=1);
#	# check the contenst of the associated QMatrix object
#	summary(p$QMatrix)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateList", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){

	if(!exists(x="PSIM_FAST")){
		
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate list as the rate matrix is undefined!\n");
		} 
	}
		return(getRateList(this$.q.matrix));


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateList
##	
###########################################################################/**
#
# @RdocMethod	setRateList
# 
# @title "Setting the rates for a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method set the rates in the \emph{unscaled} Q  matrix based on the provided list containing even names
#	and the associated rates. The rate must be specified for every event!
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
#	\item{value}{A list with the events names and the associated rates.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The GeneralSubstitution object (invisible).
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the event rates from the unscaled Q matrix
#	getRateList(p)
#	# get rates from the unscaled rate matrix via virtual field
#	p$rateList
#	# set rates in the unscaled rate matrix
#	setRateList(p, list("0->1"=1,"1->0"=1))
#	p$rateList
#	# set rates in the unscaled rate matrix via virtual field
#	p$rateList<-list("0->1"=3,"1->0"=1);
#	# check the contenst of the associated QMatrix object
#	summary(p$QMatrix)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateList", 
	class="GeneralSubstitution", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){

		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate list as the rate matrix is undefined!\n");
		} 
		else if(missing(value)){
			throw("No new rate list specified!\n");
		}
	}
		return(setRateList(this$.q.matrix, value) );

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: rescaleQMatrix
##	
###########################################################################/**
#
# @RdocMethod rescaleQMatrix
# 
# @title "Rescale the scaled rate matrix of a QMatrix object aggregated by a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	The QMatrix objects aggregated by the GeneralSubstitution objects store two rate matrices: one containes
#	the rates provided by the user (unscaled rate matrix), the other matrix (scaled rate matrix) is rescaled to have the 
#	expected number of subsitutions per unit time equal to one when the process is at equlibrium.
#	This method performes the re-scaling of the scaled rate matrix in the associated QMatrix object based on 
#	the equlibrium distribution and the unscaled rate matrix.
#
#	This method is mainly used internally as the scaled matrix is rescaled every time the unscaled matrix 
#	is modifed.
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	# provide an Alphabet object and the rates
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# rescale rate matrix
#	rescaleQMatrix(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"rescaleQMatrix", 
	class="GeneralSubstitution", 
	function(
		this,
		...
	){

	if(!exists(x="PSIM_FAST")){

		if(is.na(this$.q.matrix)){
			return(invisible(FALSE));
		}
		else if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot rescale rate matrix because it is invalid!\n");
		}
		else if (any(is.na(this$.q.matrix))){
			throw("Cannot rescale rate matrix because not all rates are specified!\n");
		}
		else if(any(is.na(this$.equ.dist))){
			throw("Cannot rescale rate matrix because the equlibrium distribution is not defined properly!\n");
		}
		# Check for alphabet mismatch:
		if(this$alphabet != this$.q.matrix$.alphabet){
			throw("The process alphabet and the QMatrix alphabet is not the same! Refusing to rescale!\n");
		}
	}
		# Set rescaling constant to zero:
		K <- 0; 
		# get the symbols:
		symbols<-this$alphabet$symbols;
		orig.matrix<-this$.q.matrix$.orig.matrix;
			
		# For every symbol:
		for (i in symbols) {
		# Get the equlibrium probability:
		i.equ<-this$.equ.dist[[ which(colnames(this$.equ.dist) == i) ]];
		for(j in symbols){
			if(i == j){next}
			# For every other symbol - update the constant:
			K <- K + (i.equ * orig.matrix[i,j] );
			}
		}
	
    		Scale(this$.q.matrix,constant=(1/K));
		# After rescaling the expected rate of substitutions per site
		# at equlibrium is 1.
		return(invisible(TRUE));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: is.GeneralSubstitution
##	
###########################################################################/**
#
# @RdocDefault is.GeneralSubstitution
# 
# @title "Check if an object is an instance of the GeneralSubstitution class" 
# 
# \description{ 
#       @get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{An object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       TRUE or FALSE.
# } 
# 
# \examples{
#	# create some objects
#	p<-GeneralSubstitution()
#	pp<-Process()
#	# chek if they inherit from GeneralSubstitution
#	is.GeneralSubstitution(p)
#	is.GeneralSubstitution(pp)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass
# } 
# 
#*/###########################################################################
setMethodS3(
	"is.GeneralSubstitution", 
	class="default", 
	function(
		this,
		...
	){

	if(!is.PSRoot(this)) {return(FALSE)}
	if(!is.null(this$.is.general.substitution)){return(TRUE)}
	if ( inherits(this, "GeneralSubstitution")) {
		this$.is.general.substitution<-TRUE;
      		return(TRUE);
	} else {
      	return(FALSE)
    	}

},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: as.character
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Return the character representation of a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#	The character representation is the object id as returned by the 
#	\code{getId.Process} method defined in the parent class.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	p<-GeneralSubstitution(name="MySubst")
#	# get character representation
#	as.character(p)
#	# the same implicitly
#	p
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character",
	class="GeneralSubstitution", 
	function(
		x,
		...
	){

		x$.id;

	},
	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<-GeneralSubstitution(alphabet=BinaryAlphabet(),rate.list=list("0->1"=1,"1->0"=2))
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="GeneralSubstitution", 
	function(
		object,
		...
	){

		this<-object;	
		.addSummaryNameId(this);
		.addSummaryAlphabet(this);
		
		if(is.null(this$.summary$"Unscaled rate matrix")){
			this$.summary$"Unscaled rate matrix"<-paste( "\n\t",paste(capture.output(print(this$.q.matrix)),collapse="\n\t"),"\n",sep="");
		}
		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: clone
##
###########################################################################/**
#
# @RdocMethod clone
# 
# @title "Clone a GeneralSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method also clones the aggregated QMatrix object, but not the aggregated Alphabet
#	object, as that is a good target for recycling.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GeneralSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A GeneralSubstitution object.
# } 
# 
# \examples{
#	# create a GeneralSubstitution object
#	p<-GeneralSubstitution(
#                           alphabet=BinaryAlphabet(),
#                           rate.list=list("0->1"=1,"1->0"=2),
#                           name="MyBinary"
#                           )
#	# clone p
#	pp<-clone(p)
#	# do some checks
#	p;pp
#	p == p
#	p == pp
#	equals(p$qMatrix, pp$qMatrix)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "clone",
  class="GeneralSubstitution",
  function(
    this,
    ...
  ){

	# Clone the process object:
	that<-clone.Object(this);
	# Disable write protection:
      	if(that$writeProtected){
        	that$writeProtected<-FALSE;
      	}

	# Clone Q matrix object:
	that$.q.matrix<-clone(this$.q.matrix);
	that$.q.matrix$.process<-that;

	# Reassingning name to force Id update:
	that$name<-that$name;
	return(that);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: plot
##
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Create a bubble plot of the substitution process" 
# 
# \description{ 
#	@get "title".
#
#	Bubble plots visualize the characteristics of the 
#	substitution process. The area of the circles is proportional to the rates/probabilities.
#	The plot is not produced if the rate matrix or the equlibrium 
#	distribution has undefined elements.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{An object inheriting from GeneralSubstitution.} 
#	\item{scale}{A scale factor affecting the area of the circles.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The process object (invisible).
# } 
# 
# \examples{
#	plot(BinarySubst(rate.list=list("0->1"=1,"1->0"=1.5)))
#	plot(JC69())
#	# get smaller circles
#	plot(JC69(),scale=0.5)
#	plot(F84(base.freqs=c(3/6,1/6,1/6,1/6)))
#	plot(WAG())
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "plot",
  class="GeneralSubstitution",
  function(
    x,
    scale=1,
    ...
  ){

	if(!is.numeric(scale)){
		throw("Scale parameter must be numeric!");
	}
	
	if(scale <= 0){
		throw("Scale parameter must be positive!");
	}

	if(hasUndefinedRate(x))	{
		throw("Cannot plot process: the rate matrix has undefined elements!");
	}

	if(any(is.na(x$equDist)))	{
		throw("Cannot plot process: the equilibrium distribution has undefined elements!");
	}

	qmat<-x$.q.matrix$scaledMatrix;
	# setting up viewports
	point_scale<-40.0;
	
	grid.newpage();

	size<-dim(qmat)[1];
	dsize<-(max(c(1/size,( (0.23 * size - 0.65)/size ) )));

	layout<-grid.layout(nrow=2,ncol=1,heights=c((1 - dsize), dsize),respect=TRUE);

	vp1<-viewport(layout=layout,layout.pos.row=1,layout.pos.col=1);
	vp2<-viewport(layout=layout,layout.pos.row=2,layout.pos.col=1);
	
	pushViewport(vp1);
	# tabulate rates	
	xx<-c();
	yy<-c();
	zz<-c();	

	for(cl in (colnames(qmat))){
		for(rw in (rownames(qmat))){
			if(rw != cl){
				xx<-c(xx,cl)
				yy<-c(yy,rw)
				zz<-c(zz,qmat[as.character(rw), as.character(cl)]);
			}
		}
	}


	# visual aspect tuned by "magic" formulas :)
	my.plot<-(qplot(x=xx,y=yy,size=zz,xlab="To:",ylab="From:",main="Rate matrix") + geom_point(colour="blue") +
	scale_size_area(limits=c(0,max(zz)), name="Size:")
	) + xlim(colnames(qmat)) + ylim(rev(rownames(qmat)));
	print(my.plot, vp=vp1);
	popViewport(1);

	# equlibrium distribution	
	dist<-x$equDist;
	xx<-c();
	yy<-c();
	zz<-c();
	
	for(cl in colnames(dist)){
		xx<-c(xx, cl);
		yy<-c(yy, 1);
		zz<-c(zz,dist[1,as.character(cl)]);
	}

	pushViewport(vp2);
	fr<-max(zz) - min(zz);	
	# visual aspect tuned by "magic" formulas :)
	my.plot<-(qplot(x=xx,y=yy,size=zz,xlab="Symbol",ylab="Prob:",main="Equlibrium distribution") + geom_point(colour="green") + 
	scale_size_area(limits=c(0,max(zz)), name="Size:",breaks=c(min(zz),min(zz) + fr*(1/3),min(zz) + fr*(2/3),max(zz))) + xlim(xx)
	);
	print(my.plot,vp=vp2);
	popViewport(1);

	return(invisible(x));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass UNREST
# 
# @title "The UNREST class"
# 
# \description{ 
#	This class implements the UNRESTricted nucleotide substitution model.
#	UNREST objects are basically a GeneralSubstitution process acting on a 
#	nucleotide alphabet.
#
#	@classhierarchy
# }
# \references{
# Yang, Z (1994) Estimating the pattern of nucleotide substitution - Journal of Molecular Evolution 
# 39:105-111 \url{http://bit.ly/aFO0cq}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.list}{A list of unscaled rates (see \code{setRateList.GeneralSubstitution}).}
#	\item{equ.dist}{Equlibrium distribution.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#       p<-UNREST(rate.list=list(
#		"T->C"=1, "T->A"=2, "T->G"=3, "C->T"=4, "C->A"=1, 
#		"C->G"=2, "A->T"=3, "A->C"=4, "A->G"=1, "G->T"=2,
#		"G->C"=3, "G->A"=4	
#	))
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GeneralSubstitution GTR
# }
# 
#*/###########################################################################
setConstructorS3(
  "UNREST",
  function( 
		name="Anonymous", # name of the object
		rate.list=NA,	  # list of unscaled rates
		equ.dist=NA,      # equlibrium distribution
		... 
		)	{

		got.rate.list<-!missing(rate.list);
		got.equ.dist<-!missing(equ.dist);
		
			this<-NA;
			# Got rate list and equlibrium distribution:
			if(got.rate.list & got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=NucleotideAlphabet(),
					rate.list=rate.list,
					equ.dist=equ.dist
				);	
				this<-extend(this, "UNREST");
			}
		
			# Got rate list	
			else if(got.rate.list & !got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=NucleotideAlphabet(),
					rate.list=rate.list
				);	
				this<-extend(this, "UNREST");
			}
			
			# Got equlibrium distribution,
			# we set it, but it will be owerwritten anyway.
			else if(!got.rate.list & got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=NucleotideAlphabet(),
					equ.dist=equ.dist
				);	
				this<-extend(this, "UNREST");
			}

			# Got nothing:
			else if(!got.rate.list & !got.equ.dist){
				this<-GeneralSubstitution(
					name=name,
					alphabet=NucleotideAlphabet()
				);	
				this<-extend(this, "UNREST");
			}

		# 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="UNREST", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
	
				if(!inherits(this$alphabet, "NucleotideAlphabet")){
					throw("This object must have as alphabet a NucleotideAlphabet object!\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: 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
#       p<-UNREST(rate.list=list(
#		"T->C"=1, "T->A"=2, "T->G"=3, "C->T"=4, "C->A"=1, 
#		"C->G"=2, "A->T"=3, "A->C"=4, "A->G"=1, "G->T"=2,
#		"G->C"=3, "G->A"=4	
#	))
#       # get a summary
#       summary(p)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="UNREST", 
	function(
		object,
		...
	){

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Constructor: JC69
##	
##########################################################################/** 
#
# @RdocClass JC69
# 
# @title "The JC69 class"
# 
# \description{ 
#	This class implements Jukes-Cantor nucleotide substitution model.
#
#	@classhierarchy
# }
#
# \references{
#	Jukes, TH and Cantor, CR (1969) Evolution of protein molecules. Pp. 21-123 in H. N. Munro, 
#	ed. Mammalian protein metabolism. Academic Press, New York.
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#       p<-JC69()
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GeneralSubstitution UNREST GTR
# }
# 
#*/###########################################################################
setConstructorS3(
  "JC69",
  function( 
		name="Anonymous", # object name
		... 
		)	{
	
		# Set all rates to be equal.	
		this<-UNREST(rate.list=list(
  		"A->T"=1,
  		"A->C"=1,
  		"A->G"=1,
  		"T->A"=1,
  		"T->C"=1,
  		"T->G"=1,
  		"C->A"=1,
  		"C->T"=1,
  		"C->G"=1,
  		"G->A"=1,
  		"G->T"=1,
  		"G->C"=1
		));
		
		this<-extend(this,"JC69");
		this$name<-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="JC69", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {

					qmat<-this$.q.matrix$Matrix;	
					# This is a dumb method to check the sanity of the rates, but consistency checking
					# should not be called frequently.
					diag(qmat)<-1;
					if(any(qmat != 1)){
						throw("The unscaled rate matrix is not consistent with the JC69 model!\n");
					}

					if ( !all.equal(as.numeric(this$.equ.dist), as.numeric(rep(0.25,times=4)) ) ){
						throw("The equlibrium distribution of the JC69 model should be uniform!\n");
					}
		
      }
      tryCatch(may.fail(this),finally=this$writeProtected<-wp);
			NextMethod();		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
###########################################################################/**
#
# @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
#       p<-JC69()
#       # get a summary
#       summary(p)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="JC69", 
	function(
		object,
		...
	){

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


#
# Constructor: GTR
#
##########################################################################/** 
#
# @RdocClass GTR
# 
# @title "The GTR class"
# 
# \description{ 
#	This class implements the general time-reversible nucleotide substitution model (GTR, REV).
#	The rate parameters are named as in PAML (see PAML documentation: \url{http://bit.ly/9SQK2f}).
#
#	The default value for the rate parameters is 1 and the default value for the base 
#	frequencies is 0.25. So the GTR objects are equivalent to JC69 objects by default.
#
#	@classhierarchy
# }
# \references{
#	Tavare, S (1986) "Some Probabilistic and Statistical Problems in the Analysis of DNA Sequences". 
#	American Mathematical Society: Lectures on Mathematics in the Life Sciences 17:57-86
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{A list of unscaled rates (see \code{setRateList.GeneralSubstitution}).}
#	\item{base.freqs}{Equlibrium distribution.}
# 	\item{...}{Additional arguments.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-GTR(
#		rate.params=list(
#			"a"=1, "b"=2, "c"=3,
#			"d"=1, "e"=2, "f"=3
#		),
#		base.freqs=c(2,2,1,1)/6
#	)
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object and run simulation
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GeneralSubstitution UNREST HKY
# }
# 
#*/###########################################################################
setConstructorS3(
  "GTR",
  function( 
		name="Anonymous", 
		# The GTR rate parameters:
		rate.params=list(
				"a"=1,
				"b"=1,
				"c"=1,
				"d"=1,
				"e"=1,
				"f"=1
		),	
		# Base frequencies (equlibrium distribution):
		base.freqs=rep(0.25,times=4),
		... 
		)	{

		this<-UNREST();

		this<-extend(
			this,
			"GTR",
			.gtr.params=list(
					"a"=NA,
					"b"=NA,
					"c"=NA,
					"d"=NA,
					"e"=NA,
					"f"=NA
				)
		);
		this$name<-name;
		setEquDist(this,value=base.freqs,force=TRUE)	
		setRateParamList(this,value=rate.params);

		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="GTR", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
	
			# All rate parameters should be positive:					
			if (any( as.numeric(this$.gtr.params) < 0 ) ){
				throw("Found negative GTR rate parameters!\n");
			}
			else {
			
				rates<-this$.q.matrix$Matrix;
		
						if (	
                 !PSRoot$my.all.equal( rates[["T","C"]] , (this$.gtr.params[["a"]] * this$.equ.dist[1,"C"] ) )|
                 !PSRoot$my.all.equal( rates[["C","T"]] , (this$.gtr.params[["a"]] * this$.equ.dist[1,"T"] )	)|
                 !PSRoot$my.all.equal( rates[["T","A"]] , (this$.gtr.params[["b"]] * this$.equ.dist[1,"A"] )	)|
                 !PSRoot$my.all.equal( rates[["A","T"]] , (this$.gtr.params[["b"]] * this$.equ.dist[1,"T"] )	)|
                 !PSRoot$my.all.equal( rates[["T","G"]] , (this$.gtr.params[["c"]] * this$.equ.dist[1,"G"] )	)|
                 !PSRoot$my.all.equal( rates[["G","T"]] , (this$.gtr.params[["c"]] * this$.equ.dist[1,"T"] )	)|
		 !PSRoot$my.all.equal( rates[["C","A"]] , (this$.gtr.params[["d"]] * this$.equ.dist[1,"A"] )	)|
                 !PSRoot$my.all.equal( rates[["A","C"]] , (this$.gtr.params[["d"]] * this$.equ.dist[1,"C"] )	)|
                 !PSRoot$my.all.equal( rates[["C","G"]] , (this$.gtr.params[["e"]] * this$.equ.dist[1,"G"] )	)|
                 !PSRoot$my.all.equal( rates[["G","C"]] , (this$.gtr.params[["e"]] * this$.equ.dist[1,"C"] )	)|
                 !PSRoot$my.all.equal( rates[["A","G"]] , (this$.gtr.params[["f"]] * this$.equ.dist[1,"G"] )	)|
                 !PSRoot$my.all.equal( rates[["G","A"]] , (this$.gtr.params[["f"]] * this$.equ.dist[1,"A"] )	)
						) {
						
								throw("Rate matrix is not consistent with the GTR rate parameters!\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: .getRateParam
##	
setMethodS3(
	".getRateParam", 
	class="GTR", 
	function(
		this,
		name,
		param.list,
		...
	){

		if(length(intersect(name,names(param.list))) == 0){
			throw("The specified rate parameter name is not valid!\n");
		}
		else {
			return(param.list[[name]]);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are named as in PAML (see PAML documentation: \url{http://bit.ly/9SQK2f}).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GTR object.} 
#	\item{name}{The name of the rate parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# construct a GTR object
#	p<-GTR();
#	# set/get a rate parameter
#	setRateParam(p,"a",4)
#	getRateParam(p,"a")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="GTR", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam(this,name,this$.gtr.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .setRateParam
##	
setMethodS3(
	".setRateParam", 
	class="GTR", 
	function(
		this,
		name,
		value,
		param.list,
		...
	){

		.checkWriteProtection(this);

	if(!exists(x="PSIM_FAST")){

		if(length(intersect(name,names(param.list))) == 0){
			throw("The specified rate parameter name is not valid!\n");
		}
		else if(missing(value)){
			throw("No new value given!\n")
		}
		else if(length(value) != 1|any(!is.numeric(value))){
			throw("The new value must be a numeric vector of length 1!\n");	
		}
		else if(any(is.na(this$.equ.dist))){
			throw("Cannot set rate parameter because the nucleotide frequencies are not defined properly!\n");
		}
	}
		param.list[[name]]<-value;
				
		# We call setRateParamList to rebuild the whole rate
		# matrix with the new values if one of the rates changed:
		setRateParamList(this, param.list);
									

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are named as in PAML (see PAML documentation: \url{http://bit.ly/9SQK2f}).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GTR object.} 
#	\item{name}{The name of the rate parameter.}
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#	# construct a GTR object
#	p<-GTR();
#	# set/get a rate parameter
#	setRateParam(p,"a",4)
#	getRateParam(p,"a")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="GTR", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam(this,name,value,this$.gtr.params);
		}
		return(invisible(value));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are named as in PAML (see PAML documentation: \url{http://bit.ly/9SQK2f}).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GTR object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of rate parameters.
# } 
# 
# \examples{
#	# create GTR object
#	p<-GTR()
#	# set/get rate parameters
#	setRateParamList(p,list(
#                       "a"=1, "b"=2, "c"=3,
#                       "d"=1, "e"=2, "f"=3
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#                       "a"=4, "b"=1, "c"=4,
#                       "d"=1, "e"=4, "f"=1
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="GTR", 
	function(
		this,
		...
	){

		this$.gtr.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .checkRateParamList
##	
setMethodS3(
	".checkRateParamList", 
	class="GTR", 
	function(
		this,
		names,
		value.names,
		...
	){

		# Check for illegal rate parameter names:
		if(length((illegal<-setdiff(value.names, names))) != 0){
			throw("The following rate parameter names are illegal: ",paste(illegal, collapse=", ")," !\n");
		}
		else {
			missing<-setdiff(names, value.names);
			if(length(missing) > 0) {
				throw("Cannot build the model because the following rate parameters are missing: ",paste(missing,collapse=", ")," \n");	
		} else {
					return(TRUE);
			}
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are named as in PAML (see PAML documentation: \url{http://bit.ly/9SQK2f}).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GTR object.} 
#	\item{value}{A list containing the rate parameters.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters (invisible).
# } 
# 
# \examples{
#	# create GTR object
#	p<-GTR()
#	# set/get rate parameters
#	setRateParamList(p,list(
#                       "a"=1, "b"=2, "c"=3,
#                       "d"=1, "e"=2, "f"=3
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#                       "a"=4, "b"=1, "c"=4,
#                       "d"=1, "e"=4, "f"=1
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="GTR", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){

	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	
	}
	
	# Get the rate parameter names:
	names<-names(this$.gtr.params);
	value.names<-names(value);

	if(.checkRateParamList(this,names,value.names)) {
	
	# Set the rate parameters:
	# The parmeters are named as in 
	# "Ziheng Yang: Computational Molecular Evolution, 
	# Oxford university Press, Oxford, 2006", pp. 34.

	rate.list=list(

                	"T->C"=(value[["a"]] * this$.equ.dist[1,"C"] ),
                	"C->T"=(value[["a"]] * this$.equ.dist[1,"T"] ),
                	"T->A"=(value[["b"]] * this$.equ.dist[1,"A"] ),
                	"A->T"=(value[["b"]] * this$.equ.dist[1,"T"] ),
                	"T->G"=(value[["c"]] * this$.equ.dist[1,"G"] ),
                	"G->T"=(value[["c"]] * this$.equ.dist[1,"T"] ),
			"C->A"=(value[["d"]] * this$.equ.dist[1,"A"] ),
			# Can you spot the pattern here: "A->C" .* "d" .* "c" :)
                	"A->C"=(value[["d"]] * this$.equ.dist[1,"C"] ),
                	"C->G"=(value[["e"]] * this$.equ.dist[1,"G"] ),
                	"G->C"=(value[["e"]] * this$.equ.dist[1,"C"] ),
                	"A->G"=(value[["f"]] * this$.equ.dist[1,"G"] ),
                	"G->A"=(value[["f"]] * this$.equ.dist[1,"A"] )

        );
	# Setting the parameter field:
	this$.gtr.params<-value;
	# Calling setRateList, which will set the 
	# elements of the rate matrix.
	setRateList(this,rate.list);
	}
	return(invisible(value));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GTR object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the base frequencies.
# } 
# 
# \examples{
#	# construct a GTR object
#	p<-GTR()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="GTR", 
	function(
		this,
		...
	){

		# Its just the .equ.dist field from UNREST.
		this$.equ.dist;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
# 
# @title "Set the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A GTR object.} 
#	\item{value}{A vector of base frequencies.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible)
# } 
# 
# \examples{
#	# construct a GTR object
#	p<-GTR()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="GTR", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
		setEquDist(this,value,force=TRUE);
		setRateParamList.GTR(this,value=this$.gtr.params);
		return(invisible(value));
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: summary.GTR
##	
###########################################################################/**
#
# @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<-GTR()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="GTR", 
	function(
		object,
		...
	){

		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "GTR") {
		this$.summary$"Rate parameters"<-paste(names(this$.gtr.params),this$.gtr.params,sep=" = ",collapse=", ");
		}

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of GTR methods ############

##	
## Constructor: TN93
##	
## Tamura, K., and M. Nei. 1993. Estimation of the number of nucleotide substitutions 
## in the control region of mitochondrial DNA in humans and chimpanzees. 
## Molecular Biology and Evolution 10:512-526.
##
##########################################################################/** 
#
# @RdocClass TN93
# 
# @title "The TN93 class"
# 
# \description{ 
#	This class implements the Tamura-Nei 93 GTR-submodel.
#
#	The rate parameters are the following: "Alpha1", "Alpha2","Beta".
#	@classhierarchy
# }
# \references{
# Tamura, K, and Nei, M (1993) Estimation of the number of nucleotide substitutions 
# in the control region of mitochondrial DNA in humans and chimpanzees -
# Molecular Biology and Evolution 10:512-526 \url{http://bit.ly/bNkCqn}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{Rate parameters.}
#	\item{base.freqs}{Base frequency parameters.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-TN93(rate.params=list( "Alpha1"=4,"Alpha2"=3,"Beta"=2),
#		base.freqs=c(2,2,1,3)/9
#	)
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR HKY UNREST GeneralSubstitution
# }
# 
#*/###########################################################################
setConstructorS3(
  "TN93",
  function( 
		name="Anonymous",
		rate.params=list(
				"Alpha1"  =1,
      				"Alpha2"  =1,
      				"Beta"    =1
			),
		base.freqs=c(0.25,0.25,0.25,0.25),
		... 
		)	{
		
		this<-GTR();
		
		this<-extend(
			this,
			"TN93",
			.tn93.params=list(
					"Alpha1"	=NA,
					"Alpha2"	=NA,
					"Beta"		=NA
				)
			);

		this$name<-name;
		this$baseFreqs<-base.freqs;
		this$rateParamList<-rate.params;

		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha1, Alpha2, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A TN93 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters.
# } 
# 
# \examples{
#	# create TN93 object
#	p<-TN93()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha1"=1,
#		"Alpha2"=2,
#		"Beta"=0.5
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha1"=1,
#		"Alpha2"=1,
#		"Beta"=3
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="TN93", 
	function(
		this,
		...
	){

		this$.tn93.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha1, Alpha2, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A TN93 object.} 
#	\item{value}{A list containing the rate parameters.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters (invisible).
# } 
# 
# \examples{
#	# create TN93 object
#	p<-TN93()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha1"=1,
#		"Alpha2"=2,
#		"Beta"=0.5
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha1"=1,
#		"Alpha2"=1,
#		"Beta"=3
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="TN93", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	else {

		# Get the rate parameter names:
		names<-names(this$.tn93.params);
		value.names<-names(value);

		if(.checkRateParamList(this,names,value.names)) {

				this$.tn93.params<-value;
				# Setting the GTR rate parameters:
				gtr.params<-list(
					"a"=value[["Alpha1"]],
					"b"=value[["Beta"]],
					"c"=value[["Beta"]],
					"d"=value[["Beta"]],
					"e"=value[["Beta"]],
					"f"=value[["Alpha2"]]
				);
				setRateParamList.GTR(this, value=gtr.params);

		}

	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha1, Alpha2, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A TN93 object.} 
#	\item{name}{The name of the rate parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# construct a TN93 object
#	p<-TN93();
#	# set/get a rate parameter
#	setRateParam(p,"Beta",4)
#	getRateParam(p,"Beta")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="TN93", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam(this,name,this$.tn93.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha1, Alpha2, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A TN93 object.} 
#	\item{name}{The name of the rate parameter.}
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#	# construct a TN93 object
#	p<-TN93();
#	# set/get a rate parameter
#	setRateParam(p,"Beta",4)
#	getRateParam(p,"Beta")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="TN93", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam(this,name,value,this$.tn93.params);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A TN93 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the base frequencies.
# } 
# 
# \examples{
#	# construct a TN93 object
#	p<-TN93()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="TN93", 
	function(
		this,
		...
	){

		getBaseFreqs.GTR(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
# 
# @title "Set the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A TN93 object.} 
#	\item{value}{A vector of base frequencies.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible)
# } 
# 
# \examples{
#	# construct a TN93 object
#	p<-TN93()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="TN93", 
	function(
		this,
		value,
		...
	){

		setBaseFreqs.GTR(this,value);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: checkConsistency.TN93
##	
###########################################################################/**
#
# @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="TN93", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
	
				# Rate parameters should not be negative:
				if(any(this$.tn93.params < 0 )){
					throw("Found negative TN93 rate parameters!\n");
				}
				else {

					if(
				  	this$.gtr.params[["a"]]!=this$.tn93.params[["Alpha1"]]|
          	this$.gtr.params[["b"]]!=this$.tn93.params[["Beta"]]|
          	this$.gtr.params[["c"]]!=this$.tn93.params[["Beta"]]|
          	this$.gtr.params[["d"]]!=this$.tn93.params[["Beta"]]|
          	this$.gtr.params[["e"]]!=this$.tn93.params[["Beta"]]|
          	this$.gtr.params[["f"]]!=this$.tn93.params[["Alpha2"]]
						) {
							throw("The TN93 parameters are not consistent with the GTR parameters!\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: summary.TN93
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="TN93", 
	function(
		object,
		...
	){
		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "TN93") {
		this$.summary$"Rate parameters"<-paste(names(this$.tn93.params),this$.tn93.params,sep=" = ",collapse=", ");
		}

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of TN93 methods ############

##	
## Constructor: HKY
##	
## Hasegawa, M., H. Kishino, and T. Yano. (1985) Dating of human-ape splitting by a molecular clock
## of mitochondrial DNA. Journal of Molecular Evolution, 22, 160-174.
##
##########################################################################/** 
#
# @RdocClass HKY
# 
# @title "The HKY class"
# 
# \description{ 
#	This class implements the HKY GTR-submodel.
#
#	The rate parameters are the following: "Alpha", "Beta".
#	@classhierarchy
# }
# \references{
# Hasegawa, M Kishino, H and Yano, T (1985) Dating of human-ape splitting by a molecular clock
# of mitochondrial DNA Journal of Molecular Evolution 22:160-174 \url{http://bit.ly/a9AxKm}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{Rate parameters.}
#	\item{base.freqs}{Base frequency parameters.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-HKY(rate.params=list( "Alpha"=10,"Beta"=2),
#		base.freqs=c(4,3,2,1)/10
#	)
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR UNREST GeneralSubstitution TN93
# }
# 
#*/###########################################################################
setConstructorS3(
  "HKY",
  function( 
		name="Anonymous",
		rate.params=list(
				"Alpha"   =1,
      				"Beta"    =1
			),	
		base.freqs=c(0.25,0.25,0.25,0.25),
			... 
		)	{
		
		this<-GTR();
		
		this<-extend(
			this,
			"HKY",
			.hky.params=list(
					"Alpha"	 	=NA,
					"Beta"		=NA
				)
			);

		this$name<-name;
		this$baseFreqs<-base.freqs;
		this$rateParamList<-rate.params;
		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An HKY object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters.
# } 
# 
# \examples{
#	# create HKY object
#	p<-HKY()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha"=1,
#		"Beta"=0.5
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha"=1,
#		"Beta"=3
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="HKY", 
	function(
		this,
		...
	){

		this$.hky.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An HKY object.} 
#	\item{value}{A list containing the rate parameters.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters (invisible).
# } 
# 
# \examples{
#	# create HKY object
#	p<-HKY()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha"=1,
#		"Beta"=0.5
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha"=1,
#		"Beta"=3
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="HKY", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	else {

		# Get the rate parameter names:
		names<-names(this$.hky.params);
		value.names<-names(value);

		if(.checkRateParamList(this,names,value.names)) {

				this$.hky.params<-value;
				# Setting the GTR rate parameters:
				gtr.params<-list(
					"a"=value[["Alpha"]],
					"b"=value[["Beta"]],
					"c"=value[["Beta"]],
					"d"=value[["Beta"]],
					"e"=value[["Beta"]],
					"f"=value[["Alpha"]]
				);
				setRateParamList.GTR(this, value=gtr.params);

		}

	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An HKY object.} 
#	\item{name}{The name of the rate parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters.
# } 
# 
# \examples{
#	# construct HKY object
#	p<-HKY();
#	# set/get a rate parameter
#	setRateParam(p,"Alpha",4)
#	getRateParam(p,"Beta")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="HKY", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam(this,name,this$.hky.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An HKY object.} 
#	\item{name}{The name of the rate parameter.}
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#	# construct HKY object
#	p<-HKY();
#	# set/get a rate parameter
#	setRateParam(p,"Alpha",4)
#	getRateParam(p,"Beta")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="HKY", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam(this,name,value,this$.hky.params);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An HKY object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the base frequency parameters.
# } 
# 
# \examples{
#	# construct object
#	p<-HKY()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="HKY", 
	function(
		this,
		...
	){

		getBaseFreqs.GTR(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
# 
# @title "Set the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An HKY object.} 
#	\item{value}{A vector of base frequencies.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible)
# } 
# 
# \examples{
#	# construct object
#	p<-HKY()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="HKY", 
	function(
		this,
		value,
		...
	){

		setBaseFreqs.GTR(this,value);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency.HKY
##	
###########################################################################/**
#
# @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="HKY", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
				
				# Rate parameters should not be negative:
				if(any(this$.hky.params < 0 )){
					throw("Found negative HKY rate parameters!\n");
				}
				else {

					if(
				  	this$.gtr.params[["a"]]!=this$.hky.params[["Alpha"]]|
          	this$.gtr.params[["b"]]!=this$.hky.params[["Beta"]]|
          	this$.gtr.params[["c"]]!=this$.hky.params[["Beta"]]|
          	this$.gtr.params[["d"]]!=this$.hky.params[["Beta"]]|
          	this$.gtr.params[["e"]]!=this$.hky.params[["Beta"]]|
          	this$.gtr.params[["f"]]!=this$.hky.params[["Alpha"]]
						) {
							throw("The HKY parameters are not consistent with the GTR parameters!\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: summary.HKY
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="HKY", 
	function(
		object,
		...
	){
		
		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "HKY") {
			this$.summary$"Rate parameters"<-paste(names(this$.hky.params),this$.hky.params,sep=" = ",collapse=", ");
		}
			this$.summary$"Transition/transversion rate ratio"<-(this$.hky.params[["Alpha"]]/this$.hky.params[["Beta"]]);

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of HKY methods ############

##	
## Constructor: F81
##	
## Felsenstein, J. (1981) Evolutionary trees from DNA sequences: a maximum likelihood approach.
## Journal of Molecular Evolution, 17, 368-376.
##
##########################################################################/** 
#
# @RdocClass F81
# 
# @title "The F81 class"
# 
# \description{ 
#	This class implements the F81 GTR-submodel.
#
#	@classhierarchy
# }
# \references{
# Felsenstein, J (1981) Evolutionary trees from DNA sequences: a maximum likelihood approach -
# Journal of Molecular Evolution 17:368-376 \url{http://dx.doi.org/10.1007/BF01734359}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{base.freqs}{Base frequency parameters.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-F81(base.freqs=c(1,2,3,4)/10)
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR UNREST GeneralSubstitution HKY
# }
# 
#*/###########################################################################
setConstructorS3(
  "F81",
  function( 
		name="Anonymous",
		base.freqs=c(0.25,0.25,0.25,0.25),
		...
		)	{
		
		this<-GTR(...);
		
		this<-extend(
			this,
			"F81"
			);

		this$name<-name;
		this$baseFreqs<-base.freqs;
		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
#
# @title "Forbidden action: getting the list of rate parameters"
#
# \description{
#       @get "title".
#	
#	This model has no rate parameters.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{...}{Not used.}
# }
#
# \value{
#	The object.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="F81", 
	function(
		this,
		...
	){

		cat("The F81 model has no rate parameters!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
#
# @title "Forbidden action: getting the list of rate parameters"
#
# \description{
#       @get "title".
#	
#	This model has no rate parameters.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	The object.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="F81", 
	function(
		this,
		value,
		...
	){

		cat("The F81 model has no rate parameters!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
#
# @title "Forbidden action: the value of a rate parameters"
#
# \description{
#       @get "title".
#	
#	This model has no rate parameters.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{name}{The name of the rate parameter.}
#       \item{...}{Not used.}
# }
#
# \value{
#	The object.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="F81", 
	function(
		this,
		name,
		...
	){

		cat("The F81 model has no rate parameters!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
#
# @title "Forbidden action: getting the list of rate parameters"
#
# \description{
#       @get "title".
#	
#	This model has no rate parameters.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{name}{Not used.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	The object.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="F81", 
	function(
		this,
		name,
		value,
		...
	){

		cat("The F81 model has no rate parameters!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A F81 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the base frequency parameters.
# } 
# 
# \examples{
#	# construct a F81 object
#	p<-F81()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="F81", 
	function(
		this,
		...
	){

		getBaseFreqs.GTR(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
# 
# @title "Set the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A F81 object.} 
#	\item{value}{A vector of base frequencies.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	value (invisible)
# } 
# 
# \examples{
#	# construct a F81 object
#	p<-F81()
#	# set/get base frequency parameters
#	setBaseFreqs(p,c(2,1,2,1)/6)
#	getBaseFreqs(p)
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs<-c(4,4,1,1)/10
#	p$baseFreqs
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="F81", 
	function(
		this,
		value,
		...
	){

		setBaseFreqs.GTR(this,value);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency.F81
##	
###########################################################################/**
#
# @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="F81", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {

				if(any(as.numeric(this$.gtr.params) != 1)){
					throw("GTR parameters are not consistent with the F81 model!\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: summary.F81
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="F81", 
	function(
		object,
		...
	){

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


######### end of F81 methods ############

##	
## Constructor: K80
##
## Kimura, M. (1980) A simple method for estimating evolutionary rates of base substitutions 
## through comparative studies of nucleotide sequences. Journal of Molecular Evolution, 16, 111-120.
##
##########################################################################/** 
#
# @RdocClass K80
# 
# @title "The K80 class"
# 
# \description{ 
#	This class implements the K80 (Kimura 2-parameter) GTR-submodel.
#
#	The rate parameters are the following: "Alpha", "Beta".
#	@classhierarchy
# }
# \references{
#	Kimura, M. (1980) A simple method for estimating evolutionary rates of base substitutions 
#	through comparative studies of nucleotide sequences. Journal of Molecular Evolution 16:111-120
#	\url{http://dx.doi.org/10.1007/BF01731581}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{Rate parameters.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-K80(rate.params=list( "Alpha"=6,"Beta"=2),
#		base.freqs=c(4,3,2,1)/10
#	)
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR UNREST GeneralSubstitution TN93
# }
# 
#*/###########################################################################
setConstructorS3(
  "K80",
  function( 
		name="Anonymous",
		rate.params=list(
				"Alpha"   =1,
      				"Beta"    =1
			),
			... 
		)	{
		
		this<-GTR();
		
		this<-extend(
			this,
			"K80",
			.k80.params=list(
					"Alpha"	 	=NA,
					"Beta"		=NA
				)
			);

		this$name<-name;
		this$rateParamList<-rate.params;
		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K80 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters.
# } 
# 
# \examples{
#	# create K80 object
#	p<-K80()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha"=1,
#		"Beta"=0.5
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha"=1,
#		"Beta"=3
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="K80", 
	function(
		this,
		...
	){

		this$.k80.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K80 object.} 
#	\item{value}{A list containing the rate parameters.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters (invisible).
# } 
# 
# \examples{
#	# create K80 object
#	p<-K80()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha"=1,
#		"Beta"=0.5
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha"=1,
#		"Beta"=3
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="K80", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	else {

		# Get the rate parameter names:
		names<-names(this$.k80.params);
		value.names<-names(value);

		if(.checkRateParamList(this,names,value.names)) {

				this$.k80.params<-value;
				# Setting the GTR rate parameters:
				gtr.params<-list(
					"a"=value[["Alpha"]],
					"b"=value[["Beta"]],
					"c"=value[["Beta"]],
					"d"=value[["Beta"]],
					"e"=value[["Beta"]],
					"f"=value[["Alpha"]]
				);
				setRateParamList.GTR(this, value=gtr.params);

		}

	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K80 object.} 
#	\item{name}{The name of the rate parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# construct a K80 object
#	p<-K80();
#	# set/get a rate parameter
#	setRateParam(p,"Alpha",4)
#	getRateParam(p,"Beta")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="K80", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam(this,name,this$.k80.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K80 object.} 
#	\item{name}{The name of the rate parameter.}
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#	# construct a K80 object
#	p<-K80();
#	# set/get a rate parameter
#	setRateParam(p,"Alpha",4)
#	getRateParam(p,"Beta")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="K80", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam(this,name,value,this$.k80.params);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects. The K80 model has equal base frequencies.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K80 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the base frequency parameters.
# } 
# 
# \examples{
#	# construct object
#	p<-K80()
#	# get base frequency parameters
#	getBaseFreqs(p) # uniform
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs # uniform
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="K80", 
	function(
		this,
		...
	){

		getBaseFreqs.GTR(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
#
# @title "Forbidden action: setting the base frequency parameters for a K80 object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="K80", 
	function(
		this,
		value,
		...
	){

		# Do not allow to modify the default base frequency distribution, which is uniform.
		throw("You are not allowed to set the base frequencies for the K80 model!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency.K80
##	
###########################################################################/**
#
# @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="K80", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
				
				# Rate parameters should not be negative:
				if(any(this$.k80.params < 0 )){
					throw("Found negative K80 rate parameters!\n");
				}
				else {

					if(
				  		this$.gtr.params[["a"]]!=this$.k80.params[["Alpha"]]|
          					this$.gtr.params[["b"]]!=this$.k80.params[["Beta"]]|
          					this$.gtr.params[["c"]]!=this$.k80.params[["Beta"]]|
          					this$.gtr.params[["d"]]!=this$.k80.params[["Beta"]]|
          					this$.gtr.params[["e"]]!=this$.k80.params[["Beta"]]|
          					this$.gtr.params[["f"]]!=this$.k80.params[["Alpha"]]
					 ) {
							throw("The K80 parameters are not consistent with the GTR parameters!\n");
						}
						else if ( !all.equal(as.numeric(this$.equ.dist), as.numeric(rep(0.25,times=4)) ) ){
							throw("The equlibrium distribution of the K80 model should be uniform!\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: summary.K80
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="K80", 
	function(
		object,
		...
	){

		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "K80") {
			this$.summary$"Rate parameters"<-paste(names(this$.k80.params),this$.k80.params,sep=" = ",collapse=", ");
		}
		this$.summary$"Transition/transversion rate ratio"<-(this$.k80.params[["Alpha"]]/this$.k80.params[["Beta"]]);

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of K80 methods ############

##	
## Constructor: K81
##	
## M. Kimura, Estimation of evolutionary sequences between homologous nucleotide sequences,
## Proc. Natl. Acad. Sci. USA 78 (1981), pp. 454-458.
##
##########################################################################/** 
#
# @RdocClass K81
# 
# @title "The K81 class"
# 
# \description{ 
#	This class implements the K81 (Kimura 3-parameter) GTR-submodel.
#
#	The rate parameters are the following: "Alpha", "Beta","Gamma".
#	@classhierarchy
# }
# \references{
# Kimura, M (1981) Estimation of evolutionary sequences between homologous nucleotide sequences -
# Proc. Natl. Acad. Sci. USA 78:454-458 \url{http://dx.doi.org/10.1073/pnas.78.1.454}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{Rate parameters.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-K81(rate.params=list( "Alpha"=10,"Beta"=2,"Gamma"=5))
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR UNREST GeneralSubstitution HKY
# }
# 
#*/###########################################################################
setConstructorS3(
  "K81",
  function( 
		name="Anonymous",
		rate.params=list(
				"Alpha"  	=1,
      				"Beta"    	=1,
				"Gamma"		=1
			),
			... 
		)	{
		
		this<-GTR();
		
		this<-extend(
			this,
			"K81",
			.k81.params=list(
					"Alpha"	 	=NA,
					"Beta"		=NA,
					"Gamma"		=NA
				)
			);

		this$name<-name;
		this$rateParamList<-rate.params;
		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha, Beta, Gamma.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K81 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters.
# } 
# 
# \examples{
#	# create K81 object
#	p<-K81()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha"=1,
#		"Beta"=0.5,
#		"Gamma"=2
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha"=1,
#		"Beta"=3,
#		"Gamma"=2
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="K81", 
	function(
		this,
		...
	){

		this$.k81.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	The rate parameters are: Alpha, Beta, Gamma.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K81 object.} 
#	\item{value}{A list containing the rate parameters.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of rate parameters (invisible).
# } 
# 
# \examples{
#	# create K81 object
#	p<-K81()
#	# set/get rate parameters
#	setRateParamList(p,list(
#		"Alpha"=1,
#		"Beta"=0.5,
#		"Gamma"=2
#        ))
#	getRateParamList(p)
#	# set/get rate parameters via virtual field
#	p$rateParamList<-list(
#		"Alpha"=1,
#		"Beta"=3,
#		"Gamma"=2
#        )
#	p$rateParamList
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="K81", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	else {

		# Get the rate parameter names:
		names<-names(this$.k81.params);
		value.names<-names(value);

		if(.checkRateParamList(this,names,value.names)) {

				this$.k81.params<-value;
				# Setting the GTR rate parameters:
				gtr.params<-list(
					"a"=value[["Alpha"]],
					"b"=value[["Beta"]],
					"c"=value[["Gamma"]],
					"d"=value[["Gamma"]],
					"e"=value[["Beta"]],
					"f"=value[["Alpha"]]
				);
				setRateParamList.GTR(this, value=gtr.params);

		}

	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha, Beta, Gamma.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K81 object.} 
#	\item{name}{The name of the rate parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The value of the rate parameter.
# } 
# 
# \examples{
#	# construct a K81 object
#	p<-K81();
#	# set/get a rate parameter
#	setRateParam(p,"Alpha",4)
#	getRateParam(p,"Gamma")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="K81", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam(this,name,this$.k81.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#	@get "title".
#
#	 The rate parameters are: Alpha, Beta, Gamma.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K81 object.} 
#	\item{name}{The name of the rate parameter.}
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#	# construct a K80 object
#	p<-K81();
#	# set/get a rate parameter
#	setRateParam(p,"Alpha",4)
#	getRateParam(p,"Gamma")
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="K81", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam(this,name,value,this$.k81.params);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#	@get "title".
#
#	The order of the frequency parameters must match with the order of symbols
#	in the NucleotideAlphabet objects. The K81 model has equal base frequencies.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A K81 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the base frequency parameters.
# } 
# 
# \examples{
#	# construct object
#	p<-K81()
#	# get base frequency parameters
#	getBaseFreqs(p) # uniform
#	# set/get base frequency parameters via virtual field
#	p$baseFreqs # uniform
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="K81", 
	function(
		this,
		...
	){

		getBaseFreqs.GTR(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
#
# @title "Forbidden action: setting the base frequency parameters for a K81 model"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="K81", 
	function(
		this,
		value,
		...
	){

		throw("You are not allowed to set the base frequencies for the K81 model!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency.K81
##	
###########################################################################/**
#
# @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="K81", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
				
				# Rate parameters should not be negative:
				if(any(this$.k81.params < 0 )){
					throw("Found negative K81 rate parameters!\n");
				}
				else {

					if(
				  	this$.gtr.params[["a"]]!=this$.k81.params[["Alpha"]]|
          	this$.gtr.params[["b"]]!=this$.k81.params[["Beta"]]|
          	this$.gtr.params[["c"]]!=this$.k81.params[["Gamma"]]|
          	this$.gtr.params[["d"]]!=this$.k81.params[["Gamma"]]|
          	this$.gtr.params[["e"]]!=this$.k81.params[["Beta"]]|
          	this$.gtr.params[["f"]]!=this$.k81.params[["Alpha"]]
						) {
							throw("The K81 parameters are not consistent with the GTR parameters!\n");
						}
						else if ( !all.equal(as.numeric(this$.equ.dist), as.numeric(rep(0.25,times=4)) ) ){
							throw("The equlibrium distribution of the K81 model should be uniform!\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: summary.K81
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="K81", 
	function(
		object,
		...
	){
		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "K81") {
		this$.summary$"Rate parameters"<-paste(names(this$.k81.params),this$.k81.params,sep=" = ",collapse=", ");
		}

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of K81 methods ############

##	
## Constructor: T92
##	
## Tamura, K. 1992. Estimation of the number of nucleotide substitutions when
## there are strong transition-transversion and G+C content biases. Molecular Biology and Evolution 9:678-687. 
##
##########################################################################/** 
#
# @RdocClass T92
# 
# @title "The T92 class"
# 
# \description{ 
#	This class implements the T92 GTR-submodel.
#
#	The rate parameters are the following: "Alpha", "Beta","Gamma".
#	The \code{theta} virtual field stores the GC content parameter.
#
#	@classhierarchy
# }
# \references{
# Tamura, K. (1992) Estimation of the number of nucleotide substitutions when
# there are strong transition-transversion and G+C content biases - Molecular Biology and 
# Evolution 9:678-687 \url{http://bit.ly/c6Pe0q}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{Rate parameters.}
#	\item{theta}{GC content (0.5 by default).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-T92(rate.params=list( "Alpha"=10,"Beta"=2),theta=0.8)
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR UNREST GeneralSubstitution HKY
# }
# 
#*/###########################################################################
setConstructorS3(
  "T92",
  function( 
		name="Anonymous",
		rate.params=list(
				"Alpha"  	=1,
      				"Beta"    	=1
			),
		theta=0.5, # GC content
		... 
		)	{
		
		this<-GTR();
		
		this<-extend(
			this,
			"T92",
			.theta=NA,
			.t92.params=list(
					"Alpha"	 	=NA,
					"Beta"		=NA
				)
			);

		this$name<-name;
		this$theta<-theta;
		this$rateParamList<-rate.params;
		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#       @get "title".
#
#       The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A T92 object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The list of rate parameters.
# } 
# 
# \examples{
#       # create a T92 object
#       p<-T92()
#       # set/get rate parameters
#       setRateParamList(p,list(
#               "Alpha"=1,
#               "Beta"=0.5
#        ))
#       getRateParamList(p)
#       # set/get rate parameters via virtual field
#       p$rateParamList<-list(
#               "Alpha"=1,
#               "Beta"=3
#        )
#       p$rateParamList
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="T92", 
	function(
		this,
		...
	){

		this$.t92.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#       @get "title".
#
#       The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A T92 object.} 
#       \item{value}{A list containing the rate parameters.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The list of rate parameters (invisible).
# } 
# 
# \examples{
#       # create a T92 object
#       p<-T92()
#       # set/get rate parameters
#       setRateParamList(p,list(
#               "Alpha"=1,
#               "Beta"=0.5
#        ))
#       getRateParamList(p)
#       # set/get rate parameters via virtual field
#       p$rateParamList<-list(
#               "Alpha"=1,
#               "Beta"=3
#        )
#       p$rateParamList
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="T92", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	else {

		# Get the rate parameter names:
		names<-names(this$.t92.params);
		value.names<-names(value);

		if(.checkRateParamList(this,names,value.names)) {

				# Set the rate parameters:
				# The parmeters are named as in 
				# "Ziheng Yang: Computational Molecular Evolution, Oxford university Press, Oxford, 2006", pp. 34.
			
				this$.t92.params<-value;
				# Setting the GTR rate parameters:
				gtr.params<-list(
          "a"=value[["Alpha"]],
          "b"=value[["Beta"]],
          "c"=value[["Beta"]],
          "d"=value[["Beta"]],
          "e"=value[["Beta"]],
          "f"=value[["Alpha"]]
        );
				setRateParamList.GTR(this, value=gtr.params);

		}

	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#       @get "title".
#
#        The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A T92 object.} 
#       \item{name}{The name of the rate parameter.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A numeric vector of length one.
# } 
# 
# \examples{
#       # construct a T92 object
#       p<-T92();
#       # set/get a rate parameter
#       setRateParam(p,"Alpha",4)
#       getRateParam(p,"Beta")
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="T92", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam(this,name,this$.t92.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#       @get "title".
#
#        The rate parameters are: Alpha, Beta.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A T92 object.} 
#       \item{name}{The name of the rate parameter.}
#       \item{value}{A numeric vector of length one.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#       # construct a T92 object
#       p<-T92();
#       # set/get a rate parameter
#       setRateParam(p,"Alpha",4)
#       getRateParam(p,"Beta")
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="T92", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam(this,name,value,this$.t92.params);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getTheta
##	
###########################################################################/**
#
# @RdocMethod getTheta
# 
# @title "Get the GC content" 
# 
# \description{ 
#       @get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A T92 object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A numeric vector of length one.
# } 
# 
# \examples{
#       # construct a T92 object
#       p<-T92()
#       # set/get GC content
#	setTheta(p,0.6)
#	getTheta(p)
#	# set/get GC content via virtual field
#	p$theta<-0.3
#	p$theta
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getTheta", 
	class="T92", 
	function(
		this,
		...
	){

		this$.theta;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setTheta
##	
###########################################################################/**
#
# @RdocMethod setTheta
# 
# @title "Set the GC content" 
# 
# \description{ 
#       @get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A T92 object.} 
#       \item{value}{A numeric vector of length one.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The new value of theta (invisible).
# } 
# 
# \examples{
#       # construct a T92 object
#       p<-T92()
#       # set/get GC content
#	setTheta(p,0.6)
#	getTheta(p)
#	# set/get GC content via virtual field
#	p$theta<-0.3
#	p$theta
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setTheta", 
	class="T92", 
	function(
		this,
		value,
		...
	){

		if(missing(value)){
			throw("No new value provided!\n");
		}
		else if(!is.numeric(value)){
			throw("Theta must be numeric!\n");
		}
		else if (length(value) != 1){
			throw("The value of theta must be a vector of length 1!\n");
		}
		else if(value > 1){
			throw("Theta (GC content) cannot be larger than 1!\n");
		}
		else {
			this$.theta<-value;
			# WARNING - here we rely on the T C G A symbol order in the nucleotide alphabet.
			base.freqs<-c(
				((1-this$.theta)/2),	# T
				(this$.theta/2),	# C
				((1-this$.theta)/2),	# A
				((this$.theta)/2)	# G
		);
	}
		# Set the GTR base frequencies:
		setBaseFreqs.GTR(this,base.freqs);	
		return(invisible(value));
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency.T92
##	
###########################################################################/**
#
# @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="T92", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
				
				# Rate parameters should not be negative:
				if(any(this$.t92.params < 0 ) | (this$.theta < 0)){
					throw("Found negative T92 rate parameters!\n");
				}
				else {

					if(
				  	this$.gtr.params[["a"]]!=this$.t92.params[["Alpha"]]|
          	this$.gtr.params[["b"]]!=this$.t92.params[["Beta"]]|
          	this$.gtr.params[["c"]]!=this$.t92.params[["Beta"]]|
          	this$.gtr.params[["d"]]!=this$.t92.params[["Beta"]]|
          	this$.gtr.params[["e"]]!=this$.t92.params[["Beta"]]|
          	this$.gtr.params[["f"]]!=this$.t92.params[["Alpha"]]
						) {
							throw("The HKY parameters are not consistent with the GTR parameters!\n");
						}

						# Checking if the equlibrium distribution is consistent with theta:
						base.freqs<-c(
							((1-this$.theta)/2),	# T
							(this$.theta/2),			# C
							((1-this$.theta)/2),	# A
							((this$.theta)/2)		  # G
						);
					
						if(any(!PSRoot$my.all.equal(base.freqs, this$equDist))){
								throw("Equlibrium distribution is not consistent with the theta value!\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: summary.T92
##	
###########################################################################/**
#
# @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<-T92(theta=0.8)
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="T92", 
	function(
		object,
		...
	){
		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "T92") {
			this$.summary$"Rate parameters"<-paste(names(this$.t92.params),this$.t92.params,sep=" = ",collapse=", ");
			this$.summary$"Theta (GC content)"<-this$.theta;
			this$.summary$"Transition/transversion rate ratio"<-(this$.t92.params[["Alpha"]]/this$.t92.params[["Beta"]]);
		}

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of T92 methods ############

##	
## Constructor: F84
##	
## Hasegawa, M., H. Kishino, and T. Yano. (1985) Dating of human-ape splitting by a molecular clock
## of mitochondrial DNA. Journal of Molecular Evolution, 22, 160-174.
##
##########################################################################/** 
#
# @RdocClass F84
# 
# @title "The F84 class"
# 
# \description{ 
#	This class implements the F84 GTR-submodel.
#
#	The rate parameters are the following: Kappa.
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Object name.}
#	\item{rate.params}{Rate parameters.}
#	\item{base.freqs}{Base frequency parameters.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create substitution process object
#       p<-F84(rate.params=list( "Kappa"=2), base.freqs=c(1,2,3,4))
#       # get a summary
#       summary(p)
#	# display a bubble plot
#	plot(p)
#
#	# The following code demonstrates how to use 
#	# the process in a simulation.
#
#	# create a sequence, attach process p
#	s<-NucleotideSequence(length=20,processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# make the first five positions invariable
#	setRateMultipliers(s,p,0,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)
#	# create a simulation object
#	sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
#	# run simulation
#	Simulate(sim)
#	# print alignment
#	sim$alignment
# }
# 
# @author
#
# \seealso{ 
# 	GTR UNREST GeneralSubstitution HKY
# }
# 
#*/###########################################################################
setConstructorS3(
  "F84",
  function( 
		name="Anonymous",
		rate.params=list(
			"Kappa"   = 0
			),
		base.freqs=c(0.25,0.25,0.25,0.25)
		)	{
		
		this<-GTR();
		
		this<-extend(
			this,
			"F84",
			.f84.params=list(
					"Kappa"	 	=NA
				)
			);

		this$name<-name;
		this$baseFreqs<-base.freqs;
		this$rateParamList<-rate.params;
		return(this);
	
  },
  enforceRCC=TRUE
);

##	
## Method: getRateParamList
##	
###########################################################################/**
#
# @RdocMethod getRateParamList
# 
# @title "Get the rate parameters" 
# 
# \description{ 
#       @get "title".
#
#       The rate parameters are: Kappa.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A F84 object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The list of rate parameters.
# } 
# 
# \examples{
#       # create F84 object
#       p<-F84()
#       # set/get rate parameters
#       setRateParamList(p,list("Kappa"=3))
#       getRateParamList(p)
#       # set/get rate parameters via virtual field
#       p$rateParamList<-list("Kappa"=2.5)
#       p$rateParamList
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParamList", 
	class="F84", 
	function(
		this,
		...
	){

		this$.f84.params;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParamList
##	
###########################################################################/**
#
# @RdocMethod setRateParamList
# 
# @title "Set the rate parameters" 
# 
# \description{ 
#       @get "title".
#
#       The rate parameters are: Kappa.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A F84 object.} 
#       \item{value}{A list containing the rate parameters.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The list of rate parameters (invisible).
# } 
# 
# \examples{
#       # create F84 object
#       p<-F84()
#       # set/get rate parameters
#       setRateParamList(p,list("Kappa"=3))
#       getRateParamList(p)
#       # set/get rate parameters via virtual field
#       p$rateParamList<-list("Kappa"=2.5)
#       p$rateParamList
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParamList", 
	class="F84", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.list(value)){
		throw("The provided value must be a list!\n");
	}
	else if(any((as.numeric(value)) < 0)){
 		throw("Cannot set negative rate parameter!\n");
	}
	else {

		# Get the rate parameter names:
		names<-names(this$.f84.params);
		value.names<-names(value);

		if(.checkRateParamList(this,names,value.names)) {

				this$.f84.params<-value;
				# Setting the GTR rate parameters:
  			kappa<-value[["Kappa"]];
        y<-(this$.equ.dist[1,"T"] + this$.equ.dist[1,"C"] );
        r<-(this$.equ.dist[1,"A"] + this$.equ.dist[1,"G"] );
        gtr.params<-list(
          "a"=(1 + (kappa/y) ),
          "b"=1,
          "c"=1,
          "d"=1,
          "e"=1,
          "f"=(1 + (kappa/r) )
        );
				setRateParamList.GTR(this, value=gtr.params);

		}

	}
		return(invisible(value));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateParam
##	
###########################################################################/**
#
# @RdocMethod getRateParam
# 
# @title "Get the value of a rate parameter" 
# 
# \description{ 
#       @get "title".
#
#        The rate parameters are: Kappa.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A F84 object.} 
#       \item{name}{The name of the rate parameter.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A numeric vector of length one.
# } 
# 
# \examples{
#       # create F84 object
#       p<-F84()
#       # set/get rate parameters
#       setRateParamList(p,list("Kappa"=3))
#       getRateParamList(p)
#       # set/get rate parameters via virtual field
#       p$rateParamList<-list("Kappa"=2.5)
#       p$rateParamList
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateParam", 
	class="F84", 
	function(
		this,
		name,
		...
	){

		if(missing(name)){
			throw("No rate parameter name specified!\n");
		}
		else {
			.getRateParam.GTR(this,name,this$.f84.params);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateParam
##	
###########################################################################/**
#
# @RdocMethod setRateParam
# 
# @title "Set the value of a rate parameter" 
# 
# \description{ 
#       @get "title".
#
#        The rate parameters are: Kappa.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A F84 object.} 
#       \item{name}{The name of the rate parameter.}
#       \item{value}{A numeric vector of length one.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The new value of the rate parameter (invisible).
# } 
# 
# \examples{
#       # construct a F84 object
#       p<-F84();
#       # set/get a rate parameter
#       setRateParam(p,"Kappa",4)
#       getRateParam(p,"Kappa")
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateParam", 
	class="F84", 
	function(
		this,
		name,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(name)){
			throw("No rate parameter name specified!\n");
		} else {
			.setRateParam.GTR(this,name,value,this$.f84.params);
		}
		return(invisible(value));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getKappa
##	
###########################################################################/**
#
# @RdocMethod getKappa
# 
# @title "Get the transition transversion rate ratio" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A F84 object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#       # construct a F84 object
#       p<-F84();
#	# set/get Kappa
#	setKappa(p,2)
#	getKappa(p)
#	# set/get Kappa via virtual field
#	p$kappa<-4
#	p$kappa
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getKappa", 
	class="F84", 
	function(
		this,
		...
	){

			getRateParam.F84(this, "Kappa");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setKappa
##	
###########################################################################/**
#
# @RdocMethod setKappa
# 
# @title "Get the transition transversion rate ratio" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A F84 object.} 
#	\item{value}{A numeric vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of Kappa (invisible).
# } 
# 
# \examples{
#       # construct a F84 object
#       p<-F84();
#	# set/get Kappa
#	setKappa(p,2)
#	getKappa(p)
#	# set/get Kappa via virtual field
#	p$kappa<-4
#	p$kappa
#	# get object summary
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setKappa", 
	class="F84", 
	function(
		this,
		value,
		...
	){

			setRateParam.F84(this,"Kappa",value);
			return(invisible(value));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod getBaseFreqs
# 
# @title "Get the base frequency parameters" 
# 
# \description{ 
#       @get "title".
#
#       The order of the frequency parameters must match with the order of symbols
#       in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A F84 object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A matrix containing the base frequency parameters.
# } 
# 
# \examples{
#       # construct object
#       p<-F84()
#       # set/get base frequency parameters
#       setBaseFreqs(p,c(2,1,2,1)/6)
#       getBaseFreqs(p)
#       # set/get base frequency parameters via virtual field
#       p$baseFreqs<-c(4,4,1,1)/10
#       p$baseFreqs
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBaseFreqs", 
	class="F84", 
	function(
		this,
		...
	){

		getBaseFreqs.GTR(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBaseFreqs
##	
###########################################################################/**
#
# @RdocMethod setBaseFreqs
# 
# @title "Set the base frequency parameters" 
# 
# \description{ 
#       @get "title".
#
#       The order of the frequency parameters must match with the order of symbols
#       in the NucleotideAlphabet objects.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A F84 object.} 
#       \item{value}{A vector of base frequencies.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       value (invisible)
# } 
# 
# \examples{
#       # construct object
#       p<-F84()
#       # set/get base frequency parameters
#       setBaseFreqs(p,c(2,1,2,1)/6)
#       getBaseFreqs(p)
#       # set/get base frequency parameters via virtual field
#       p$baseFreqs<-c(4,4,1,1)/10
#       p$baseFreqs
#       # get object summary
#       summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setBaseFreqs", 
	class="F84", 
	function(
		this,
		value,
		...
	){

		setBaseFreqs.GTR(this,value);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency.F84
##	
###########################################################################/**
#
# @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="F84", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
				
				# Rate parameters should not be negative:
				if( any(this$.f84.params < 0 ) ){
					throw("Found negative F84 rate parameters!\n");
				}
				else {
  			kappa<-this$.f84.params[["Kappa"]];
        y<-(this$.equ.dist[1,"T"] + this$.equ.dist[1,"C"] );
        r<-(this$.equ.dist[1,"A"] + this$.equ.dist[1,"G"] );

        gtr.params<-list(
          "a"=(1 + (kappa/y) ),
          "b"=1,
          "c"=1,
          "d"=1,
          "e"=1,
          "f"=(1 + (kappa/r) )
        );

				if(any(names(gtr.params) != names(this$.gtr.params)) | any(!PSRoot$my.all.equal(as.numeric(gtr.params), as.numeric(this$.gtr.params) ) )){
						throw("The Kappa value is not consistent with the GTR rate parameters!\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: summary.F84
##	
###########################################################################/**
#
# @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<-F84(rate.params=list("Kappa"=3))
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="F84", 
	function(
		object,
		...
	){
		this<-object;
		.addSummaryNameId(this);
    .addSummaryAlphabet(this);
		if (class(this)[[1]] == "F84") {
			this$.summary$"Rate parameters"<-paste(names(this$.f84.params),this$.f84.params,sep=" = ",collapse=", ");
		}

		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

######### end of F84 methods ############
##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	

##
## Constructor: PSRootSummary
##
##########################################################################/** 
#
# @RdocClass PSRootSummary
# 
# @title "The PSRootSummary class"
# 
# \description{ 
#	PSRootSummary objects are blessed lists containing summary entries created by
#	\code{summary.*} methods.
#	
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{summary}{A list.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# @author
#
# \seealso{ 
# 	@seeclass 
# }
# 
#*/###########################################################################
setConstructorS3(
  "PSRootSummary",
  function(summary=list(),...){
			
			# Stepping out of the R.oo framework to provide 
			# the expected behaviour.
			class(summary)<-c("PSRootSummary");
			summary;
  },
  ###
  enforceRCC=FALSE
);

##
## Method: print.PSRootSummary
##
###########################################################################/**
#
# @RdocMethod print
# 
# @title "Print out a PSRootSummary object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A PSRootSummary object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The summary object (invisible).
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "print",
  class="PSRootSummary",
  appendVarArgs=FALSE,
  function(
    x,
    ...
  ){
	this<-x;
	cat("\n");
	for (i in names(this)){
        cat(paste(i,": ",this[[i]],"\n",sep=""));
   	}
		cat("\n");
		invisible(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: checkConsistency;
##
###########################################################################/**
#
# @RdocMethod	checkConsistency
# 
# @title "Check object consistency"
# 
# \description{ 
#		@get "title".
#		The consisntency check is not implemented for PSRootSummary objects,
#		the method prints out a warning about that.
# } 
# 
# @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="PSRootSummary",
  function(
		this,
    ...
  ){
		
		warning("Consistency check is not implemented in class ",class(this)[[1]],"!\n");	
		return(invisible(TRUE));
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##########################################################################/** 
#
# @RdocClass PSRoot
# 
# @title "The root class for all phylosim objects"
# 
# \description{ 
#		The root class for all phylosim objects containig some utility methods. 
#		@classhierarchy
# }
#	
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#	
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#		obj<-PSRoot();
#		ll(obj);
# }
# 
# @author
#
#
# \seealso{ 
# 	Object
# }
# 
#*/###########################################################################
setConstructorS3(
  "PSRoot",
  function(...){
  extend(Object(), "PSRoot",
		.comments=character(0),
		.summary=list()
  );
  },
  ###
  enforceRCC=TRUE
);


##	
## Method: virtualAssignmentForbidden
##	
###########################################################################/**
#
# @RdocMethod virtualAssignmentForbidden
# 
# @title "Throws an error message informing the user about forbidden action on virtual a field" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Throws an error.
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"virtualAssignmentForbidden", 
	class="PSRoot", 
	###
	function(
		this,
		...
	){
		throw("You cannot set the value of this virtual field directly!");
	},
	###
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: enableVirtual
##	
###########################################################################/**
#
# @RdocMethod enableVirtual
# 
# @title "Enable the use of virtual fields for a given object" 
# 
# \description{ 
#	@get "title".
#	R.oo disables the virtual field feature inside get/set methods. This method can be used to re-enable virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PSRoot object.
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"enableVirtual", 
	class="PSRoot", 
	###
	function(
		this,
		...
	){
			attr(this,"disableGetMethods")<-NULL;
			attr(this,"disableSetMethods")<-NULL;
			this;
	},
	###
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: stringLength
##	
###########################################################################/**
#
# @RdocDefault stringLength
# 
# 
# @title "Returns the string length of the character representation of an object" 
# 
# \description{ 
#	@get "title".
#	More useful as a static method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An integer vector of length one.
# } 
# 
# \examples{
#	x<-"character representaion"
#	# get the strign length of x
#	stringLength(x)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"stringLength", 
	class="default", 
	function(
		this,
		...
	){
		
		this<-as.character(this);	
		if (length(this) != 1){throw("This function can handle only vectors of length 1!")};

		return(length(strsplit(this,split="",fixed=TRUE)[[1]]));	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: stringLengthVector
##	
###########################################################################/**
#
# @RdocDefault stringLengthVector
# 
# 
# @title "Returns the string lengths of the character represenations of a collection of objects" 
# 
# \description{ 
#	@get "title".
#	More useful as a static method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An array or a list of object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An integer vector with the corresponding lengths.
# } 
# 
# \examples{
#	x<-c("character representaion","other string");
#	# get the strign length of x
#	stringLengthVector(x)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"stringLengthVector", 
	class="default", 
	function(
		this,
		...
	){
	
		as.numeric(apply(as.array(this),1,stringLength));
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getMethodsList
###########################################################################/**
#
# @RdocMethod getMethodsList
# 
# @title "Get the list of applicable methods for an object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list of applicable methods.
# } 
# 
# \examples{
#	# create an object
#	o<-PSRoot()
#	# get the applicable methods
#	getMethodsList(o)
#	# get methods via virtual field
#	o$methodsList
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
##
setMethodS3(
  "getMethodsList",
  class="PSRoot",
  function(
    this,
    ...
  ){

            cls   <- class(this)[[1]]
            clazz <- Class$forName(cls);
            mlist <- getMethods(clazz);

			# If the class has no methods, do not 
			# consider the methods from the parent class.
			if(names(mlist)[[1]] == cls){	
      			as.character(names(mlist[[1]]));
			}
			else {
				return(character(0));
			}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: setMethodsList
##
###########################################################################/**
#
# @RdocMethod setMethodsList
#
# @title "Forbidden action: setting the list of applicable methods for an object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setMethodsList",
  class="PSRoot",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: ll
##
###########################################################################/**
#
# @RdocMethod ll
# 
# @title "Display detailed information about the virtual fields and methods defined for a given object" 
# 
# \description{ 
#	@get "title".
#	The method prints the class of the object, all the parent classes,
#	and the virtual fields and methods defined in the immediate class.
#
#	This method provides a "quick and minimal" documentation for PhyloSim classes.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
# 	\item{quiet}{Do not print out methods list.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Text.
# } 
# 
# \examples{
#	# create a Site object
#	s<-Site()
#	ll(s)
#	# get information about the Process class
#	ll(Process())
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "ll",
  class="PSRoot",
  function(
    this,
    quiet=FALSE,
    ...
  ){
		
		class<-class(this);
		parents<-class[-1];
		class<-class[[1]]
		methods<-getMethodsList(this);
		fields<-getFields(this);
		text<-character(0);	

		pretty.print<-function(vec,text){

				tmp<-"";
				if(length(vec) > 0 ){
					tmp<-paste(tmp,"  ",vec,sep="",collapse="\n");
				  paste(text,tmp,"\n",sep="");
				} else {
					return(text);
				}
		}

	
		text<-paste(text,"\nClass: ",class,"\n",sep="");
		text<-paste(text,"Inherits from: ",paste(parents,collapse=" "),"\n",sep="");
		text<-paste(text,"Fields (",length(fields),"):\n",sep="");
		text<-pretty.print(fields,text);	

		# Discriminate between the methods implementing 
		# virtual fileds and the rest:
	
		vfields<-character(0);
		methods.not.virtual<-character(0);

		num.args<-function(fun){
			length(formals(fun))
		}

		method.to.field<-function(method){

			 method<-sub('^(get|set)(.*)','\\2',method);
			 tmp<-as.array(strsplit(method,"",fixed=TRUE))[[1]];
       tmp[1]<-tolower(tmp[1]);
       paste(tmp,collapse="");			

		}

		classify.method<-function(method,limit) {

				if( num.args( paste(method,".",class(this)[[1]],sep="") ) == limit){
                vfields<<-c(vfields,method.to.field(method));
            } else {
              methods.not.virtual<<-c(methods.not.virtual,method);
            }

		}

		for(method in methods){
			
				# Get methods for virtual fields have 2 aguments: "this" and "...".
				if(length(grep("^get",method,perl=TRUE)) == 1) {
					classify.method (method,limit=2)
				}
				# Set methods for virtual fields have 3 aguments: "this", "..." and "value".
				else if (length(grep("^set",method,perl=TRUE)) == 1) {
					classify.method (method,limit=3)
				} else {
					methods.not.virtual<-c(methods.not.virtual,method);
				}
		
		}
		vfields<-sort(unique(vfields));	

		lapply(methods.not.virtual,
			function(name) {
				tmp<-method.to.field(name);
				if (length(intersect(tmp,vfields)) > 0 ) {
					print(intersect(tmp,vfields));
					throw("Method classification inconsistency! Blaming ",paste(intersect(tmp,vfields),collapse=" "),". \n");
				}
			}
		);
		
		text<-paste(text,"Virtual fields (",length(vfields),"):\n",sep="");
		text<-pretty.print(vfields,text);
		text<-paste(text,"Methods implemented in ",class," (",length(methods.not.virtual),"):\n",sep="");
		text<-pretty.print(sort(methods.not.virtual),text);
		text<-paste(text,"\n",sep="");
		
		if(!quiet){ cat(text) }	

		invisible(text);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: getComments
##
###########################################################################/**
#
# @RdocMethod getComments
# 
# @title "Get the comments associated with an object" 
# 
# \description{ 
#	@get "title".
#
#	The comment field can contain any type of object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The value of the comment field.
# } 
# 
# \examples{
#	# create an object
#	o<-PSRoot()
#	# add some comments
#	setComments(o,"Random comment")
#	# get the comment 
#	getComments(o)
#	# get/set the comment via virtual fiels
#	o$comments<-"Second random comment"
#	o$comments
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getComments",
  class="PSRoot",
  function(
    this,
    ...
  ){
			this$.comments;
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: setComments
##
###########################################################################/**
#
# @RdocMethod setComments
# 
# @title "Set the comments associated with an object" 
# 
# \description{ 
#	@get "title".
#
#	The comment field can contain any type of object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
#	\item{new_value}{An object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new value of the comment field (invisible).
# } 
# 
# \examples{
#	# create an object
#	o<-PSRoot()
#	# add some comments
#	setComments(o,"Random comment")
#	# get the comment 
#	getComments(o)
#	# get/set the comment via virtual fiels
#	o$comments<-"Second random comment"
#	o$comments
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setComments",
  class="PSRoot",
  function(
    this,
    new_value,
    ...
  ){
			this$.comments<-new_value;
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: PSRoot$my.all.equal
##
###########################################################################/**
#
# @RdocMethod my.all.equal
# 
# @title "Test if two objects are nearly equal" 
# 
# \description{ 
#	@get "title".
#	
#	This method simply calls \code{all.equal.default} with the tolerance parameter set to 
#	\code{.Machine$double.eps ^ 0.5}. More useful as a static method.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{static}{A PSRoot object.} 
#	\item{target}{R object.}
#	\item{current}{Other R object, to be compared with target.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	TRUE or FALSE. 
# } 
# 
# \examples{
#	PSRoot$my.all.equal(0.0,0.0001)	
#	PSRoot$my.all.equal(0.0,0.000000001)	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "my.all.equal",
  class="PSRoot",
  function(
    static,
    target,
    current,
    ...
  ){

		static;
		one<-target;
		two<-current;

		TOLERANCE<-.Machine$double.eps ^ 0.5;
		if(missing(one) | missing (two)){
			throw("Two objects are needed for comparison!\n");
		}
		else {
			one<-as.double(one);
			two<-as.double(two);
			return(isTRUE(all.equal(one,two, tolerance=TOLERANCE)));
		}
		

  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: summary.PSRoot
##
###########################################################################/**
#
# @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<-PSRoot()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="PSRoot",
  function(
    object,
    ...
  ){
		this<-object;	
		# Adding the Comments field:
		if(length(this$.comments) > 0 ) {
		this$.summary$Comments<-paste(this$.comments, collapse=", ");
		}
		
		obj<-PSRootSummary(summary=this$.summary);
		this$.summary<-list();
		# Return a summary object:
		return(obj);

	},
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: is.na.PSRoot
##
###########################################################################/**
#
# @RdocMethod is.na
# 
# @title "Check if a PSRoot object is NA" 
# 
# \description{ 
#	@get "title".
#	PSRoot objects accanot be NA, so this method always returns FALSE.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A PSRoot object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	FALSE
# } 
# 
# \examples{
#	is.na(PSRoot());
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "is.na",
  class="PSRoot",
  function(
    x,
    ...
  ){
		
		# We don't want our objects to be NA-s!	
		return(FALSE);
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: checkConsistency;
##
###########################################################################/**
#
# @RdocMethod	checkConsistency
# 
# @title "Check object consistency"
# 
# \description{ 
#		@get "title".
#		The consisntency check is not implemented in plain PSRoot objects,
#		the method prints out a warning about that.
# } 
# 
# @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="PSRoot",
  function(
    this,
    ...
  ){
		
		warning("Consistency check is not implemented in class ",class(this)[[1]],"!\n");	
		return(invisible(TRUE));
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: globalConsistencyCheck
##
###########################################################################/**
#
# @RdocMethod globalConsistencyCheck
# 
# @title "Check the consistency of all objects inheriting form PSRoot in the current environment" 
# 
# \description{ 
#	@get "title".
#
#	This method searches for objects which inherit from PSRoot and calls \code{checkConsistency()} for all of them,
#	which can take a lots of time. Prints the results of the checks as text.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Returns invisible TRUE if all checks are successful.
# } 
# 
# \examples{
#	# create some objects
#	a<-NucleotideAlphabet()
#	s<-Site()
#	p<-Process()
#	# ask for a global consistency check
#	PSRoot$globalConsistencyCheck();
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "globalConsistencyCheck",
  class="PSRoot",
  function(
    ...
  ){
		
		for(name in ls(envir=.GlobalEnv)) {
				obj<-get(name,envir=.GlobalEnv);
				if (is.PSRoot(obj)) {
					cat("Checking ",name," ... ");	
					if( checkConsistency((obj)) ) {
							cat("OK\n");
					}
				}
		}
		return(invisible(TRUE));
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: plot.PSRoot
##
setMethodS3(
  "plot",
  class="PSRoot",
  function(
    ...
  ){
	
		cat("No plot method defined for this object!\n");	
		return(invisible(FALSE));
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: intersect.list.PSRoot
##
###########################################################################/**
#
# @RdocMethod intersect.list
# 
# @title "Utility method returning the intersection of two lists" 
# 
# \description{ 
#	@get "title".
#	Duplicated elements are not considered.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PSRoot object.} 
#	\item{one}{A list of objects.}
#	\item{two}{A list of objects.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The list containing the intersection.
# } 
# 
# \examples{
#	# create some lists
#	a<-list(1,2,3);
#	b<-c(a,list("a","b","c"))
#	# get the intersection of a and b
#	PSRoot$intersect.list(a,b)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "intersect.list",
  class="PSRoot",
  function(
    this,
    one,
    two,
    ...
  ){

	if(!is.list(one)){
		throw("The first argument is not a list!\n");
	}
	if(!is.list(two)){
		throw("The second argument is not a list!\n");
	}

	one<-unique(one);
	two<-unique(two);
	intersect<-list();
        for (i in one){
        	for (j in two){
        		if(i == j) {
        	   		intersect<-c(intersect,list(i));
                	}
              }
        }
	return(intersect);
		
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);

##
## Method: is.PSRoot.default
##
###########################################################################/**
#
# @RdocDefault is.PSRoot
# 
# @title "Check if an object inherits from PSRoot" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create some objects
#	o<-PSRoot()
#	a<-Alphabet()
#	x<-Object()
#	# check if they inherit form PSRoot
#	is.PSRoot(o)
#	is.PSRoot(a)
#	is.PSRoot(x)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "is.PSRoot",
  class="default",
  function(
    this,
    ...
  ){

		if(!is.object(this)) {return(FALSE)}
		inherits(this,"PSRoot");
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=TRUE,
  conflict="warning"
);
##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass PhyloSim
# \alias{phylosim}
# 
# @title "The PhyloSim class"
# 
# \description{ 
#
#	PhyloSim is an extensible object-oriented framework for the Monte Carlo simulation 
#	of sequence evolution written in 100 percent \code{R}.
#	It is built on the top of the \code{\link{R.oo}} and \code{\link{ape}} packages and uses 
#	Gillespie's direct method to simulate substitutions, insertions and deletions.
#
#	Key features offered by the framework:	
#	\itemize{
#	\item  Simulation of the evolution of a set of discrete characters with arbitrary states evolving 
#		by a continuous-time Markov process with an arbitrary rate matrix.
#	\item Explicit implementations of the most popular substitution models (for nucleotides, amino acids and codons).
# 	\item Simulation under the popular models of among-sites rate variation, like the gamma (+G) and invariants plus gamma (+I+G) models.
#	\item The possibility to simulate with arbitrarily complex patterns of among-sites rate variation by setting the site specific rates according to any \code{R} expression.
#	\item Simulation with one or more separate insertion and/or deletion processes acting on the sequences, which sample the insertion/deletion length from an arbitrary discrete distribution or an \code{R} expression (so all the probability distributions implemented in \code{R} are readily available for this purpose).
#	\item Simulation of the effects of variable functional constraints over the sites by site-process-specific insertion and deletion tolerance parameters, which determine the rejection probability of a proposed insertion/deletion.
#	\item The possibility of having a different set of processes and site-process-specific parameters for every site, which allow for an arbitrary number of partitions in the simulated data.
#	\item Simulation of heterotachy and other cases of non-homogeneous evolution by allowing the user to set "node hook" functions altering the site properties at internal nodes of the phylogeny.
#	\item The possibility to export the counts of various events ("branch statistics") as phylo objects (see \code{\link{exportStatTree.PhyloSim}}).
#	}
#
#	General notes:
#	\itemize{
#	\item The \code{Sequence} objects have no "immortal links". The simulation
#	is aborted if the sequence length shrinks to zero. It is up to the user 
#	to choose sensible indel rates and sequence lengths to prevent that.
#	\item The sites near the beginning and end of the sequences have less sites proposing
#	insertion and deletion events around the so the insertion and deletion processes 
#	have an "edge effect". The user can simulate
#	realistic flanking sequences to alleviate the edge effect in the simulation settings where
#	it may be an issue.
# }
#
#	Notes on performance: 
#	\itemize{
#	\item The pure \code{R} implementation offers felxibility, but also comes
#	with a slower simulation speed. If the \code{PSIM_FAST} object is present in the environment, a "fast & careless"
#	mode is enabled. In this mode most of the error checking is skipped, increasing the speed.
#	It is recomended that simulations are only run in fast mode if you are sure that the simulation
#	settings are free from errors. It is probably a good practice to set up the simulations in normal mode
#	with short sequences and enable fast mode when running the actual simulation with long sequences.
#	\item Please note, that no "branch statistics" are saved in fast mode.
#	\item Logging also has a negative impact on performance, so it's not a good idea to run
#	large simulations with the logging enabled.
#	\item The time needed to run a simulation depends not only on the number of the sites, 
#	but also on the length of the tree.
#	\item Constructing \code{Sequence} objects with large number of sites is expensive. Avoid doing
#	that inside a cycle.
#	\item In the case of \code{Sequence} objects with a large number of sites (more than 10 000) the 
#	amount of available memory can be limiting as well.
#  }
#
#	The examples below demonstrate only some more common simulation settings,
#	the framework offers much more flexibility. See the package
#	vignette (\code{vignette("PhyloSim",package="phylosim")}) and the
#	examples directory (\url{http://github.com/bsipos/phylosim/tree/master/examples/}) 
#	for additional examples.
#	
#	@classhierarchy
# }
#
#
# \references{
#	Gillespie, DT (1977) Exact stochastic simulation of coupled chemical reactions - 
#	J. Phys. Chem. 81 (25):2340-2361 \url{http://dx.doi.org/10.1021/j100540a008}
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{phylo}{A rooted phylo object, constructed by the APE package.}
# 	\item{root.seq}{A valid Sequence object with Process objects attached. Used as the starting sequence during simulation.}
# 	\item{name}{The name of the object (a character vector of length one).}
# 	\item{log.file}{Name of the file used for logging.}
# 	\item{log.level}{An integer specifying the verbosity of logging (see \code{\link{setLogLevel.PhyloSim}}).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#   set.seed(1)
#	## The following examples demonstrate
#	## the typical use of the framework.
#	## See the package vignette and
#	## \url{http://github.com/bsipos/phylosim/tree/master/examples/}
#
#	## The ll() method gives information about the methods defined
#	## in the immediate class of an object.
#	## Useful when exploring the framework.
#
#	s<-Sequence()
#	ll(s)
#	ll(PhyloSim())
#	ll(GTR())
#
#	## Example 1 - A short simulation:
#	## simulate nucleotide seqeunces and display 
#	## the resulting alignment matrix.
#
#	Simulate(
#		PhyloSim(phy=rcoal(3),
#       root=NucleotideSequence(string="ATGC", proc=list(list(JC69())) ) )
#	)$alignment
#
#	# Construct a phylo object for the following
#	# simulations, scale total tree length to 1:
#
#	tmp<-PhyloSim(phylo=rcoal(3))
#	scaleTree(tmp,1/tmp$treeLength)
#	tmp$treeLength
#	t<-tmp$phylo
#
#	## Example 3 - simulating rate variation,
#	## insertions and deletions.
#	## See the examples/example_3_clean.R file
#	## in the phylosim GitHub repository.
#
#	# construct a GTR process object
#       gtr<-GTR(
#		name="MyGTR",
#               rate.params=list(
#                       "a"=1, "b"=2, "c"=3,
#                       "d"=1, "e"=2, "f"=3
#               ),
#               base.freqs=c(2,2,1,1)/6
#       )
#	# get object summary
#	summary(gtr)
#	# display a bubble plot
#	plot(gtr)
#
#	# construct root sequence object
#	s<-NucleotideSequence(length=20)
#	# attach process via virtual field
#	s$processes<-list(list(gtr))
#	# sample states from the equilibrium
#	# distribution of the attached processes
#	sampleStates(s)
#	# create among-site rate variation by sampling
#	# the "rate.multiplier" site-process-specific parameter
#	# from a discrete gamma distribution (GTR+G).
#	plusGamma(s,gtr,shape=0.1)
#	# make the range 11:12 invariable
#	setRateMultipliers(s,gtr,0,11:12)
#	# get the rate multipliers for s and gtr
#	getRateMultipliers(s,gtr)
#
	# construct a deletion process object
#	# proposing lengths in the range 1:3
#	d<-DiscreteDeletor(
#		rate=0.1,
#		name="MyDel",
#		sizes=c(1:3),
#		probs=c(3/6,2/6,1/6)
#	)
#	# get object 
#	summary(d)
#	# plot deletion length distribution
#	plot(d)
#	# attach deletion process d to sequence s
#	attachProcess(s,d)
# 	# create a region rejecting all deletions
#       setDeletionTolerance(s,d,0,11:12)
#
#	# construct an insertion process object
#	# proposing lengths in the range 1:3
#	i<-DiscreteInsertor(
#		rate=0.1,
#		name="MyDel",
#		sizes=c(1:2),
#		probs=c(1/2,1/2),
#		template.seq=NucleotideSequence(length=1,processes=list(list(JC69())))
#	) 
# 	# states will be sampled from the JC69 equilibrium distribution
#	# get object 
#	summary(i)
#	# plot insertion length distribution
#	plot(i)
#	# attach insertion process i to sequence s
#	attachProcess(s,i)
# 	# create a region rejecting all insertions
#       setInsertionTolerance(s,i,0,11:12)
#
#	# plot total site rates
#	plot(s)
#	# construct simulation object
#	sim<-PhyloSim(root.seq=s, phylo=t)
#	# get object summary
#	summary(sim)
#	# plot tree
#	plot(sim)
#	# run simulation
#	Simulate(sim)
# 	# get the list of recorded per-branch event counts
# 	getBranchEvents(sim)
#	# export the number of substitutions as a phylo object
#	subst<-exportStatTree(sim,"substitution")
#	# plot the exported phylo object
#	plot(subst)
#	# plot tree and alignment
#	plot(sim)
#	# save and display alingment
#	file<-paste("PhyloSim_dummy_fasta_",Sys.getpid(),".fas",sep="");
#	saveAlignment(sim,file=file);
#	# print out the Fasta file
#	cat(paste(scan(file=file,what=character(),sep="\n"),collapse="\n"));cat("\n");
#	# delete Fasta file
#	unlink(file);
#
#   # See \url{http://github.com/bsipos/phylosim/tree/master/examples/examples_class.R}
#   # for the full list of PhyloSim constructor examples.
#   
#	## See the package vignette and 
#	## the GitHub repository for even more examples.
# }
# 
# @author
#
# \seealso{ 
#	\code{\link{PSRoot} \link{Alphabet} \link{AminoAcidAlphabet} 
#	\link{AminoAcidSequence} \link{AminoAcidSubst}
#	\link{AnyAlphabet} \link{BinaryAlphabet} \link{BinarySequence} 
#	\link{BinarySubst} \link{BrownianInsertor} \link{CodonAlphabet}
#	\link{CodonSequence} \link{CodonUNREST} \link{ContinuousDeletor}
#	\link{ContinuousInsertor} \link{cpREV} \link{DiscreteDeletor}
#	\link{DiscreteInsertor} \link{Event} \link{F81} \link{F84}
#	\link{FastFieldDeletor} \link{GeneralDeletor}
#	\link{GeneralInDel} \link{GeneralInsertor} \link{GeneralSubstitution} 
#	\link{GTR} \link{GY94} \link{HKY} \link{JC69} \link{JTT} \link{JTT.dcmut}
#	\link{K80} \link{K81} \link{LG} \link{mtArt} \link{mtMam} \link{mtREV24}
#	\link{MtZoa} \link{NucleotideAlphabet} \link{NucleotideSequence} \link{PAM} 
#	\link{PAM.dcmut} \link{PhyloSim} \link{Process} \link{QMatrix} \link{Sequence}
#	\link{Site} \link{T92} \link{TN93} \link{UNREST} \link{WAG}}
# }
# 
#*/###########################################################################
setConstructorS3(
"PhyloSim",
  function(
		phylo=NA,
		root.seq=NA,
		name=NA,
		log.file=NA,
		log.level=-1, # no loggin is performed by default
		... 
		)	{

		this<-PSRoot();	
		this<-extend(this,
			"PhyloSim",
			.name="Anonymous",
			.phylo=NA,
			.root.sequence=NA, 
			.sequences=list(),		# references to the sequence objects
			.node.hooks=list(),		# references to the node hook functions.
			.branch.stats=list(), # branch statistics.
			.alignment=NA,				# the resulting alignment in fasat format.
			.log.file=NA, 				# the name of the log file.
			.log.connection=NA,		# connection for the log file.
			.log.level=NA					# log level
		);

		if(!all(is.na(phylo))){
			this$phylo<-phylo;
		}

		if(!all(is.na(root.seq))){
			this$rootSeq<-root.seq;
		}
	
		if(!missing(name)){
			this$name<-name;
		}

		if(!missing(log.file)){
			this$logFile<-log.file;
		} else {	
			# Setting default log file:
			tmp<-this$id;
			tmp<-gsub(":","_",tmp);
			this$logFile<-paste(tmp,".log",sep="");
		}

		# Setting log level:
		this$logLevel<-log.level;

		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="PhyloSim", 
	function(
		this,
		...
	){

      may.fail<-function(this) {
					
				# Checking the name:	
				this$name<-this$name;
				# Checking the phylo object:
				if (!any(is.na(this$.phylo)) & !is.phylo(this$.phylo) ){
					throw("The phylo object is invalid!\n");
				}
				# Checking the log level:
				if(!is.numeric(this$.log.level) | (length(this$.log.level) != 1) ){
					throw("The log level must be numeric vector of length 1!\n");
				}
				# Checking lof file:
				if(!is.character(this$.log.file) | (length(this$.log.level) != 1) ){
					throw("The log file must be charcter vector of length 1!\n");
				}
				# Checking the sequences:
				for (seq in this$.sequences){
					if(is.Sequence(seq)){
						checkConsistency(seq);
					}
				}
				# Checking node hooks:
				for (hook in this$.node.hooks){
					if(!is.null(hook) & !is.function(hook)){
						throw("Invalid node hook found!\n");
					}
				}
				# Checking the alignment:
				if(!any(is.na(this$.alignment))){
					.checkAlignmentConsistency(this, this$.alignment);
				}
		
      }
      tryCatch(may.fail(this));
			return(invisible(TRUE));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##	
## Method: is.phylo.default
##	
###########################################################################/**
#
# @RdocDefault is.phylo
# 
# @title "Check if an object is an instance of the phylo class" 
# 
# \description{ 
#	@get "title".
#	Phylo objects are created by the \pkg{APE} package. This method just return the value of \code{inherits(this,"phylo")}.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# load APE
#	library(ape);
#	# create some objects
#	o1<-Object();
#	o2<-rcoal(3);
#	# check if they are phylo objects
#	is.phylo(o1);
#	is.phylo(o2);			
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	The \pkg{ape} package.
# } 
# 
#*/###########################################################################
setMethodS3(
	"is.phylo", 
	class="default", 
	function(
		this,
		...
	){

		inherits(this,"phylo");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##	
## Method: setPhylo
##	
###########################################################################/**
#
# @RdocMethod setPhylo
# 
# @title "Set the phylo object for a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	The internal structure of the provided phylo object is reordered in a cladeweise fashion.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{value}{A phylo object created by the \pkg{ape} package.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A phylo object or FALSE.
# } 
# 
# \examples{
#	#create a PhyloSim object
#	sim<-PhyloSim();
#	# creat a phylo object
#	tree<-rcoal(3);
#	# get/set phylo object
#	setPhylo(sim,tree);
#	getPhylo(sim,tree);
#	# get/set phylo object via virtual field
#	sim$tree<-rcoal(5);
#	sim$tree;
# } 
# 
# @author 
# 
# \seealso{ 
# 	The PhyloSim class, the \pkg{ape} package.
# } 
# 
#*/###########################################################################
setMethodS3(
	"setPhylo", 
	class="PhyloSim", 
	function(
		this,
		value,
		...
	){

		if(missing(value)){
			throw("No object provided!\n");
		}
		else if(!is.phylo(value)){
			throw("The new value must be a \"phylo\" object!\n");
		}
		else if(!is.rooted(value)){
			throw("The new value must be a rooted \"phylo\" object!\n");
		}
		else {

			.checkTipLabels(value);
			this$.phylo<-value;
			this$.phylo<-reorder(this$.phylo, order="cladewise");
			for (i in this$nodes){
				this$.sequences[[i]]<-NA;
			}
			return(this$.phylo);

		}
		return(FALSE);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .checkTipLabels
##	
setMethodS3(
	".checkTipLabels", 
	class="phylo", 
	function(
		this,
		...
	){

		for(label in this$tip.label){
			if(length(grep("^Node \\d+$",label,perl=TRUE,value=FALSE)) > 0){
					throw("Sorry, but the node labels matching \"Node \\d+\" are reserved for internal nodes! Blaming label: ",label,".\n");	
			}
			else if(length(grep("^Root node \\d+$",label,perl=TRUE,value=FALSE)) > 0){
					throw("Sorry, but the node labels matching \"Root node \\d+\" are reserved for the root node! Blaming label: ",label,".\n");	
			}
			
		}

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##	
## Method: getPhylo
##	
###########################################################################/**
#
# @RdocMethod getPhylo
# 
# @title "Get the phylo object aggregated in a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A phylo object or NA.
# } 
# 
# \examples{
#	#create a PhyloSim object
#	sim<-PhyloSim();
#	# creat a phylo object
#	tree<-rcoal(3);
#	# get/set phylo object
#	setPhylo(sim,tree);
#	getPhylo(sim,tree);
#	# get/set phylo object via virtual field
#	sim$tree<-rcoal(5);
#	sim$tree;
# } 
# 
# @author 
# 
# \seealso{ 
# 	The PhyloSim class, the \pkg{ape} package.
# } 
# 
#*/###########################################################################
setMethodS3(
	"getPhylo", 
	class="PhyloSim", 
	function(
		this,
		...
	){

		this$.phylo;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##	
## Method: setRootSeq
##	
###########################################################################/**
#
# @RdocMethod setRootSeq
# 
# @title "Set the root sequence for a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	The root sequence will be used as a starting point for the simulation. The phylo object must be set before
#	trying to set the root sequence object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{value}{A valid Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The root Sequence object if succesfull, FALSE otherwise.
# } 
# 
# \examples{
#	# create some objects
#	sim<-PhyloSim(phylo=rcoal(3));
#	seq<-NucleotideSequence(string="ATGCC");
#	# set/get root sequence
#	setRootSeq(sim, seq);
#	getRootSeq(sim, seq);
#	# set/get root sequence via virtual field
#	sim$rootSeq<-BinarySequence(string="111000111000");
#	sim$rootSeq;
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass Sequence Process
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRootSeq", 
	class="PhyloSim", 
	function(
		this,
		value,
		...
	){

		if(missing(value)){
			throw("No object provided!\n");
		}
		else if(!is.Sequence(value)){
			throw("The new value must be a sequence object!\n");
		}
		else {

			this$.root.sequence<-clone(value);
			this$.root.sequence$name<-paste("Root node",this$rootNode);
        
            # Call garbage collection:
            gc();
            gc();

			return(this$.root.sequence);

		}
		return(FALSE);


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##	
## Method: getRootSeq
##	
###########################################################################/**
#
# @RdocMethod getRootSeq
# 
# @title "Get the root sequence aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The root Sequence object or NA.
# } 
# 
# \examples{
#	# create some objects
#	sim<-PhyloSim(phylo=rcoal(3));
#	seq<-NucleotideSequence(string="ATGCC");
#	# set/get root sequence
#	setRootSeq(sim, seq);
#	getRootSeq(sim, seq);
#	# set/get root sequence via virtual field
#	sim$rootSeq<-BinarySequence(string="111000111000");
#	sim$rootSeq;
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass Sequence Process
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRootSeq", 
	class="PhyloSim", 
	function(
		this,
		...
	){

			this$.root.sequence;


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##	
## Method: as.character.PhyloSim
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Return the character representation of a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	The character representation is the identifier of the PhyloSim object as returned by the \code{getId} method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	o<-PhyloSim(name="MySim");
#	# get character representation
#	as.character(o)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="PhyloSim", 
	function(
		x,
		...
	){

		return(getId(x));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
)

##
## Method: getName
##
###########################################################################/**
#
# @RdocMethod getName
# 
# @title "Get the name of a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	o<-PhyloSim();
#	# set/get name
#	setName(o,"MySim");
#	getName(o,"MySim");
#	# set/get name via virtual field
#	o$name<-"George";
#	o$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getName",
  class="PhyloSim",
  function(
    this,
    ...
  ){

    this$.name;
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setName
##
###########################################################################/**
#
# @RdocMethod setName
# 
# @title "Set the name of a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{new.name}{A character vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new name.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	o<-PhyloSim();
#	# set/get name
#	setName(o,"MySim");
#	getName(o,"MySim");
#	# set/get name via virtual field
#	o$name<-"George";
#	o$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setName",
  class="PhyloSim",
  function(
    this,
    new.name,
    ...
  ){

    this$.name<-as.character(new.name);
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getId
##
###########################################################################/**
#
# @RdocMethod getId
# 
# @title "Get the unique identifier of a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#	The unique identifier is the concatenation of the class, the object name as returned by getName() and the object hash 
#       as returned by hashCode().
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	o<-PhyloSim(name="MySim");
#	# get id
#	getId(o);
#	# get id via virtual field
#	o$id;
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getId",
  class="PhyloSim",
  function(
    this,
    ...
  ){

  	this.class<-class(this)[1];
	id<-paste(this.class,this$.name,hashCode(this),sep=":");
	return(id);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setId
##
###########################################################################/**
#
# @RdocMethod setId
#
# @title "Forbidden action: setting the unique identifier of a PhyloSim object"
#
# \description{
#       @get "title".
#
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setId",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

  throw("Id is generated automatically and it cannot be set!\n");

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: Simulate
##
###########################################################################/**
#
# @RdocMethod Simulate
# 
# @title "Run a simulation according to a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	The phylo object and the root sequence must be set before attempting to run a simulation.
#	Also the bigRate of the root sequence must not be NA or zero, so at least one sane
#	Process object must be attached to the root sequence object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{quiet}{TRUE or FALSE (default).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	);
#	# Run the simulation
#	Simulate(sim);
#	# Print the resulting sequences
#	sim$sequences
#	# Print the resulting alignment
#	sim$alignment
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "Simulate",
  class="PhyloSim",
  function(
    		this,
		quiet=FALSE,
    ...
  ){


		if(!is.phylo(this$.phylo)){
			throw("Cannot simulate because the phylo object is not set or it is invalid!\n");
		}
		# Check for the root sequence:
		else if(!is.Sequence(this$.root.sequence)){
			throw("Cannot simulate because the root sequence is not set or it is invalid!\n");
		}
		# Check bigRate validity:
		else if(is.na(this$.root.sequence$bigRate)){
			throw("Cannot simulate because the bigRate of the root sequence is NA!\n");
		}
		else{

			# Warn for zero bigRate:
			if(this$.root.sequence$bigRate == 0){
				warning("The bigRate of the root sequence is zero! You are running a pointless simulation!\n");
			}

			if(exists(x="PSIM_FAST")){
				if(!quiet){
cat("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
cat("!! WARNING: fast & careless mode is on, most of the error checking is omitted!  !!\n");
cat("!!    Please note that this also disables the saving of branch statistics.      !!\n");
cat("!!       You can go back to normal mode by deleting the PSIM_FAST object.       !!\n");
cat("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
				}
			Log(this,"WARNING: fast & careless mode is on, most of the error checking is omitted!");
			}
		
			# Attach root sequence to root node:
			Log(this,paste("Attaching root sequence ",this$.root.sequence$id,sep=""));
			attachSeqToNode(this, node=getRootNode(this),seq=this$.root.sequence);

			# Write protecting the root sequence:
			Log(this,paste("Write protecting root sequence ",this$.root.sequence$id,sep=""));
			this$.root.sequence$writeProtected<-TRUE;

			# Traverse the tree and simulate:
			Log(this,paste("Starting simulation on the object",this$id));	
			edge.counter<-1;
			n.edges<-this$nedges;
			for(edge in 1:n.edges){
				if(!quiet){ cat("Simulating edge",edge,"of", n.edges,"\n");}
				Log(this,paste("Starting to simulate edge",edge,"of",n.edges));	
				.simulateEdge(this,number=edge);
				edge.counter<-edge.counter+1;
			}
		}
		Log(this, "Simulation finished, building alignment!\n");
		this$.alignment<-.recoverAlignment(this);
		# Flush the log connection:
		if(!is.na(this$.log.connection)){
				close(this$.log.connection);
		}

        # Call the garbage collector:
        gc();
        gc();

		return(invisible(this));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .simulateEdge
##
setMethodS3(
  ".simulateEdge",
  class="PhyloSim",
  function(
    this,
		number=NA,
    ...
  ){

		# Get edge:
		edge<-getEdge(this, number);
		# Get parent node:
		start.seq<-getSeqFromNode(this, edge[[1,"from"]]);
		# Evolve sequence:
		new.seq<-.evolveBranch(this, start.seq=start.seq, branch.length=edge[1,"length"], old.node=edge[[1,"from"]],new.node=edge[[1,"to"]], branch.number=number);
		# Write protect the sequence:
		new.seq$writeProtected<-TRUE;
		# Attach sequence to children node:
		attachSeqToNode(this, node=edge[1,"to"], seq=new.seq);

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .evolveBranch
##
setMethodS3(
  ".evolveBranch",
  class="PhyloSim",
  function(
    this,
    start.seq=NA,
    branch.length=NA,
		old.node=NA,
		new.node=NA,
		branch.number=NA,
    ...
  ){

	if(!exists(x="PSIM_FAST")){

		if(missing(start.seq)){
			throw("No starting sequence provided!\n");
		}
		else if(missing(branch.length)){
			throw("No branch length provided!\n");
		}
		else if(!is.numeric(branch.length)){
			throw("The branch length must be numeric!\n");
		}
	}
		if(.checkSeq(this, start.seq) ){
		
			# Cloning the starting sequence:
			seq<-clone(start.seq);
			
			# Set the name of the sequence object:
			if(is.tip(this, new.node)){
				seq$name<-this$tipLabels[[new.node]];
			}
			else {
				seq$name<-paste("Node",new.node);
			}
			.GillespieDirect(this, seq=seq, branch.length=branch.length, branch.number=branch.number);
			
			# Call the node hook if exists:
			hook<-this$.node.hooks[[as.character(new.node)]];
			if(!is.null(hook) & is.function(hook)){
				Log(this,paste("Calling node hook for node",new.node));
				seq<-hook(seq=seq);	
				if(!is.Sequence(seq)){
					throw("Node hook returned an invalid sequence object!\n");
				}
				else if(is.na(seq$bigRate)){
					throw("Node hook returned sequence with NA bigRate!\n");
				}
				else if(seq$bigRate == 0.0){
					throw("Node hook returned sequence with zero bigRate!\n");
				}
				else{
				 checkConsistency(seq, omit.sites=TRUE);
				}
			}

			# Return the resulting sequence object:
			return(seq);
		
		}
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .GillespieDirect
##
setMethodS3(
  ".GillespieDirect",
  class="PhyloSim",
  function(
    this,
    seq=NA,
    branch.length=NA,
		branch.number=NA,
    ...
  ){

		Debug(this, paste("Branch length is",branch.length));
		
		# Initialize time:

		time<-0.0;
		
		# Sample the next waiting time until
		# the branch length is consumed:	

		while( (time<-time + rexp(n=1, rate=(big.rate<-getBigRate(seq)))) <= branch.length){

			# Generate a random number between zero and the bigRate:

			E<-runif(n=1,min=0,max=big.rate);

			# Identify the target site:

			site.number<-which(.getCumulativeRatesFast(seq) >= E)[[1]];

			# Get the events from the target site:

			site<-seq$.sites[[site.number]];
			site$.position<-site.number;
			events<-getEvents(site);
			site$.position<-NULL;
			
			# Get the rates:
			rates<-double();
			for(e in events){
				rates<-c(rates,e$.rate);
			}
		
			# Calculate the corresponding cumulative rates:	
			if(site.number > 1){
				rates<-cumsum(c(seq$.cumulative.rates[[site.number - 1]], rates));
			}
			else {
				rates<-cumsum(c(0.0, rates));
			}

			# Pick the event:

			event.number<-which(rates >= E)[[1]] - 1;
			event<-events[[event.number]];

			# Log the event:

			Log(this,paste("Performing event [",event$.name,"] at position",event$.position,"generated by the process",event$.process$.id));

			# Perform the event:

			event.details<-Perform(event);
			Debug(this,paste("Remaining branch length is",(branch.length-time) ));
			
			# Log event details:
	
					# Log deletion event details:
						if(event$.name == "Deletion"){
						Log(this,paste("The process",event$.process,"proposed to delete range",paste(event.details$range,collapse="--"),". Accepted:",event.details$accepted));
					}
					# Log insertion event details:
					else if(event$.name == "Insertion"){
						message<-paste("The process ",event$.process," proposed insertion at position ",event.details$position,". Accepted: ",event.details$accepted,sep="");
						if(event.details$accepted == TRUE){
						message<-paste(message,"."," Insert length was ",event.details$length,sep="");
						}
						Log(this, message);
					}

			# Update branch statistics if not in fast mode:
			if(!exists(x="PSIM_FAST")){
				.UpdateBranchStats(this,event,event.details, branch.number);
			}

			# Abort if sequence length shrunk to zero:

			if(seq$.length == 0){
				message<-paste("Terminating the simulation because the length of the sequence ",seq$name," shrunk to zero! Please be more careful when tuning the indel rates!\n");
				Log(this, message);
				throw(message);
			}	

		} #/while

        # Calling garbage collection:
        gc();
        gc();
		return(seq);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: attachSeqToNode
##
###########################################################################/**
#
# @RdocMethod	attachSeqToNode
# 
# @title "Assotiate a Sequence object with a given node of a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	This method is mainly used internally.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{node}{Node identifier.}
#	\item{seq}{A Sequence object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "attachSeqToNode",
  class="PhyloSim",
  function(
		this,
		node=NA,
		seq=NA,
    ...
  ){

		if(!is.phylo(this$.phylo)){
			throw("The phylo object is not set, sequence to node is not possible!\n");
		}
		if(missing(node)){
			throw("No node specified!\n");
		}
		else if(missing(seq)){
			throw("No sequence object given");
		}
		else if(.checkNode(this,node) & .checkSeq(this, seq)){
			
			if(is.Sequence(this$.sequences[[node]])){
				throw("The node has already an attached sequence. Detach that before trying to attach a new one!\n");
			}
			else {
				this$.sequences[[as.numeric(node)]]<-seq;
				return(invisible(this));
			}

		}
	
		return(invisible(this));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: attachHookToNode
##
###########################################################################/**
#
# @RdocMethod attachHookToNode
# 
# @title "Attach a callback function to a given node of a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	A "node hook" is a function which accepts a Sequence object through the named argument "seq" and returns a 
#	Sequence object. The node hook function must accept any object which inherits from the \code{Sequence} class!
#
#	After simulating the branch leading to the node, the resulting Sequence object is passed
#	to the node hook and the returned object is used to simulate the downstream branches.
#
#	By using node hooks the attached processes can be replaced during simulation, hence enabling the simulation of 
#	non-homogeneous sequence evolution.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{node}{Node identifier.} 
# 	\item{fun}{A function (see above).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	);
#	# create a node hook function
#	hook<-function(seq=NA){
#		# replace the substitution process with F84
#		if(inherits(seq,"NucleotideSequence")){
#			cat("Replacing JC69 with F84.\n");
#			seq$processes<-list(list(F84(rate.params=list("Kappa" = 2)))); 
#		}
#		return(seq);
#	}
#	# attach hook function to node 5
#	attachHookToNode(sim,5,hook);
#	# Run the simulation
#	Simulate(sim);
#	# Check if the processes have been truly replaced
#	lapply(sim$sequences, getUniqueProcesses.Sequence)
#	# Print the resulting alignment
#	sim$alignment
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "attachHookToNode",
  class="PhyloSim",
  function(
    		this,
		node=NA,
		fun=NA,
    ...
  ){

		if(!is.phylo(this$.phylo)){
			throw("The phylo object is not set, attaching node hook is not possible!\n");
		}
		if(missing(node)){
			throw("No node specified!\n");
		}
		else if(missing(fun)){
			throw("No function given!");
		}
		else if(!is.function(fun)){
			throw("The argument \"fun\" must be a function!\n");
		}
		else if( length(intersect(names(formals(fun)), "seq")) == 0 ){
			throw("The function argument must have a an argument named \"seq\"");
		}
		else if(!is.Sequence(fun(Sequence(length=1)))){
      throw("The insert hook function must return a Sequence object!\n");
		}
		else if( .checkNode(this,node) ){
			if(is.function(this$.node.hooks[[as.character(node)]])){
				throw("The node has already an attached node hook. Detach that before trying to attach a new one!\n");
			}
			else {
				this$.node.hooks[[as.character(node)]]<-fun;
				return(invisible(this));
			}

		}
	
		return(invisible(this));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: .checkNode
##
setMethodS3(
  ".checkNode",
  class="PhyloSim",
  function(
    this,
		node=NA,
    ...
  ){

		if(missing(node)){
			throw("No node specified!\n");
		} else if( length(intersect(node, getNodes(this))) != 1){
			throw("The specified node is invalid!\n");	
		}
		else {
			return(TRUE);
		}
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkSeq
##
setMethodS3(
  ".checkSeq",
  class="PhyloSim",
  function(
    this,
		seq=NA,
    ...
  ){

		if(missing(seq)){
			throw("No sequence specified!\n");
		} else if(!is.Sequence(seq)){
			throw("The sequence object is invalid!\n");	
		}
		else {
			return(TRUE);
		}
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: detachSeqFromNode
##
###########################################################################/**
#
# @RdocMethod	detachSeqFromNode
# 
# @title "Detach a Sequence object from a given node of a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	This method is mainly used internally.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{node}{Node identifier.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "detachSeqFromNode",
  class="PhyloSim",
  function(
    		this,
		node=NA,
    		...
  ){

		if(missing(node)){
			throw("No node specified!\n");
		}
		else if( .checkNode(this,node) ){
			
				this$.sequences[[as.numeric(node)]]<-NA;
		}
	
		return(invisible(this));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: detachHookFromNode
##
###########################################################################/**
#
# @RdocMethod	detachHookFromNode
# 
# @title "Detach a node hook function from a given node of a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{node}{Node identifier.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATGC",processes=list(list(JC69())))
#	);
#	# create a node hook function
#	hook<-function(seq=NA){
#		# replace the substitution process with F84
#		if(inherits(seq,"NucleotideSequence")){
#			cat("Replacing JC69 with F84.\n");
#			seq$processes<-list(list(F84(rate.params=list("Kappa" = 2)))); 
#		}
#		return(seq);
#	}
#	# attach hook function to node 5
#	attachHookToNode(sim,5,hook);
#	# detach hook from node 5
#	detachHookFromNode(sim,5);
#	# Run the simulation again
#	Simulate(sim);	# You should not see the message printed out by the "hook" function.
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	attachHookToNode PhyloSim Simulate.PhyloSim
# } 
# 
#*/###########################################################################
setMethodS3(
  "detachHookFromNode",
  class="PhyloSim",
  function(
    this,
		node=NA,
    ...
  ){

		if(missing(node)){
			throw("No node specified!\n");
		}
		else if( .checkNode(this,node) ){
			
				this$.node.hooks[[as.character(node)]]<-NA;
		}
	
		return(invisible(this));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: getSeqFromNode
##
###########################################################################/**
#
# @RdocMethod getSeqFromNode
# 
# @title "Get the Sequence object associated with a given node of a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{node}{Node identifier.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Sequence object.
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATG",processes=list(list(JC69())))
#	);
#	# get the sequence associated with node 5
#	getSeqFromNode(sim,5)	# Should be NA
#	# Run the simulation
#	Simulate(sim)
#	# try again
#	getSeqFromNode(sim,5)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getSeqFromNode",
  class="PhyloSim",
  function(
    		this,
		node=NA,
    		...
  ){

		if(missing(node)){
			throw("No node specified!\n");
		}
		else if( .checkNode(this,node) ){
			
				return(this$.sequences[[as.numeric(node)]]);
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getSequences
##
###########################################################################/**
#
# @RdocMethod getSequences
# 
# @title "Gets all the Sequence objects associated with the nodes of a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	The order of the Sequence objects in the returned list reflects the identifiers of the associated nodes.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of sequence objects.
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATG",processes=list(list(JC69())))
#	);
#	# run the simulation
#	Simulate(sim)
#	# get all the associated sequence objects
#	getSequences(sim)
#	# get the sequence associated with node 3
#	# via virtual field
#	sim$sequences[[3]]
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getSequences",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		slist<-list();
		for (node in getNodes(this)){
			slist[[node]]<-getSeqFromNode(this, node=node);
		}
		return(slist);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setSequences
##
###########################################################################/**
#
# @RdocMethod setSequences
#
# @title "Forbidden action: setting the Sequence objects associated with the nodes of a phylo object aggregated by a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setSequences",
  class="PhyloSim",
  function(
    		this,
		value,
    		...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getAlignment
##
###########################################################################/**
#
# @RdocMethod	getAlignment
# 
# @title "Get the alignment stored in a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The alignment as a matrix. Gap are represented by strings composed of dashes.
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATG",processes=list(list(JC69())))
#	);
#	# run the simulation
#	Simulate(sim)
#	# get the resulting aligment
#	getAlignment(sim)
#	# via virtual fileld:
#	sim$alignment
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getAlignment",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		this$.alignment;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setAlignment
##
###########################################################################/**
#
# @RdocMethod setAlignment
#
# @title "Forbidden action: setting the alignment stored in a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setAlignment",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

               this$alignment <- value;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .recoverAlignment
##
setMethodS3(
  ".recoverAlignment",
  class="PhyloSim",
  function(
    		this,
		paranoid=FALSE,
    		...
  ){

		# Refuse to build alignment if at least one of the sequences is NA:
		for (seq in this$.sequences){
			if(!is.Sequence(seq)){
				throw("Cannot build alignment because the simulation is incomplete!\n");
			}
		}

		# The list holding all the partial alignment matrices:
		aln.mat<-list();
		
		# Assigning NA-s here to prevent creation of these variables in the global
		# environment.
		row.names<-NA;
		from.node<-NA;
		to.node<-NA;
		from.seq<-NA;
		to.seq<-NA;
		edge<-NA;
		from.name<-NA;
		to.name<-NA;
		from.mat<-NA;
		to.mat<-NA;

		# Initialize the variables:

		init.vars<-function(){

			# Getting the edge:
			edge<<-getEdge(this, edge.number);
			
			# Getting the nodes:
			from.node<<-edge[[1,"from"]];
			to.node<<-edge[[1,"to"]];

			# Getting the sequence objects:
			from.seq<<-getSeqFromNode(this, from.node)
			to.seq<<-getSeqFromNode(this, to.node)
	
			# Getting sequence names:	
			from.name<<-from.seq$name;
			to.name<<-to.seq$name;

		}

		# Initialize the aligment matrices:
		init.aln.mats<-function(){

			# Initialize "from" element in aln.mat if necessary:	
			if( is.null(aln.mat[[from.name]] )){
					# Create a row of the states:
					tmp<-rbind(as.character(lapply(from.seq$.sites, getState)));
					# Label the columns by the site position:
					colnames(tmp)<-seq(along.with=from.seq$.sites);
					# Label the row with the sequence name:
					rownames(tmp)<-from.name;
					# Set the corresponding list element in aln.mat:
					aln.mat[[ from.name ]]<-tmp;
			}
			# Set from.mat
			from.mat<<-aln.mat[[ from.name ]];
			
			# Initialize "to" element int aln.mat if necessary
			if( is.null(aln.mat[[to.name]]) ){
				# Create a new entry if we are dealing with a tip:
				if(is.tip(this, to.node)){
					# Create a vector of states:
					tmp<-rbind(as.character(lapply(to.seq$.sites, getState)));
					# Label columns by position:
					colnames(tmp)<-seq(along.with=to.seq$.sites);
					# Label row by sequence name:
					rownames(tmp)<-to.name;
					aln.mat[[ to.name ]]<-tmp;
				}
				else {
					# A "to" element can be null only if its a tip:
					throw("aln.mat inconsistency!\n");
				}
			}
			# Set to.mat:
			to.mat<<-aln.mat[[ to.name ]];

			# Save row names:
			# The order is important! First "from", than "to"!
			row.names<<-c(rownames(from.mat), rownames(to.mat));					

		}

		# Get the sequence position of a given alignment column from
		# the column labels:
		get.seq.pos<-function(mat=NA, col=NA){
						# Column number cannot be larger than length:
						if(col > dim(mat)[[2]]){
							throw("Invalid column number!\n");
						}
						# Get the corresponding column name:
						tmp<-colnames(mat)[[col]];		
						# Return if NA:
						if(is.na(tmp)){
							return(NA);
						}
						else{
							return(as.numeric(tmp));	
						}
	  }
	
		# Check if two positions from the two *sequences* are homologous.	
		is.homologous<-function(from.pos=NA, to.pos=NA){
				# Check position validity:
				if(to.pos > to.seq$length){
					throw("to.pos too big ",to.pos);
				}
				if(from.pos > from.seq$length){
					throw("from.pos too big ",from.pos);
				
				}
				# Check if the ancestral from to.seq/to.pos is from.seq/from.pos:
				return(equals(to.seq$.sites[[ to.pos ]]$.ancestral, from.seq$.sites[[ from.pos ]]));
		}

		# Get the symbol length from "to.seq" at position to.pos:
		get.to.symlen<-function(pos=NA){
				len<-stringLength(to.mat[to.name , pos]);
				if( is.na(len) | (len < 1) ){
					throw("Trouble in getting to.symlen!");
				} else {
					return(len);
				}
		}

		# Get the symbol length from "from.seq" at position from.pos:
		get.from.symlen<-function(pos=NA){
				len<-stringLength(from.mat[from.name , pos]);
				if( is.na(len) | (len < 1) ){
					throw("Trouble in getting from.symlen!");
				} else {
					return(len);
				}
		}

		make.gap.in.from<-function(label=NA,symlen=NA){
				# Create the gap symbol:
				gap<-paste(rep("-",times=symlen),collapse="");
				# Create the vector with gaps:
 				gaps<-cbind(rep(gap, times=dim(from.mat)[[1]] ));
				# Label the column:
        colnames(gaps)<-c(label);
				# Bind the gaps with the corresponding column from to.mat,
				# and than bind with res.mat:
        res.mat<<-cbind(res.mat, rbind( gaps, cbind(to.mat[,j])  ) );
				# Restore rownames:	
        rownames(res.mat)<<-row.names;
				# Increment counter for to.mat:
        j<<-j+1;
		}

		make.gap.in.to<-function(label=NA,symlen=NA){
			# See above.
			gap<-paste(rep("-",times=symlen),collapse="");
			gaps<-cbind(rep(gap, times=dim(to.mat)[[1]] ));
			colnames(gaps)<-c(label);
			res.mat<<-cbind(res.mat, rbind(  cbind(from.mat[,i]), gaps  ) );
			rownames(res.mat)<<-row.names;
			i<<-i+1;

		}

		emmit.homologous<-function(){
			# Bind the two columns into one column:
			tmp<-cbind(rbind( cbind(from.mat[,i]), cbind(to.mat[,j]) ) );
			# Label the column by from.pos:	
			colnames(tmp)<-c(from.pos);
			# Set res.mat
			res.mat<<-cbind(res.mat, tmp );
			# resotre rownames:
			rownames(res.mat)<<-row.names;
			
			i<<-i+1;
			j<<-j+1;
		}

		# Iterate over the reverse of the edge matrix:	
		for (edge.number in rev(seq(from=1, to=this$nedges))){

			# Call variable initialization:
			init.vars();

			# Initialize partial alignment matrices:
			init.aln.mats();
		
			# The matrix holding the resulting partial alignment:	
			res.mat<-c();

			# Column counter for from.mat:
			i<-1;
			# Column counter for to.mat:
			j<-1;
			
			while(i <=dim(from.mat)[[2]] | j <=dim(to.mat)[[2]] ){

					# First of all, check for counter overflow:
					if(i > dim(from.mat)[[2]]){
							# If i is greater than the length of from.mat, but we 
							# are still iterating, that means that we have parts left from
							# to.mat, so we have to create gaps in from.mat, and increment j.
							make.gap.in.from(symlen=get.to.symlen(pos=j));
							next();
					}
					else if (j > dim(to.mat)[[2]]){
							# If j is greater than the length of to.mat and we still iterating,
							# that means that we have still some columns in from.mat, so we create
							# gaps in to.mat and increment i. We label the new column with from.pos.
							from.pos<-get.seq.pos(mat=from.mat, col=i);
							make.gap.in.to(label=from.pos,get.from.symlen(pos=i));
							next();
					}

					# Now figure out the positions:
					from.pos<-get.seq.pos(mat=from.mat, col=i);
					to.pos<-get.seq.pos(mat=to.mat, col=j);

					# Now check for the gaps wich have been introduced before:

					if(is.na(from.pos)){
						# If we have a gap in from.mat,
						# than emmit the columnt with a gap in "to":
						make.gap.in.to(symlen=get.from.symlen(pos=i));
						next();
					}

					if(is.na(to.pos)){
						# Existent gap in to.mat:
						make.gap.in.from(symlen=get.to.symlen(pos=j));
						next();
					}

					# Now we have some real alignment to do here:

					if(is.homologous(from.pos=from.pos, to.pos=to.pos)){
						# We have to homologous columns, bind them, and emmit:
						emmit.homologous();
						next();
					}
					else if(is.Process(to.seq$.sites[[to.pos]]$.ancestral)){
						# The two columns are not homologous. The column in "to"
						# was inserted by a process. Make gap in from:
						make.gap.in.from(symlen=get.from.symlen(pos=i));
						next();

					} 
					else {
						# The only possibility left is a deletion in the child sequence.
						# Make gaps in "to", label new column by from.pos:
						make.gap.in.to(label=from.pos,symlen=get.from.symlen(pos=i));
						next();
					}

		 } # while i | j
			
			# Replace the "from" element in aln.mat with the resulting partial
			# alignment matrix: 
			aln.mat [[ from.name ]]<-res.mat;

		} # for edge.number
		alignment <-aln.mat[[ this$rootSeq$name ]];
		# Check the correcteness of the alignment if paranoid:
		if(paranoid){
			.checkAlignmentConsistency(this, alignment);
		}

        # Call garbage collection:
        gc();
        gc();

		# The whole alignment is associated with the root node:
		return(alignment);
		
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkAlignmentConsistency
##
setMethodS3(
  ".checkAlignmentConsistency",
  class="PhyloSim",
  function(
    this,
    aln,
    ...
  ){
	
	# First check if the sequences are intact:
	for(node in this$nodes){
		seq.node<-getSeqFromNode(this, node);
		seq.aln<-aln[seq.node$name, ];
		seq.aln<-seq.aln[ grep("^[^-]+$",seq.aln) ];
		seq.aln<-paste(seq.aln, collapse="");
		if(seq.aln != seq.node$string){
			throw("The alignment is inconsistent with the sequence objects!\n Blaming ",seq.node$name, ".\n");
		}
	}

	for(edge.number in rev(seq(from=1, to=this$nedges))){

			# Getting the edge:
			edge<-getEdge(this, edge.number);
			
			# Getting the nodes:
			from.node<-edge[[1,"from"]];
			to.node<-edge[[1,"to"]];

			# Getting the sequence objects:
			from.seq<-getSeqFromNode(this, from.node)
			to.seq<-getSeqFromNode(this, to.node)
	
			# Getting sequence names:	
			from.name<-from.seq$name;
			to.name<-to.seq$name;

			# Initializing positions:
			from.pos<-1;
			to.pos<-1;

			is.gap<-function(string){
			
					res<-length(grep("^-+$",string));
					if( res == 1 ){
							return(TRUE);
					} 
					else if (res > 1){
							throw("is.gap: argument vector too long!\n");
					}
					else {
							return(FALSE);
					}
	
			}
			
			# Iterate over edges:
			for (i in 1:dim(aln)[[2]]){

					# Overflow in "from" counter,
					if(from.pos > from.seq$length){

						to.char<-aln[to.name,i];			
						if(!is.gap(to.char)){
							# we have a final insertion:
							if(!is.Process(to.seq$.sites[[to.pos]]$.ancestral)){
								throw("Alignment insertion inconsistency!\n");
							}
							to.pos<-to.pos+1;
						} 
							next();
					}				
					
					# Overflow in "to" counter (final deletion):
					if(to.pos > to.seq$length){
						break();
					}				
					
					# Get the symbols from alignment:	
					from.char<-aln[from.name,i];			
					to.char<-aln[to.name,i];			

					is.gap.to<-is.gap(to.char);
					is.gap.from<-is.gap(from.char);
	
					# Skip if we have to gap symbols:	
					if( is.gap.from & is.gap.to ){
						next();
					}
					# Deletion in to.seq:
					else if(is.gap.to & !is.gap.from ){
						from.pos<-(from.pos+1);
					}
					# Insertion in to.seq:
					else if(!is.gap.to & is.gap.from ){
							# Check ancestral pointer for inserted sites:
							if(!is.Process(to.seq$.sites[[to.pos]]$.ancestral)){
								throw("Alignment insertion inconsistency!\n");
							}
							to.pos<-(to.pos+1);
					} else {
							 # We must have a homology here:						
							 if(!equals(to.seq$.sites[[ to.pos ]]$.ancestral, from.seq$.sites[[ from.pos ]])){
									throw("Non-homologous sites aligned! Alignment is inconsistent!\n");	
							}
							 from.pos<-(from.pos+1);
							 to.pos<-(to.pos+1);
					}
	
			}

	}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: saveAlignment
##
###########################################################################/**
#
# @RdocMethod saveAlignment
# 
# @title "Save the alignment stored in a PhyloSim object in a Fasta file" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{file}{The name of the output file.} 
# 	\item{skip.internal}{Do not save sequences corresponding to internal nodes.} 
# 	\item{paranoid}{Check the consistency of the alignment.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATG",processes=list(list(JC69())))
#	);
#	# run the simulation
#	Simulate(sim)
#	# save the alignment
#	file<-paste("PhyloSim_dummy_fasta_",Sys.getpid(),".fas",sep="");
#	saveAlignment(sim,file=file,paranoid=TRUE);
#	# print out the Fasta file
#	cat(paste(scan(file=file,what=character(),sep="\n"),collapse="\n"));cat("\n");
#	# delete Fasta file
#	unlink(file);
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "saveAlignment",
  class="PhyloSim",
  function(
    		this,
    		file="phylosim.fas",
    		skip.internal=FALSE,
		paranoid=FALSE,
    		...
  ){

		if(any(is.na(this$.alignment))){
			warning("Alignment is undefined, nothin to save!\n");
			return();
		}
		else {
			if(paranoid){
				.checkAlignmentConsistency(this, this$.alignment);
			}
			sink(file);
			if(!skip.internal){
				for(i in 1:dim(this$.alignment)[[1]]){
					cat(">",rownames(this$.alignment)[[i]],"\n");
					cat(paste(this$.alignment[i,],collapse=""),"\n");
				}
			} else {
				for(i in 1:dim(this$.alignment)[[1]]){

					name<-rownames(this$.alignment)[[i]];

					if(!any((length(grep("^Node \\d+$",name,perl=TRUE,value=FALSE)) > 0),(length(grep("^Root node \\d+$",name,perl=TRUE,value=FALSE)) > 0))){
						cat(">",name,"\n");
						cat(paste(this$.alignment[i,],collapse=""),"\n");
					}

				}
			}
			sink(NULL);
		}
		return(invisible(this));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: plot.PhyloSim
##
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Plot a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#       This method plots the aggregated alignment alongside the tree used for simulation. Various options
#       allow for control over the plot style.
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A PhyloSim object.}
# 	\item{plot.tree}{Whether to plot the tree alongside the alignment. TRUE or FALSE; defaults to TRUE.}
# 	\item{plot.ancestors}{Whether to plot the ancestral sequences. TRUE or FALSE; defaults to TRUE.}
# 	\item{plot.chars}{Whether to plot the actual text of the characters.}
# 	\item{plot.legend}{Whether to plot the legend showing the character-to-color mapping.}
# 	\item{plot.labels}{Whether to plot the sequence labels along the y-axis}
# 	\item{aspect.ratio}{(Experimental; when set, this option forces the num.pages value to 1) Constrains the alignment residues to have a certain aspect ratio; values above 1 cause vertically-stretched blocks. FALSE disables aspect ratio control, numerical values set the aspect ratio; defaults to FALSE.}
# 	\item{num.pages}{Optionally split the alignment over a number of vertically-stacked pages. This is useful for long alignments. 'auto' chooses a sensible number of pages, numerical values specify a number; defaults to 'auto'.}
# 	\item{char.text.size}{Text size for the aligned characters. This may require tweaking depending on the DPI and output format. Defaults to 'auto'.}
# 	\item{axis.text.size}{Text size for the sequence labels along the y-axis. This may require tweaking depending on the DPI and output format. Defaults to 'auto'.}
#       \item{color.scheme}{Color scheme to use ("auto", "binary", "dna", "protein", "codon", "combined", "combined_codon"). Defaults to 'auto'. When set to 'auto', the function will choose an appropriate coloring scheme based on the alignment content.}
#       \item{color.branches}{The event count used to color the branches ("substitutions" by default). See \code{\link{getBranchEvents.PhyloSim}}.}
#       \item{tree.xlim}{The x-axis limits of the tree panel.}
#       \item{aln.xlim}{The x-axis limits of the alignment panel (in alignment column coordinates).}
#       \item{tracks}{Tracks to display above or below the alignment as colored blocks.
#
# The input format for tracks is a list of data frames with the following possible fields, all of which are optional and can be omitted:
# \itemize{
# \item pos - the sequence position (starting with 1) of the feature. Defaults to NULL.
# \item score - the score (between 0 and 1) of the feature. Scores above 1 or below zero will be truncated.
# Defaults to 1.
# \item y_lo - the lower Y offset (between 0 and 1) of the feature. Defaults to 0. Use a y_lo and y_hi
# value for each row in the track data frame to create a wiggle plot like effect.
# \item y_hi - the upper Y offset (between 0 and 1) of the feature. Defaults to 1. Use just a y_hi value
# for each row in the track data frame to create a bar plot like effect.
# \item {the fields below are considered unique per track; the values from the first row in the track
# data frame are used.}
# \item id - the display ID for the track. Defaults to 'Track'.
# \item layout - set to 'above' to put the track above the alignment, 'below' for below.
# \item height - the number of alignment rows for the track to span in height. Defaults to 3.
# \item color.gradient - a comma-separated list of colors to interpolate between when coloring
# the blocks. Examples: 'white,red' 'blue,gray,red' '#FF00FF,#FFFFFF'. Defaults to 'white,black'.
# \item color - a single color to use when coloring the blocks. Mutually exclusive with color.gradient,
# and if a color.gradient value exists then this value will be ignored. Defaults to black.
# \item background - a color for the background of the track. Defaults to white.
# }}
#       \item{aln.length.tolerance}{The desired alignment/sequence length ratio (A/S ratio) to trim the alignment to.
#       The A/S ratio is defined as the ratio between the alignment length and the mean ungapped sequence length, and
#       the alignment trimming procedure will remove blocks of indel-containing columns (in a sensible order) until 
#       either (a) the desired indel tolerance is reached, or (b) no more columns can be removed without yielding an empty
#       alignment. A track is added below the alignment to indicate how many indels each resulting alignment column used
#       used to harbor, and black squares are overlaid onto the alignment where extant sequence data has been trimmed.
#       Defaults to NULL (no trimming); values in the range of 0.9 to 1.3 tend to work well at improving the
#       legibility of very gappy alignments.}
#       \item{plot.nongap.bl}{If set to TRUE, plots the non-gap branch length (defined as the branch length of the subtree of non-gapped sequences) as a track below the alignment. Defaults to FALSE.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATGCTAGCTAGG",processes=list(list(JC69())))
#	);
#       # plot the aggregated phylo object
#       plot(sim)
#	# run simulation
#	Simulate(sim)
#       # Plot the alignment without the tree or ancestral sequences.
#       plot(sim, plot.ancestors=FALSE, plot.tree=FALSE)
#       # Force a DNA-based color scheme 
#       # (default is 'auto' to auto-detect based on the sequence composition)
#       plot(sim, color.scheme='dna', plot.legend=TRUE)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "plot",
  class="PhyloSim",
  function(
    x,
    plot.tree,
    plot.ancestors,
    plot.chars,
    plot.legend,
    plot.labels,
    aspect.ratio,
    num.pages,
    char.text.size,
    axis.text.size,
    color.scheme,
    color.branches,
    tree.xlim,
    aln.xlim,
    tracks,
    aln.length.tolerance,
    plot.nongap.bl,
    ...
  ){
		
		if(missing(char.text.size)){
   		        char.text.size <- 'auto'
		}
		if(missing(axis.text.size)){
			axis.text.size <- 'auto'
		}
		if(missing(color.scheme)){
			color.scheme <- 'auto'
		}
		if(missing(color.branches)){
			color.branches <- 'substitutions'
		}
		if(missing(plot.tree)){
			plot.tree <- TRUE
		}
		if(missing(plot.ancestors)){
			plot.ancestors <- TRUE
		}
		if(missing(plot.chars)){
			plot.chars <- TRUE
		}
		if(missing(plot.legend)){
			plot.legend <- FALSE
		}
		if(missing(plot.labels)){
			plot.labels <- TRUE
		}
		if(missing(aspect.ratio)){
			aspect.ratio <- FALSE
		}
		if(missing(num.pages)){
			num.pages='auto'
		}
                if(missing(color.scheme)){
                        color.scheme='auto'
                }
                if(missing(tree.xlim)){
                  tree.xlim=NULL
                }
                if(missing(aln.xlim)){
                  aln.xlim=NULL
                }
                if(missing(tracks)){
                  tracks=NULL
                }
                if(any(is.na(x$.phylo))) {
                  plot.tree <- FALSE
                }
                if(missing(aln.length.tolerance)){
                  aln.length.tolerance=NULL
                }
                if(missing(plot.nongap.bl)){
                  plot.nongap.bl=FALSE
                }
                
		if(all(!is.na(x$.alignment), is.matrix(x$.alignment))){
			.plotWithAlignment(x,
				plot.tree=plot.tree,
				plot.ancestors=plot.ancestors,
				plot.chars=plot.chars,
                                plot.legend=plot.legend,
                                plot.labels=plot.labels,
				aspect.ratio=aspect.ratio,
				num.pages=num.pages,
                                char.text.size=char.text.size,
                                axis.text.size=axis.text.size,
                                color.scheme=color.scheme,
                                color.branches=color.branches,
                                tree.xlim=tree.xlim,
                                aln.xlim=aln.xlim,
                                tracks=tracks,
                                aln.length.tolerance=aln.length.tolerance,
                                plot.nongap.bl=plot.nongap.bl
			);
			return(invisible(x));
		}

		plot(x$.phylo);
		nodelabels();

		return(invisible(x));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: .plotWithAlignment
##
setMethodS3(
  ".plotWithAlignment",
  class="PhyloSim",
  function(
    x,
    plot.tree,
    plot.ancestors,
    plot.chars,
    plot.legend,
    plot.labels,
    aspect.ratio,
    num.pages,
    char.text.size,
    axis.text.size,
    color.scheme,
    color.branches,
    tree.xlim,
    aln.xlim,
    tracks,
    aln.length.tolerance,
    plot.nongap.bl,
    ...
  ){

   # ugly empirical fix of some R CMD check warnings:
   id           <-NA;
   pos          <-NA;
   char         <-NA;
   xend         <-NA;
   yend         <-NA;
   y            <-NA;
   substitutions<-NA;
   event.count  <-NA;
   type         <-NA;
   track_index  <-NA;
   xx           <-NA;
   yy           <-NA;
   xmin         <-NA;
   xmax         <-NA;
   ymin         <-NA;
   ymax         <-NA;

    ### First, we need to define a bunch of sparsely-documented utility functions. ###

   # Re-orders the alignment rows by matching the tree's tips.
   sort.aln.by.tree = function(aln,tree) {
     names <- dimnames(aln)[[1]]
     if (length(names) > length(tree$tip.label)) {
       return(aln)
     }
     newPositions <- rev(match(tree$tip.label,names))
     aln <- aln[newPositions,]
     dimnames(aln) <- list(names[newPositions])
     return(aln)
   }
   
    # Extracts a list of child node IDs for the given node. Returns (-1,-1) if the node is a leaf.
    child.nodes <- function(phylo,node) {
      edge.indices <- which(phylo$edge[,1]==node)
      nodes <- phylo$edge[edge.indices,2]
      if (length(nodes)==0) {
        nodes <- list(c(-1,-1))
      } else {
        nodes <- list(nodes)
      }
      return(list(nodes))
    }

    # Extracts the parent node ID for the given node. Returns -1 if the node is root.
    parent.node <- function(phylo,node) {
      edge.index <- which(phylo$edge[,2]==node)
      node <- phylo$edge[edge.index,1]
      if (length(node)==0) {
        node <- -1
      }
      return(node)
    }

    generic.count <- function(sim,node,type) {
      if (type == 'insertions' || type == 'ins') {
        type <- 'insertion'
      }
      if (type == 'deletions' || type == 'del') {
        type <- 'deletion'
      }
      if (type == 'substitutions' || type == 'subst' || type == 'sub') {
        type <- 'substitution'
      }
      if (type == 'syn') {
        type <- 'synonymous'
      }
      if (type == 'nsyn') {
        type <- 'non-synonymous'
      }
                                        # Default value of 0.
      cnt <- 0
      if(type=='none' || type == '') {
        return(as.numeric(cnt))
      }
                                        # Find the edge which points to the given node.
      edge.index <- which(phylo$edge[,2]==node)
      if (length(edge.index) > 0) {
        bs <- sim$.branch.stats
        cnt <- bs[[paste(edge.index)]][[type]]
        if (is.null(cnt) || is.na(cnt)) {
          cnt <- 0
        }
      }
      return(as.numeric(cnt))
    }
   
    subst.count <- function(sim,node) {
      return(generic.count(sim,node,'substitution'))
    }
    ins.count <- function(sim,node) {
      return(generic.count(sim,node,'insertion'))
    }
    del.count <- function(sim,node) {
      return(generic.count(sim,node,'deletion'))
    }
    syn.count <- function(sim,node) {
      return(generic.count(sim,node,'synonymous'))
    }
    nsyn.count <- function(sim,node) {
      return(generic.count(sim,node,'non-synonymous'))
    }

    # Finds the node with a given label.
    node.with.label <- function(tree,label) {
      return(which(tree$tip.label %in% label))
    }
   
    # Extracts the length of the branch above the given node. Returns 0 if the node is root.
    branch.length <- function(phylo,node) {
      edge.index <- which(phylo$edge[,2]==node)
      bl <- phylo$edge.length[edge.index]
      if (length(bl)==0) {
        bl <- 0
      }
      return(bl)
    }

    # The maximum root-to-tip length in the tree.
    max.length.to.root <- function(phylo) {
      max.length <- 0
      for (i in 1:length(phylo$tip.label)) {
        cur.length <- length.to.root(phylo,i)
        max.length <- max(max.length,cur.length)
      }
      return(max.length)
    }

    # The length from the root to the given node. Can be given either as a node ID or a tip label.
    length.to.root <- function(phylo,node) {
      tip.index <- node
      if (is.character(node)) {
        tip.index <- which(phylo$tip.label==node)
      }
      
      cur.node.b <- tip.index

      p.edges <- phylo$edge
      p.lengths <- phylo$edge.length
      
      length <- 0
      while(length(which(p.edges[,2]==cur.node.b)) > 0) {
        cur.edge.index <- which(p.edges[,2]==cur.node.b)
        cur.edge.length <- p.lengths[cur.edge.index]
        length <- length + cur.edge.length
        cur.node.a <- p.edges[cur.edge.index,1]
        cur.node.b <- cur.node.a # Move up to the next edge
      }
      return(length)
    }

    # Returns a data frame defining segments to draw the phylogenetic tree.
    phylo.layout.df <- function(phylo,layout.ancestors=FALSE,align.seq.names=NULL) {
      # Number of nodes and leaves.
      n.nodes <- length(phylo$tip.label)+phylo$Nnode
      n.leaves <- length(phylo$tip.label)

      # Create the skeleton data frame.
      df <- data.frame(
                       node=c(1:n.nodes),                                            # Nodes with IDs 1 to N.
                       x=0,                                                          # These will contain the x and y coordinates after the layout procedure below.
                       y=0,
                       label=c(phylo$tip.label,((n.leaves+1):n.nodes)),            # The first n.leaves nodes are the labeled tips.
                       is.leaf=c(rep(TRUE,n.leaves),rep(FALSE,n.nodes-n.leaves)),    # Just for convenience, store a boolean whether it's a leaf or not.
                       parent=0,                                                     # Will contain the ID of the current node's parent
                       children=0,                                                   # Will contain a list of IDs of the current node's children
                       branch.length=0                                               # Will contain the branch lengths
                       )

      # Collect the parents, children, and branch lengths for each node
      parent <- c()
      bl <- list()
      children <- list()
      event.count <- list()
      for (i in 1:nrow(df)) {
        node <- df[i,]$node
        parent <- c(parent,parent.node(phylo,node))
        bl <- c(bl,branch.length(phylo,node))
        children <- c(children,child.nodes(phylo,node))
        event.count <- c(event.count,generic.count(x,node,color.branches))
      }
      df$parent <- parent
      df$children <- children
      df$branch.length <- bl
      df$event.count <- as.numeric(event.count)

      # Start the layout procedure by equally spacing the leaves in the y-dimension.
      df[df$is.leaf==TRUE,]$y = c(1:n.leaves)

      found.any.internal.node.sequences <- FALSE

      # For each leaf: travel up towards the root, laying out each internal node along the way.
      for (i in 1:n.leaves) {
        cur.node <- i
        while (length(cur.node) > 0 && cur.node != -1) {
          # We always use branch lengths: x-position is simply the length to the root.
          df[cur.node,]$x <- length.to.root(phylo,cur.node)

          # The y-position for internal nodes is the mean of the y-position of the two children.
          children <- unlist(df[cur.node,]$children)
          if (length(children) > 0 && children[1] != -1) {
            child.a <- children[1]
            child.b <- children[2]
            child.a.y <- df[child.a,]$y
            child.b.y <- df[child.b,]$y
            df[cur.node,]$y <- (child.a.y+child.b.y)/2
          }

          # Try to find the index of this node in the alignment names.
          if (!is.null(align.seq.names)) {
            lbl <- df[cur.node,]$label
            index.in.names <- which(align.seq.names == lbl | align.seq.names %in% c(paste('Node',lbl),paste('Root node',lbl)))
            if (length(index.in.names)>0) {
              df[cur.node,]$y <- index.in.names
              if (!df[cur.node,]$is.leaf) {
                found.any.internal.node.sequences <- TRUE
              }
            }
          }
          
          cur.node <- unlist(df[cur.node,]$parent)
        }
      }
      
      # We have a data frame with each node positioned.
      # Now we go through and make two line segments for each node (for a 'square corner' type tree plot).
      line.df <- data.frame()
      for (i in 1:nrow(df)) {
        row <- df[i,]            # Data frame row for the current node.
        if (row$parent == -1) {
          next; # Root node!
        }
        p.row <- df[row$parent,] # Data frame row for the parent node.
        if (layout.ancestors && found.any.internal.node.sequences) {
          horiz.line <- data.frame(
                                   x=row$x,
                                   xend=p.row$x,
                                   y=row$y,
                                   yend=p.row$y,
                                   lbl=row$label,
                                   event.count=row$event.count
                                   )
          line.df <- rbind(line.df,horiz.line)
        } else {
          horiz.line <- data.frame(
                                   x=row$x,
                                   xend=p.row$x,
                                   y=row$y,
                                   yend=row$y,
                                   lbl=row$label,
                                   event.count=row$event.count
                                   )    # First a line from row.x to parent.
          vert.line <- data.frame(
                                  x=p.row$x,
                                  xend=p.row$x,
                                  y=row$y,
                                  yend=p.row$y,
                                  lbl=row$label,
                                  event.count=row$event.count
                                  ) # Now a line from row.y to parent.y
          
          #horiz.line <- data.frame(x=row$x,xend=(p.row$x+row$x)/2,y=row$y,yend=row$y,lbl=row$label)    # First a line from row.x to parent.
          #vert.line <- data.frame(x=(p.row$x+row$x)/2,xend=p.row$x,y=row$y,yend=p.row$y,lbl=row$label) # Now a line from row.y to parent.y
          line.df <- rbind(line.df,horiz.line,vert.line)
        }
      }
      return(line.df)
    }

    # Call this to put a ggplot panel into a specified layout position [for example: print(p,vp=subplot(1,2)) ]
    subplot <- function(x, y) viewport(layout.pos.col=x, layout.pos.row=y)

    # Call this to create a layout with x and y rows and columns, respectively
    vplayout <- function(x, y) {
      grid.newpage()
      pushViewport(viewport(layout=grid.layout(y,x)))
    }

    # Creates a color aesthetic for alignments
    alignment.colors <- function(scheme,darken=F) {
      scheme <- tolower(scheme)
      if (scheme == 'binary') {
        cols <- c(
                  '0' = "#000000",
                  '1' = '#FFFFFF'
                  )
      } else if (scheme == 'dna') {
        cols <- c(
                  'G' = "#FFFF00",
                  'C' = "#00FF00",
                  'T' = "#FF0000",
                  'A' = "#0000FF"
                  )
      } else if (scheme == 'numeric') {
        #cols <- heat.colors(10)      
        cols <- colorRampPalette(c("red","yellow","green"))(10)
        cols <- c(
                  '0' = cols[1],
                  '1' = cols[2],
                  '2' = cols[3],
                  '3' = cols[4],
                  '4' = cols[5],
                  '5' = cols[6],
                  '6' = cols[7],
                  '7' = cols[8],
                  '8' = cols[9],
                  '9' = cols[10]
        )
      } else if (scheme == 'taylor' || scheme == 'protein') {
        cols <- c(
                  'A' = "#CCFF00",       'a' = "#CCFF00",
                  'C' = "#FFFF00",       'c' = "#FFFF00",
                  'D' = "#FF0000",       'd' = "#FF0000",
                  'E' = "#FF0066",       'e' = "#FF0066",
                  'F' = "#00FF66",       'f' = "#00FF66",
                  'G' = "#FF9900",       'g' = "#FF9900",
                  'H' = "#0066FF",       'h' = "#0066FF",
                  'I' = "#66FF00",       'i' = "#66FF00",
                  'K' = "#6600FF",       'k' = "#6600FF",
                  'L' = "#33FF00",       'l' = "#33FF00",
                  'M' = "#00FF00",       'm' = "#00FF00",
                  'N' = "#CC00FF",       'n' = "#CC00FF",
                  'P' = "#FFCC00",       'p' = "#FFCC00",
                  'Q' = "#FF00CC",       'q' = "#FF00CC",
                  'R' = "#0000FF",       'r' = "#0000FF",
                  'S' = "#FF3300",       's' = "#FF3300",
                  'T' = "#FF6600",       't' = "#FF6600",
                  'V' = "#99FF00",       'v' = "#99FF00",
                  'W' = "#00CCFF",       'w' = "#00CCFF",
                  'Y' = "#00FFCC",       'y' = "#00FFCC",
                  '2' = "#888888",       '2' = "#888888",
                  'O' = "#424242",       'o' = "#424242",
                  'B' = "#7D7D7D",       'b' = "#7D7D7D",
                  'Z' = "#EEEEEE",       'z' = "#EEEEEE",
                  'X' = "#000000",       'x' = "#000000"
                  )
      } else if (scheme == 'codon') {
                                        # Get the protein colors.
        protein.colors <- alignment.colors('protein')
                                        # Create a list of codons.
        ca <- CodonAlphabet()
        nucs <- c('G','A','C','T')
        codons <- expand.grid(nucs,nucs,nucs,stringsAsFactors=F)
                                        # For each codon give the protein color.
        codon.colors <- c()
        for (i in 1:nrow(codons)) {
          codon = paste(codons[i,],collapse='')
          aa <- translateCodon(ca,codon)
          codon.colors[codon] = protein.colors[aa]
        }
        cols <- codon.colors
      } else if (scheme == 'combined') {
        dna.colors <- alignment.colors('dna')
        binary.colors <- alignment.colors('binary')
        protein.colors <- alignment.colors('protein')
        cols <- c(dna.colors,protein.colors,binary.colors)
      } else if (scheme == 'combined_codon') {
        dna.colors <- alignment.colors('dna')
                                        # Make the DNA stand out here by being a little darker
        for (i in 1:length(dna.colors)) {
          color <- dna.colors[i]
          darker.color <- darker(color)
          dna.colors[i] <- darker.color
        }
        binary.colors <- alignment.colors('binary')
        protein.colors <- alignment.colors('protein')
        codon.colors <- alignment.colors('codon')
                                        # Put them all together. (One remaining issue: the protein G,A,T,C will be colored as DNA!)
        cols <- c(dna.colors,protein.colors,binary.colors,codon.colors)
      }

      if (darken) {
        for (i in 1:length(cols)) {
          color <- cols[i]
          darker.color <- darker(color,0.85)
          cols[i] <- darker.color
        }
      }
      
      return(cols)
    }

    darker <- function(color,factor=0.7) {
      x <- col2rgb(color)
      x <- round(x * factor)
      y <- rgb(x[1],x[2],x[3],maxColorValue=255)
      return(y)
    }
    lighter <- function(color) {
      x <- col2rgb(color)
      x <- round(x * 1.2)
      y <- rgb(min(x[1],255),min(x[2],255),min(x[3],255),maxColorValue=255)
      return(y)
    }

    # Scores each column according to the branch length of the subtree created by
    # non-gap residues (we use nongap.bl as the var name), and stores the 'nongap.str'
    # which is the pasted list of labels for non-gapped sequences at this site.
    # This information is used by the 'remove.gaps' function to remove columns to
    # reach a certain alignment length threshold.
    score.aln.columns <- function(tree,aln) {
      aln.length <- length(aln[1,])

      score.df <- data.frame()
      for (i in 1:aln.length) {
        aln.column <- aln[,i]

        nongap.seqs <- names(aln.column[aln.column != '-'])
        gap.seqs <- names(aln.column[aln.column == '-'])

        # Get the non-gap branch length.
        if (length(nongap.seqs) == 1) {
          nongap.node <- node.with.label(tree,nongap.seqs[1])
          nongap.bl <- branch.length(tree,nongap.node)
        } else {
          nongap.tree <- drop.tip(tree,gap.seqs)
          nongap.bl <- sum(nongap.tree$edge.length)
        }

        nongap.str <- paste(nongap.seqs,collapse=';')
        cur.df <- data.frame(
          pos=i,
          score=nongap.bl,
          nongap.str=nongap.str,
          stringsAsFactors=F
        )
        score.df <- rbind(score.df,cur.df)
      }
      score.df <- score.df[order(score.df$score,score.df$pos),]
      return(score.df) 
    }

    # Goes through the alignment of the sim object and removes columns until either the desired
    # tolerance is reached or there are no more low-scoring columns to remove (whichever comes
    # first). Tolerance is defined as the ratio of the alignment length to the mean sequence
    # length. So, an alignment with no indels at all is exactly 1; an alignment with lots
    # of deletions (but no insertion) is less than 1; an alignment with lots of insertion is
    # greater than 1.
    #
    # Values of 0.9 - 1.3 tend to give good results in a variety of situations.
    #
    remove.gaps <- function(sim,tolerance) {
      aln <- sim$.alignment
      tree <- sim$.phylo
      col.scores <- score.aln.columns(tree,aln)

      # Store the deletion markers in a separate data frame.
      deletion.df <- NULL

      # Get the mean sequence length
      lengths <- apply(aln,1,function(x) {
        x <- x[x != '-']
        return(stringLength(paste(x,collapse='')))
      })
      mean.seq.length <- mean(lengths)

      repeat {
        aln.length <- length(aln[1,])  
        ratio <- aln.length / mean.seq.length
        if (ratio < tolerance) {
          break;
        }

        # Take the next site from the sorted scores
        lowest.scores <- col.scores[1,]
        col.scores <- col.scores[-c(1),]
        cur.pos <- lowest.scores$pos # Current position of lowest-scoring column.
        cur.score <- lowest.scores$score # The current column score.
        cur.str <- lowest.scores$nongap.str # The current column's nongap pattern.

        # Grab the entire 'current chunk' of alignment which has the same
        # score and non-gap string.
        repeat {
          first.pos <- col.scores[1,'pos']
          first.score <- col.scores[1,'score']
          first.str <- col.scores[1,'nongap.str']
          if (cur.score == max(col.scores$score)) {
            lowest.scores <- NULL
            cur.ratio <- length(aln[1,]) / mean.seq.length
            print(sprintf("Nothing left to remove at ratio %.2f!",cur.ratio))
            break;
          }
          if (first.pos == cur.pos + 1 && first.score == cur.score && first.str == cur.str) {
            cur.pos <- col.scores[1,]$pos
            lowest.scores <- rbind(lowest.scores,col.scores[1,])
            col.scores <- col.scores[-1,]
          } else {
            #print("Done!")
            break;
          }
        }

        if (is.null(lowest.scores)) {
          break;
        }

        # remove.us should be a contiguous vector of integers,
        # representing the set of columns to remove.
        remove.us <- lowest.scores$pos

        if (any(diff(remove.us) > 1)) {
          print("ERROR: Removing a non-consecutive set of columns!")
        }

        #print(paste("Removing at ",paste(remove.us[1])))

        # Go through columns from right to left, making sure to update
        # the new positions of columns on the right side of the splice.
        rev.pos <- rev(remove.us)
        for (i in 1:length(rev.pos)) {
          cur.pos <- rev.pos[i]
          aln <- splice.column(aln, cur.pos)

          # Update new positions of column scores
          above <- which(col.scores$pos > cur.pos)
          col.scores[above,]$pos <- col.scores[above,]$pos - 1

          # Update new positions of deletion locations.
          if (!is.null(deletion.df) && nrow(deletion.df) > 0) {
            above <- which(deletion.df$pos > cur.pos)
            deletion.df[above,]$pos <- deletion.df[above,]$pos - 1
          }
        }


        # Add a single entry to the data frame of deletions, to be used
        # by the plot function to indicate deletion points.
        cur.deletion <- data.frame(
          pos = cur.pos, # The first position AFTER the deletion splice.
          length = length(rev.pos), # The length of the block removed.
          nongap.str = as.character(cur.str), # nongap sequence IDs for this deletion
          stringsAsFactors=F
        )
        #print(cur.deletion)
        deletion.df <- rbind(deletion.df,cur.deletion)
      }

      # Create a new PhyloSim object, assign the tree & aln, and return.
      sim.temp <- PhyloSim();
      sim.temp$.alignment <- aln
      sim.temp$.phylo <- tree
      sim.temp$.indels <- deletion.df
      return(sim.temp)
    }

    splice.column <- function(aln,pos) {
      return(aln[,-pos])
    }
    
    ####################################
    ### Let the real plotting begin! ###
    ####################################
    
    # Apply the deletion tolerance if needed.
    if (!is.null(aln.length.tolerance)) {
      x <- remove.gaps(x, tolerance=aln.length.tolerance)
      indels <- x$.indels
    } else {
      indels <- NULL
    }

    df <- data.frame()
    aln <- x$.alignment
    phylo <- x$.phylo

                                        # Do some reordering of alignment & tree.
    if (!any(is.na(phylo))) {
      x$.phylo <- reorder(x$.phylo, order="cladewise");
      phylo    <- x$.phylo
      aln <- sort.aln.by.tree(aln,phylo)
    }

    names <- dimnames(aln)[[1]]
   
    #print(paste("Aln length:",length(aln[1,])))
    #print(paste("Num seqs:",length(names)))

   # Create a factor of all the characters in the alignment.
   char.levels <- sort(unique(as.vector(aln)))
   names.levels <- names
   
    for (i in 1:length(names)) {
      char.list <- aln[i,]
      name <- names[i]
                                        # Store the indices of where the gaps are -- we won't plot the gaps.
      gaps <- char.list == '-' 
      seq.pos <- seq(1,length(char.list))
                                        # Get the position and character of each non-gap residue.
      pos.nogaps <- seq.pos[gaps==FALSE]
      char.nogaps <- as.character(char.list[gaps==FALSE])
                                        # Create a data frame with 1 row per residue to plot.
      df <- rbind(df,data.frame(
                                id=factor(x=rep(name,length(pos.nogaps)),levels=names.levels),      # Sequence ID to which this residue belongs
                                seq_index=rep(i,length(pos.nogaps)),  # Index of the containing sequence
                                pos=pos.nogaps,                       # Alignment position
                                char=factor(x=char.nogaps,levels=char.levels)                      # Character of the residue
                                ))
    }
    
                                        # Turn the IDs into a factor to plot along the y axis.
    
    if (!plot.ancestors) {
                                        # Remove the ancestral nodes from the plot.
      tip.name.indices <- grep("node",names,ignore.case=TRUE,invert=TRUE)
      names <- names[tip.name.indices]
      df$id <- factor(df$id,levels=names)
      df <- subset(df,id %in% names)
    }

   df$type <- 'aln'
   
   ### Add indels to the data frame.
   if (!is.null(indels)) {
     # For each non-gap sequence of each chunk deleted, add a row
     # to the data frame.
     del.df <- data.frame()

     # For each position, store the count of indels in a track.
     max.pos <- max(c(df$pos,indels$pos))
     indel.histogram <- data.frame(
       pos=1:max.pos - 0.5,
       count=0,
       length=0
     )
     for (i in 1:nrow(indels)) {
       row <- indels[i,]
       seqs <- strsplit(row$nongap.str,";")[[1]]
       if (length(seqs) == 0) {
         # Edge case: an indel row came from a column with no aligned sequence,
         # so the 'nongap.str' is empty. Just continue on...
         next()
       }

       cur.df <- data.frame(
         id=seqs,
         pos=row$pos,
         length=row$length,
         type='indel'
       )
       del.df <- rbind(del.df,cur.df)

       # Tick up the histogram.
       indel.histogram[row$pos,]$count <- indel.histogram[row$pos,]$count + 1
       indel.histogram[row$pos,]$length <- indel.histogram[row$pos,]$length + row$length
     }

     # Sync the two data frame's columns, fill empty stuff with NAs.
     columns.from.df <- colnames(df)[!(colnames(df) %in% colnames(del.df))]
     columns.from.del <- colnames(del.df)[!(colnames(del.df) %in% colnames(df))]
     del.df[,columns.from.df] <- NA
     df[,columns.from.del] <- NA

     df <- rbind(df,del.df)

     # Transform the histogram and add it to our tracks.
     max.count <- max(indel.histogram$count)
     max.length <- max(indel.histogram$length)
     indel.histogram$y_lo <- 0
     indel.histogram$score <- indel.histogram$count / (max.count+1)
     indel.histogram$y_hi <- indel.histogram$score
     indel.histogram$id <- 'Hidden Indel Count'
     indel.histogram$height <- 5
     indel.histogram$layout <- 'below'
     indel.histogram$color.gradient <- 'darkblue,darkblue'
     indel.histogram$type <- 'track'

     #indel.len <- indel.histogram
     #indel.len$id <- 'Hidden Indel Length'
     #indel.len$score <- indel.len$length / (max.length+1)
     #indel.len$y_hi <- indel.len$score
     #indel.len$color.gradient <- 'darkgreen,darkgreen'
     
     if (!is.null(tracks)) {
       tracks <- c(tracks,list(indel.histogram))
     } else {
       tracks <- list(indel.histogram)
     }     
   }


   if (plot.nongap.bl && is.phylo(phylo)) {
     score.df <- score.aln.columns(phylo,aln)
     max.bl <- max(score.df$score)
     bl.track <- data.frame(
       id = 'Non-gap Branch Length',
       layout = 'below',
       pos = score.df$pos,
       score = score.df$score / max.bl * 0.9,
       y_hi = score.df$score / max.bl * 0.9,
       color.gradient = 'red,black,black'
     )
     if (!is.null(tracks)) {
       tracks <- c(tracks,list(bl.track))
     } else {
       tracks <- list(bl.track)
     }
   }
   
   # Track input format is a list of data frames with one row per feature to be
   # displayed, with the following columns. The only mandatory column is 'pos';
   # all others have sensible default values.
   # ---
   # [fields below are unique per row]
   # pos:     The sequence position (starting with 1) of the feature
   # score:   The score (between 0 and 1) of the feature. Scores above 1 or below
   #          zero will be truncated.
   # y_lo:    The lower Y offset (between 0 and 1) of the feature block.
   # y_hi:    The upper Y offset (between 0 and 1) of the feature block. These two
   #          values allow bars to be positioned along the y-axis.
   # [fields below are unique per track; the value from the first row is used.]
   # id:      The display ID for the track.
   # layout:  Set to 'above' to put the track above the alignment, 'below' for below.
   # height:  The number of alignment rows for the track to span in height.
   # color.gradient: A comma-separated list of colors to interpolate between when coloring
   #          the blocks. Examples: 'white,red' 'blue,gray,red' '#FF00FF,#FFFFFF'
   # color:   A single color to use for the track, no matter what the scores. Overridden
   #          color.gradient if both exist.
   # 
   # ---
   #
   
   # What we do is add the track data to the alignment data frame (so it gets
   # paged and scaled properly along with the alignment data) and then separate
   # it out before plotting, so it can be plotted separately from the alignment.
   df$track_index <- -1

   if (!is.null(tracks)) {
     df$score <- NA
     i <- 0
     for (track in tracks) {
       i <- i + 1
       track$track_index <- i
       track$type <- 'track'
       
       # Add default values.
       if (is.null(track$background)) {
         track$background <- 'white'
       }
       if (length(track$pos) == 0) {
         # If no positions are included in the data frame, set the first position
         # to 1 and put the foreground color same as the background.
         # This has the effect of creating a 'spacer' row.
         track$pos <- 1
         track$color <- track[1,]$background
       }
       if (is.null(track$layout)) {
         track$layout <- 'above'
       }
       if (is.null(track$color.gradient)) {
         if (!is.null(track$color)) {
           # No color gradient exists, but we have 'color' instead. Use that.
           track$color.gradient <- paste(track[1,]$color, track[1,]$color, sep=',')
         } else {
           # No color.gradient OR color value exists, so use the default white-to-black.
           track$color.gradient <- 'white,black'
         }
       }
       if (is.null(track$score)) {
         track$score <- 1
       }
       if (is.null(track$y_lo)) {
         track$y_lo = 0
       }
       if (is.null(track$y_hi)) {
         track$y_hi = 1
       }
       if (is.null(track$id)) {
         track$id <- paste('Track',i)
       }
       if (is.null(track$height) || is.na(track$height)) {
         track$height <- 4
       }

       # Ensure that we don't have positions at zero or below.
       track[track$pos <= 0,'pos'] <- 1

       # Limit score range
       track$score <- pmin(track$score,1)
       track$score <- pmax(track$score,0)
       
       # Sync the two data frame's columns, fill empty stuff with NAs.
       columns.from.aln <- colnames(df)[!(colnames(df) %in% colnames(track))]
       columns.from.track <- colnames(track)[!(colnames(track) %in% colnames(df))]
       track[,columns.from.aln] <- NA
       df[,columns.from.track] <- NA

       track$type <- 'track'
       df <- rbind(df,track)
     }
   }

   if (num.pages != 'auto') {
     num.pages <- as.numeric(num.pages)
   }

    aln.length <- max(df$pos)
    chars.per.page <- aln.length
    num.seqs <- length(names)
   
    if (tolower(num.pages) == 'auto' || num.pages > 1) {
                                        # Plotting a multi-page alignment.
      if (tolower(num.pages) == 'auto') {

        # If we have tracks, add the total track height to the 'num.seqs' variable.
        track.rows <- subset(df,type == 'track')
        if (nrow(track.rows) > 0) {
          track.indices <- sort(unique(track.rows$track_index))
          for (track.index in track.indices) {
            sub.track <- subset(track.rows,track_index==track.index)
            if (nrow(sub.track) > 0) {
              num.seqs <- num.seqs + sub.track[1,]$height 
            }
          }
        }
                                        # Formula to get a square-ish total plot.
        num.pages <- sqrt(aln.length/num.seqs)
        num.pages <- ceiling(num.pages)+1
                                        # One-page rule for short alignments.
        if (aln.length < 30) {num.pages <- 1}
      }
                                        # Add a 'page' factor to the data frame and use facet_grid.
      chars.per.page <- ceiling(aln.length / num.pages)
      df$page <- floor((df$pos-1) / chars.per.page) + 1
      if (nrow(subset(df,page <= 0)) > 0) {
        df[df$page <= 0,]$page <- 1  # Fix errors where pos=0.5 goes to page 0
      }
      df$pos <- df$pos - (chars.per.page*(df$page-1))
      page.labels <- paste((0:(num.pages-1))*chars.per.page+1,(1:num.pages)*chars.per.page,sep="-")
      page.numbers <- sort(unique(df$page))
      page.labels <- page.labels[page.numbers]
      df$page <- factor(df$page,levels=page.numbers,labels=page.labels)

      num.pages <- length(page.labels)
      #print(paste("Num pages:",num.pages))

    } else {
      # We've only got one page. Create a factor...
      df$page <- 1
      df$page <- factor(df$page,levels=c(1),labels=c('1'))

      # Store some values which will be used later.
      aln.length <- max(df$pos)
      chars.per.page <- aln.length
    }

    if (color.scheme == 'auto') {
      all.chars <- unlist(aln)
      all.chars <- all.chars[all.chars != '-']
      n.chars <- length(unique(toupper(all.chars)))

      dna <- c('a','t','g','c')
      dna <- c(dna,toupper(dna))

      protein <- letters
      protein <- protein[!(protein %in% c('b','j','o','u','x','z'))]
      protein <- c(protein,toupper(protein))

      ca <- CodonAlphabet()
      nucs <- c('G','A','C','T')
      codon.grid <- expand.grid(nucs,nucs,nucs,stringsAsFactors=F)
      codons <- c()
      for (i in 1:nrow(codon.grid)) {
        codons <- c(codons,paste(codon.grid[i,],collapse=''))
      }
      if(any(all.chars %in% codons)) {
                                        # If we see any codon alphabets, use the combined_codon
        color.scheme <- 'combined_codon'
      } else {      
                                        # Else just use the combined color scheme. It's good enough!
        color.scheme <- 'combined'
      }
    }

    legend.title <- color.scheme

    # Remove any tracks from the main aln data frame.
   tracks <- subset(df,type=='track')
   indels <- subset(df,type=='indel')
   df <- subset(df,type=='aln')

   # Set positional values in the aln data frame.
   df$xx <- df$pos
   df$yy <- as.numeric(df$id)
   df$xmin <- df$xx - .5
   df$xmax <- df$xx + .5
   df$ymin <- df$yy - .5
   df$ymax <- df$yy + .5

   darken.colors <- FALSE
   if (nrow(indels) > 0) {
     darken.colors <- TRUE
   }
   
   color.map <- alignment.colors(color.scheme,darken=darken.colors)
   df$colors <- color.map[as.character(df$char)]
   
   # Set the base for y-axis configurations.
   y.lim <- c(0,length(names)+1)
   y.breaks <- 1:length(names)
   y.labels <- names
   
   # Create the ggplot panel.
   p <- ggplot(df,aes(x=xx,y=yy,xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax))
   p <- p + geom_rect(aes(fill=colors))

   if (!is.null(aln.xlim)) {
     aln.limits <- aln.xlim
   } else {
     aln.limits <- c(0,max(df$pos)+1)
   }
   
   if (nrow(tracks) > 0) {
     # Handle tracks.

     # These variables hold the current above and below offsets.
     cur.y.above <- length(names) + 1 - .5
     y.lim[2] <- length(names) + 1 - .5
     cur.y.below <- 0.5

     bg.out <- data.frame()
     track.out <- data.frame()
     track.indices <- sort(unique(tracks$track_index))
     for (track.index in track.indices) {
       sub.track <- subset(tracks,track_index==track.index)

       # Collect the track-wide features.
       track.id <- sub.track[1,]$id
       track.height <- sub.track[1,]$height
       track.layout <- sub.track[1,]$layout
       color.gradient <- strsplit(sub.track[1,]$color.gradient,',')[[1]]
       track.bg <- sub.track[1,]$background
       track.ramp <- colorRamp(colors=color.gradient)
       sub.track$colors <- rgb(track.ramp(sub.track$score),maxColorValue=255)

       sub.track$xx <- sub.track$pos
       sub.track$xmin <- sub.track$pos-.5
       sub.track$xmax <- sub.track$pos+.5

       if (track.layout == 'below') {
         sub.track$yy <- cur.y.below
         sub.track$ymin <- cur.y.below - track.height
         sub.track$ymax <- cur.y.below

         y.lim[1] <- cur.y.below - track.height
         y.breaks <- c(y.lim[1] + track.height/2,y.breaks)
         y.labels <- c(as.character(track.id),y.labels)

         # Temporarily store the current min and max for y.
         cur.y.min <- cur.y.below - track.height
         cur.y.max <- cur.y.below

         # Add our track height to the state variable.
         cur.y.below <- cur.y.below - track.height
       } else {
         sub.track$yy <- cur.y.above
         sub.track$ymin <- cur.y.above
         sub.track$ymax <- cur.y.above + track.height
         
         y.lim[2] <- cur.y.above + track.height
         y.breaks <- c(y.breaks,y.lim[2] - track.height/2)
         y.labels <- c(y.labels,as.character(track.id))

         # Temporarily store the current min and max for y.
         cur.y.min <- cur.y.above
         cur.y.max <- cur.y.above + track.height

         # Add our track height to the state variable.
         cur.y.above <- cur.y.above + track.height
       }

       # Adjust bar position if we have y_lo and y_hi values.
       if(length(sub.track$y_lo) > 0) {
         sub.track$ymin <- cur.y.min + track.height*sub.track$y_lo
       }
       if (length(sub.track$y_hi) > 0) {
         sub.track$ymax <- cur.y.min + track.height*sub.track$y_hi
       }

       track.out <- rbind(track.out,sub.track)

       # Create a background rectangle for each page, to place behind the current track.
       pages <- sort(unique(df$page))
       page.indices <- sort(unique(as.integer(df$page)))
       for (page.index in 1:length(pages)) {
         pg <- pages[page.index]
         current.track.bg <- data.frame(
           page=pg,
           colors=track.bg,
           xx=0.5,
           yy=cur.y.min,
           xmin=0.5,
           xmax=chars.per.page + 0.5,
           ymin=cur.y.min,
           ymax=cur.y.max
         )
         bg.out <- rbind(bg.out,current.track.bg)
       }
     }

     # Add layers for the backgrounds and tracks.
     p <- p + geom_rect(aes(fill=colors),data=bg.out)
     p <- p + geom_rect(aes(fill=colors),data=track.out)
   }

   if (nrow(indels) > 0) {
     # Plot indels as small bars on top of characters.
     indel.width <- 0.25
     indels$pos <- indels$pos - .5 # Position indel on seq boundary.
     indels$xx <- indels$pos
     indels$yy <- as.numeric(indels$id)
     indels$xmin <- indels$xx - indel.width
     indels$xmax <- indels$xx + indel.width
     indels$ymin <- indels$yy - .5
     indels$ymax <- indels$yy + .5
     indels$colors <- 'black'

     p <- p + geom_rect(aes(fill=colors),data=indels)
   }
   
   #color.map <- alignment.colors(color.scheme)
   p <- p + scale_fill_identity()

   p <- p + scale_x_continuous(limits=aln.limits,expand=c(0,0))
   
   if (plot.labels) {
     p <- p + scale_y_continuous(limits=y.lim,breaks=y.breaks,labels=y.labels,expand=c(0,0))
   } else {
     p <- p + scale_y_continuous(limits=y.lim,breaks=y.breaks,labels=rep('',length(y.labels)),expand=c(0,0))
   }

   if (aspect.ratio) {
      axis.text.size <- 5
      char.text.size <- 2
   }
   
    if (num.pages > 1) {
      p <- p + facet_grid(page ~ .)
    }

    if (char.text.size == 'auto') {
      char.text.size <- 125 / (num.pages * (num.seqs+1))
      char.text.size <- min(char.text.size,10)
      char.text.size <- max(char.text.size,1)
    }
   
    if (plot.chars) {
      p <- p + geom_text(aes(label=char),colour='black',size=char.text.size)
    }    
    if (aspect.ratio) {
      p <- p + coord_equal(ratio=aspect.ratio)
    }

    if (axis.text.size == 'auto') {
      axis.text.size <- 500 / (num.pages * (num.seqs+1))
      axis.text.size <- min(axis.text.size,10)
      axis.text.size <- max(axis.text.size,1)
    }
   
    plot.theme <- theme(
		  axis.text.y = element_text(size=axis.text.size,hjust=1),
		  axis.title.x = element_blank(),
		  axis.title.y = element_blank(),
                  axis.ticks = element_blank(),
                  panel.grid.minor = element_blank(),
                  panel.grid.major = element_blank(),
                      
                  plot.margin = unit(c(0,0,0,0),'npc')
                  )
    p <- p + plot.theme

    if (!plot.legend) {
       p <- p + theme(legend.position='none')
    }
    
    if (plot.tree) {      
      if (plot.ancestors) {
        tree.df <- phylo.layout.df(phylo,layout.ancestors=TRUE,align.seq.names=names)
      } else {
        tree.df <- phylo.layout.df(phylo,align.seq.names=names)
      }

      if (num.pages > 1) {
        tree.df$page <- 1
        df.copy <- tree.df
        for (i in 2 : num.pages) {
          df.copy$page <- i
          tree.df <- rbind(tree.df,df.copy)
        }
      }

      max.length <- max.length.to.root(phylo)
      aln.length <- length(aln[1,])
      n.leaves <- length(names)
      
      if (max(tree.df$event.count) > 0) {
        #print(paste("Coloring tree by",color.branches))
        q <- ggplot(tree.df,aes(colour=event.count))
        q <- q + scale_colour_gradient()
      } else {
        q <- ggplot(tree.df)
      }

      q <- q + geom_segment(aes(x=x,y=y,xend=xend,yend=yend))
      if (plot.labels) {
        q <- q + scale_y_continuous(limits=y.lim,breaks=y.breaks,labels=y.labels,expand=c(0,0))
      } else {
        q <- q + scale_y_continuous(limits=y.lim,breaks=y.breaks,labels=rep('',length(y.labels)),expand=c(0,0))
      }
      if (!is.null(tree.xlim)) {
        tree.limits <- tree.xlim
      } else {
        tree.limits <- c(0,max.length)
      }
      q <- q + scale_x_continuous(limits=tree.limits,expand=c(0.05,0))
      q <- q + plot.theme
#      q <- q + theme(plot.margin = unit(c(0,0,0,0),'npc'))
      if (num.pages > 1) {
        q <- q + facet_grid(page ~ .)
        q <- q + theme(strip.text.y=element_blank())
      }

      if (!plot.legend) {
        q <- q + theme(legend.position='none')
      }

      if (aspect.ratio) {
        warning("Aspect ratio set while plotting tree -- the alignment and tree won't line up!")
      }
      
      vplayout(4,1)
      print(p,vp=subplot(2:4,1))
      print(q,vp=subplot(1,1))
    } else {
      p <- p + plot.theme
      print(p)
    }
    
    # this method has no meaningful return value
  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: summary.PhyloSim
##
###########################################################################/**
#
# @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 a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#	sim<-PhyloSim(
#		name="TinySim",
#		phylo=rcoal(3),
#		root.seq=NucleotideSequence(string="ATG",processes=list(list(JC69())))
#	);
#       # get a summary
#       summary(sim)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "summary",
  class="PhyloSim",
  function(
    object,
    ...
  ){

     this<-object;
     this$.summary$"Name"<-this$name;
     this$.summary$"Id"<-this$id;

		 if(is.Sequence(this$rootSeq)){
			root.seq<-this$rootSeq$id;
		 } else {
		 	this$.summary$"Root Sequence"<-"undefined";
		 }
		 if(is.Sequence(this$rootSeq)){
		 	this$.summary$"Root Sequence big rate"<-this$rootSeq$bigRate;
		 }
		 if(is.phylo(this$.phylo)){

     	this$.summary$"Tree length"<-this$treeLength;
		 	phylo.details<-grep(pattern="[[:alnum:]]+",x=capture.output(print(this$.phylo)),perl=TRUE,value=TRUE);
		 	phylo.details<-paste("\n",phylo.details,collapse="",sep="\t");
			this$.summary$"Phylo object details"<-phylo.details;

		 } else {
			this$.summary$"Phylo object details"<-"undefined";
		 }

		 aln<-"undefined";
		 if(is.matrix(this$alignment)){
				aln<-"defined";	
		 }
     this$.summary$"Alignment"<-aln;
     this$.summary$"Log file"<-this$.log.file;
     this$.summary$"Log level"<-this$.log.level;

     NextMethod();


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##### Logging Methods #####

##	
## Method: getLogFile
##	
###########################################################################/**
#
# @RdocMethod getLogFile
# 
# @title "Get the name of the file used for logging" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# Create a PhyloSim object
#	sim<-PhyloSim();
#	# get the name of the log file		
#	getLogFile(sim)	
#	# modify log file name
#	setLogFile(sim,"OldLog.txt")
#	# get/set log file name via virtual field
#	sim$logFile
#	sim$logFile<-"NewLog"
#	sim$logFile
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getLogFile", 
	class="PhyloSim", 
	function(
		this,
		...
	){

		this$.log.file;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setLogFile
##	
###########################################################################/**
#
# @RdocMethod setLogFile
# 
# @title "Set the name of the file used for logging" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{value}{The name of the file used for logging.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new logfile.
# } 
# 
# \examples{
#	# Create a PhyloSim object
#	sim<-PhyloSim();
#	# get the name of the log file		
#	getLogFile(sim)	
#	# modify log file name
#	setLogFile(sim,"OldLog.txt")
#	# get/set log file name via virtual field
#	sim$logFile
#	sim$logFile<-"NewLog"
#	sim$logFile
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setLogFile", 
	class="PhyloSim", 
	function(
		this,
		value,
		...
	){

			if(missing(value)){
				throw("No value provided!\n");
			}
			value<-as.character(value);
			if( length(value) != 1 ){
				throw("The new value must be a character vector of length 1!\n");
			}
			else{ 
				if( file.access(value,mode=0) == c(0) ){
					warning("The specified file already exists and it will be overwritten during simulation!\n");
				}
				this$.log.file<-value;

			}
			return(this$.log.file);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getLogLevel
##	
###########################################################################/**
#
# @RdocMethod getLogLevel
# 
# @title "Get the log level from a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The log level as an integer vector of length one.
# } 
# 
# \examples{
#	# Create a PhyloSim object
#	sim<-PhyloSim();
#	# get/set log level
#	getLogLevel(sim)
#	setLogLevel(sim,0)
#	# set/get log level via virtual field
#	sim$logLevel<- -1
#	sim$logLevel
#	# clean up
#	unlink(sim$logFile)
# } 
# 
# @author 
# 
# \seealso{ 
# 	setLogLevel PhyloSim 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getLogLevel", 
	class="PhyloSim", 
	function(
		this,
		...
	){

		this$.log.level;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setLogLevel
##	
###########################################################################/**
#
# @RdocMethod setLogLevel
# 
# @title "Set the log level for a given PhyloSim object" 
# 
# \description{ 
#	@get "title".
#	
#	No logging is performed if the log level is negative. If the log level is zero, the messages passed to 
#	the \code{Log} method will be writen in the log file. If the log level is positive, the messages passed to
#	the \code{Debug} method are saved as well.
#
#	The default log level is -1. The specified file will be truncated in the case it already exists.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{value}{The new log level as an integer.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new level as an integer vector of length one.
# } 
# 
# \examples{
#	# Create a PhyloSim object
#	sim<-PhyloSim();
#	# get/set log level
#	getLogLevel(sim)
#	setLogLevel(sim,0)
#	# set/get log level via virtual field
#	sim$logLevel<- -1
#	sim$logLevel
# } 
# 
# @author 
# 
# \seealso{ 
# 	getLogLevel PhyloSim 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setLogLevel", 
	class="PhyloSim", 
	function(
		this,
		value,
		...
	){

			if(missing(value)){
				throw("No value provided!\n");
			}
			if((!is.numeric(value)) | length(value) != 1 ){
				throw("The new value must be a numeric vector of length 1!\n");
			}
			else{ 
    			# Create/wipe out log file.
				if(value >= 0 ){
						if(file.access(this$.log.file,mode=0) == c(0)){
							warning("The log file already existed and it was wiped out!\n");
						}
						# Creating the associated connection:
						this$.log.connection<-file(paste(this$.log.file),"w+");
				}
				this$.log.level<-value;
			}
			return(this$.log.level);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .getMessageTemplate
##	
setMethodS3(
	".getMessageTemplate", 
	class="PhyloSim", 
	function(
		this,
		...
	){

		template<-list(
			time=paste("[",Sys.time(),"]",sep=""),
			level="Info",
			event=""
		);

		return(template);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .logMessage
##	
setMethodS3(
	".logMessage", 
	class="PhyloSim", 
	function(
		this,
		message,
		...
	){

			if(missing(message)){
				throw("No message given!\n");
			}
			else if (!is.list(message)){
				throw("The message should be a list");
			}
			else if( length(intersect(names(message),c("time","level","event"))) != 3){
				throw("The \"time\", \"level\" and \"event\" elements are mandatory in the message list!\n");
			}
			else {
				writeLines(paste(message[["time"]]," "),con=this$.log.connection,sep="");
				message[["time"]]<-NULL;
				writeLines(paste(message[["level"]]," "),con=this$.log.connection,sep="");
				message[["level"]]<-NULL;
				writeLines(paste(message[["event"]]," "),con=this$.log.connection,sep="");
				message[["event"]]<-NULL;
				writeLines(paste(message,collapse=", "),con=this$.log.connection,sep="");
				writeLines("\n",con=this$.log.connection,sep="");
				return(TRUE);
			}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: Log
##	
###########################################################################/**
#
# @RdocMethod Log
# 
# @title "Save a message in the PhyloSim log file" 
# 
# \description{ 
#	@get "title".
#
#	The message is written to the log file only if the log level is non-negative. You can use this method for logging
#	in the case you write classes for PhyloSim.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{message}{A character vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The message (invisible).
# } 
# 
# \examples{
#	# create a PhyloSim object,
#	# with logLevel set to zero	
#	sim<-PhyloSim(log.level=0);
#	# log a message
#	Log(sim,"Hiya there!");
#	# close log connection
#	close(sim$.log.connection)
#	# print out the log file
#	cat(paste(scan(file=sim$LogFile,what=character(),sep="\n"),collapse="\n"));cat("\n");
#	# clean up
#	unlink(sim$logFile)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"Log", 
	class="PhyloSim", 
	function(
		this,
		message,
		...
	){
	
			if(this$.log.level < 0){
				return(invisible(FALSE))
			}
			if(missing(message)){
				throw("No message given!\n");
			} else {
				template<-.getMessageTemplate(this);
				template$level<-"Info";
				message<-c(template,as.list(message));
				.logMessage(this, message);
				return(invisible(message));
			}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: Debug
##	
###########################################################################/**
#
# @RdocMethod Debug
# 
# @title "Save a debug message in the PhyloSim log file" 
# 
# \description{ 
#	@get "title".
#
#	The debug message is written to the log file only if the log level is non-negative. You can use this method for logging
#	debug messages in the case you write classes for PhyloSim.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{message}{A character vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The message (invisible).
# } 
# 
# \examples{
#	# create a PhyloSim object,
#	# with logLevel set to zero	
#	sim<-PhyloSim(log.level=0);
#	# log a debug message
#	Debug(sim,"Some useful detail...");
#	# close log connection
#	close(sim$.log.connection)
#	# print out the log file
#	cat(paste(scan(file=sim$LogFile,what=character(),sep="\n"),collapse="\n"));cat("\n");
#	# clean up
#	unlink(sim$logFile)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"Debug", 
	class="PhyloSim", 
	function(
		this,
		message,
		...
	){
		
			if(missing(message)){
				throw("No message given!\n");
			} 
			else if( this$.log.level <= 0){
				return(invisible(FALSE))
			}
			else {
				template<-.getMessageTemplate(this);
				template$level<-"DEBUG";
				message<-c(template,as.list(message));
				.logMessage(this, message);
				return(invisible(message));
			}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .UpdateBranchStats
##	
setMethodS3(
	".UpdateBranchStats", 
	class="PhyloSim", 
	function(
		this,
		event,
		details,
		branch.number,
		...
	){

		if(details$type == "substitution"){
		
            if(details$accepted) {
	
			if(is.null(this$.branch.stats[[as.character(branch.number)]]$substitution)){
				this$.branch.stats[[as.character(branch.number)]]$substitution<-1;
			} else {
			this$.branch.stats[[as.character(branch.number)]]$substitution<-(this$.branch.stats[[as.character(branch.number)]]$substitution + 1);
			}
			name<-event$name;
	
			if(is.null(this$.branch.stats[[as.character(branch.number)]][[name]])){
				this$.branch.stats[[as.character(branch.number)]][[name]]<-1;

            }
			else {
				this$.branch.stats[[as.character(branch.number)]][[name]]<-(this$.branch.stats[[as.character(branch.number)]][[name]] + 1);
			}

			}
		
			# Special stuff for the GY94 codon model:	
			if(is.GY94(event$.process)){
				# Increment synonymous counter:
				if(event$.type == "synonymous"){
					if(is.null(this$.branch.stats[[as.character(branch.number)]][["nr.syn.subst"]])){
						# First event of this type on this branch, initialize the list element to 1.
						this$.branch.stats[[as.character(branch.number)]][["nr.syn.subst"]]<-1;
					}
					else {
					this$.branch.stats[[as.character(branch.number)]][["nr.syn.subst"]]<-(this$.branch.stats[[as.character(branch.number)]][["nr.syn.subst"]] + 1);
					}
				}
				# Increment non-synonymous counter:
				else if(event$.type == "non-synonymous"){
					if(is.null(this$.branch.stats[[as.character(branch.number)]][["nr.nsyn.subst"]])){
						# First event of this type on this branch, initialize the list element to 1.
						this$.branch.stats[[as.character(branch.number)]][["nr.nsyn.subst"]]<-1;
					}
					else {
						this$.branch.stats[[as.character(branch.number)]][["nr.nsyn.subst"]]<-(this$.branch.stats[[as.character(branch.number)]][["nr.nsyn.subst"]] + 1);
					}
				} else {
					throw("The event generated by the GY94 has no type!\n");
				}

			}

		}
		else if(details$type == "deletion"){
			if(is.null(this$.branch.stats[[as.character(branch.number)]]$deletion)){
				this$.branch.stats[[as.character(branch.number)]]$deletion<-1;
			}
			else {
				this$.branch.stats[[as.character(branch.number)]]$deletion<-(this$.branch.stats[[as.character(branch.number)]]$deletion + 1);
			}
		}
		else if(details$type == "insertion"){
			if(is.null(this$.branch.stats[[as.character(branch.number)]]$insertion)){
			this$.branch.stats[[as.character(branch.number)]]$insertion<-1;					
			}
			else {
			this$.branch.stats[[as.character(branch.number)]]$insertion<-(this$.branch.stats[[as.character(branch.number)]]$insertion + 1);					

			}
		}
		else {
			throw("Invalid event type!\n");
		}
			

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBranchEvents
##	
###########################################################################/**
#
# @RdocMethod getBranchEvents
# 
# @title "Get the list of events having per-branch statistics recorded" 
# 
# \description{ 
#	@get "title".
#
#	During simulation the number of events performed on every branch is recorded. The recorded events can be "basic"
#	events, like "insertion", "deletion" and "A->T" or events which are sums of basic events, like "substituion". The 
#	\code{getBranchEvents} method returns a character vector with the names of the events having per-branch 
#	statistics recorded. The method should be called after the simulation is finished.
#
#	The per-branch statistics can be exported as phylo objects by using the \code{exportStatTree} method.
#	The branch lengths of the exported phylo objects are set to the value of the respective per-branch event count.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector.
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#
#	# NOTE: this will be a little bit slow
#	sim<-PhyloSim(
#		phylo=rcoal(3),
#		root.seq=CodonSequence(
#                               string="ATGATTATT",
#                               processes=list(list(GY94(kappa=2,omega.default=0.5))))
#	);
#	# make the tree longer to have more events
#	scaleTree(sim,5)
#	# plot the tree
#	plot(sim)
#	# run simulation
#	Simulate(sim)
#	# get the list of recorded per-branch event counts
#	getBranchEvents(sim)
#	# export the number of subtitions as a phylo object
#	subst<-exportStatTree(sim,"substitution")
#	# plot the exported phylo object
#	plot(subst)
#	#export the number of synonymous substitutions as a phylo object
#	subst<-exportStatTree(sim,"nr.syn.subst")
#	# plot the exported phylo object
#	plot(subst)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBranchEvents", 
	class="PhyloSim", 
	function(
		this,
		...
	){

		tmp<-character();
		for(branch in this$.branch.stats){
			tmp<-c(tmp,names(branch));
		}
		return(unique(sort(tmp)));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBranchEvents
##	
###########################################################################/**
#
# @RdocMethod setBranchEvents
#
# @title "Forbidden action: setting the list of events having per-branch statistics recorded"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setBranchEvents", 
	class="PhyloSim", 
	function(
		this,
		value,
		...
	){

			virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: exportStatTree
##	
###########################################################################/**
#
# @RdocMethod exportStatTree
# 
# @title "Export the per-branch counts of an event as a phylo object" 
# 
# \description{ 
#	@get "title".
#
#	During simulation the number of events performed on every branch is recorded. The recorded events can be "basic"
#	events, like "insertion", "deletion" and "A->T" or events which are sums of basic events, like "substituion". The 
#	\code{getBranchEvents} method returns a character vector with the names of the events having per-branch 
#	statistics recorded. The method should be called after the simulation is finished.
#
#	The per-branch statistics can be exported as phylo objects by using the \code{exportStatTree} method.
#	The branch lengths of the exported phylo objects are set to the value of the respective per-branch event count.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{event}{The name of the event as returned by the \code{getBranchEvents} method.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A phylo object.
# } 
# 
# \examples{
#	# Create a PhyloSim object.
#	# Provide the phylo object 
#	# and the root sequence.
#
#	# NOTE: this will be a little bit slow
#	sim<-PhyloSim(
#		phylo=rcoal(3),
#		root.seq=CodonSequence(
#                               string="ATGATTATT",
#                               processes=list(list(GY94(kappa=2,omega.default=0.5)))
#                               )
#	);
#	# make the tree longer to have more events
#	scaleTree(sim,5)
#	# plot the tree
#	plot(sim)
#	# run simulation
#	Simulate(sim)
#	# get the list of recorded per-branch event counts
#	getBranchEvents(sim)
#	# export the number of substitutions as a phylo object
#	subst<-exportStatTree(sim,"substitution")
#	# plot the exported phylo object
#	plot(subst)
#	#export the number of synonymous substitutions as a phylo object
#	subst<-exportStatTree(sim,"nr.syn.subst")
#	# plot the exported phylo object
#	plot(subst)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"exportStatTree", 
	class="PhyloSim", 
	function(
		this,
		event,
		...
	){

 		if(!is.matrix(this$.alignment)){
      			throw("Simulation is not complete, cannot export statistics!\n");
    		}
		else if(missing(event)){
			throw("No event name specified!\n");
		}
		else if(length(intersect(event, this$branchEvents)) != 1 ){
			throw("Invalid event name!");
		}
		else {

			phylo.copy<-this$phylo;
			phylo.copy$edge.length<-.getStatBrlen(this, event);
			return(phylo.copy);		
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .getStatBrlen
##	
setMethodS3(
	".getStatBrlen", 
	class="PhyloSim", 
	function(
		this,
		event,
		...
	){

		tmp<-numeric();
		for(i in dimnames(this$edges)[[1]]){
				if(is.null(this$.branch.stats[[i]][[event]])){
					tmp[[as.numeric(i)]]<-0;
				}
				else {
					tmp[[as.numeric(i)]]<-this$.branch.stats[[i]][[event]];
				}
		}
		return(tmp);


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##### Phylo object interface methods  #####

##
## Method: getEdges
##
###########################################################################/**
#
# @RdocMethod	getEdges
# 
# @title "Get the edge matrix from a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	The rows of the edge matrix contain the nodes connected by the edge and the edge length.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the edge matrix
#	getEdges(sim)
#	# get the edge matrix via virtual field
#	sim$edges
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getEdges",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
			   if(length(this$.phylo$edge.length) > 2){
				if(attr(this$.phylo, "order") != "cladewise"){
					throw("The order of the phylo object is not cladewise! Someone must have been messing with that!\n");
				}
			   }
				tmp<-cbind(this$.phylo$edge,this$.phylo$edge.length);
				colnames(tmp)<-c("from","to","length");
				rownames(tmp)<-1:dim(tmp)[[1]];
				return(tmp);
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setEdges
##
###########################################################################/**
#
# @RdocMethod setEdges
#
# @title "Forbidden action: setting the edge matrix for a phylo object aggregated by a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setEdges",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getNtips
##
###########################################################################/**
#
# @RdocMethod	getNtips
# 
# @title "Get the number of the tips form a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the number of tips
#	getNtips(sim)
#	# get the number of tips via virtual field
#	sim$ntips
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getNtips",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
								return(length(this$.phylo$tip.label));
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setNtips
##
###########################################################################/**
#
# @RdocMethod setNtips
#
# @title "Forbidden action: setting the number of the tips for a phylo object aggregated by a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setNtips",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getTipLabels
##
###########################################################################/**
#
# @RdocMethod getTipLabels
# 
# @title "Get the tip labels from a phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix containing the tip labels.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the tip labels
#	getTipLabels(sim)
#	# get the tip lables via virtual field
#	sim$tipLabels
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getTipLabels",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
					tmp<-rbind(this$.phylo$tip.label);
					rownames(tmp)<-c("Labels:");
					colnames(tmp)<-c(1:length(tmp));
					return(tmp);
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setTipLabels
##
###########################################################################/**
#
# @RdocMethod setTipLabels
#
# @title "Forbidden action: setting the tip labels for a phylo object aggregated by a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setTipLabels",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getNodes
##
###########################################################################/**
#
# @RdocMethod getNodes
# 
# @title "Get the node identifiers from a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the node IDs
#	getNodes(sim)
#	# get the node IDs via virtual field
#	sim$nodes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getNodes",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
					# This is dumb but safe:
					return(sort(unique(as.vector(this$.phylo$edge))));
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getNedges
##
###########################################################################/**
#
# @RdocMethod	getNedges
# 
# @title "Get the number of edges from phylo object aggregated by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the number of the edges
#	getNedges(sim)
#	# get the number of the edges via virtual field
#	sim$nedges
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getNedges",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
					return(dim(this$.phylo$edge)[[1]]);
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setNedges
##
###########################################################################/**
#
# @RdocMethod setNedges
#
# @title "Forbidden action: setting the number of edges for phylo object aggregated by a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setNedges",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setNodes
##
###########################################################################/**
#
# @RdocMethod setNodes
#
# @title "Forbidden action: setting the node identifiers for a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setNodes",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getTips
##
###########################################################################/**
#
# @RdocMethod	getTips
# 
# @title "Get the node identifiers of the tip nodes from a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the tip IDs
#	getTips(sim)
#	# get the tip IDs via virtual field
#	sim$tips
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getTips",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
					# This is dumb but safe:
					#return(sort(unique(as.vector(this$.phylo$edge))));
					return(1:(getNtips(this)));
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setTips
##
###########################################################################/**
#
# @RdocMethod setTips
#
# @title "Forbidden action: setting the node identifiers of the tip nodes for a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setTips",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getRootNode
##
###########################################################################/**
#
# @RdocMethod getRootNode
# 
# @title "Get the identifier of the root node from a PhyloSim object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the root node ID
#	getRootNode(sim)
#	# get the root node ID via virtual field
#	sim$rootNode
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getRootNode",
  class="PhyloSim",
  function(
    this,
    ...
  ){

		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
					# Relying on cladewise order:
					return(this$.phylo$edge[1,1]);
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setRootNode
##
###########################################################################/**
#
# @RdocMethod setRootNode
#
# @title "Forbidden action: setting the identifier of the root node for a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setRootNode",
  class="PhyloSim",
  function(
    this,
    value,
    ...
  ){

		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: is.tip
##
###########################################################################/**
#
# @RdocMethod is.tip
# 
# @title "Check if a node is a tip" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{node}{A node identifier (integer vector of length one).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# check if node 4 is a tip
#	is.tip(sim,4)
#	# check if node 6 is a tip
#	is.tip(sim,6)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "is.tip",
  class="PhyloSim",
  function(
    		this,
		node=NA,
    		...
  ){

		if(missing(node)){
			throw("No node number specified!\n");
		}
		else if(!is.numeric(node)){
			throw("The node number must be numeric!\n");
		}
		else {
			return(round(node) <= this$ntips);
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getEdge
##
###########################################################################/**
#
# @RdocMethod getEdge
# 
# @title "Get and edge from the edge matrix" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{number}{The edge number.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The edge as a matrix with a single row.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get edge number 3
#	getEdge(sim,3)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getEdge",
  class="PhyloSim",
  function(
    this,
    number=NA,
    ...
  ){

    if(missing(number)){
      throw("No object provided!\n");
    }
    else if(!is.numeric(number)){
      throw("The edge number must be numeric!\n");
    }
    else {
				number<-round(number);
				tmp<-rbind(c(this$.phylo$edge[number,],this$.phylo$edge.length[number]));
				colnames(tmp)<-c("from","to","length");
				rownames(tmp)<-c("Edge:");
				return(tmp);

    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getTreeLength
##
###########################################################################/**
#
# @RdocMethod getTreeLength
# 
# @title "Get the tree length from a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	This method retruns the sum of the edge lengths stored in the aggregated phylo object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the tree length
#	getTreeLength(sim)
#	# get tree length via virtual field
#	sim$treeLength
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getTreeLength",
  class="PhyloSim",
  function(
    this,
    ...
  ){
		
		if(!all(is.na(this$.phylo))){
			if(is.phylo(this$.phylo)){
				return(sum(this$.phylo$edge.length));
			}
			else{
				throw("The phylo object is invalid!\n");
			}
		}
		else{
			throw("The phylo object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setTreeLength
##
###########################################################################/**
#
# @RdocMethod setTreeLength
#
# @title "Forbidden action: setting the tree length for a PhyloSim object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setTreeLength",
  class="PhyloSim",
  function(
    this,
		value,
    ...
  ){
		
		virtualAssignmentForbidden(this);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: scaleTree
##
###########################################################################/**
#
# @RdocMethod scaleTree
# 
# @title "Scale the branch lengths of a phylo object aggragted by a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#	This method multiples all the edge lengths by the specified factor.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{factor}{A numeric vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# create a PhyloSim object
#	sim<-PhyloSim(phylo=rcoal(5));
#	# get the tree length
#	sim$treeLength
#	# scale tree
#	scaleTree(sim,10)
#	# get the scaled tree length
#	sim$treeLength
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "scaleTree",
  class="PhyloSim",
  function(
    		this,
		factor,
    		...
  ){

		if(missing(factor)){
			throw("No branch length scaling factor specified!\n");
		} else if((!is.numeric(factor)) | (length(factor) != 1)){
			throw("The scaling factor must be a numeric vector of length 1!\n");	
		} else if(!is.phylo(this$.phylo)){
			throw("The phylo object is not set or it is invalid!\n");
		} else {

			this$.phylo$edge.length<-(this$.phylo$edge.length * factor);
			return(invisible(this));
		
		}
		

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

###########################################################################/**
#
# @RdocMethod readAlignment
# 
# @title "Read alignment from file" 
# 
# \description{ 
#	@get "title".
#
#	This method reads an alignment by using the \code{read.dna} function from the \code{\link{ape}}
#	package and stores in the \code{PhyloSim} object. If a tree is already attached to the \code{PhyloSim}
#       object, the alignment must at least contain the sequences corresponding to tip nodes (but it
#       may also contain additional ancestral sequences).
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{file}{A file name specified by either a variable of mode character, or a double-quoted string.}
#	\item{format}{a character string specifying the format of the DNA sequences. Four choices are possible: "interleaved", "sequential", "clustal", or "fasta", or any unambiguous abbreviation of these.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# get a safe file name	
#	fname<-paste("PhyloSim_dummy_fas_",Sys.getpid(),sep="")
#	# write out a fasta alignment
#	cat("> t3\nGTCTTT-CG-\n",file=fname);
#	cat("> t4\nG--TC-TCGG\n",file=fname,append=TRUE);
#	cat("> t2\nG--TC-TCGG\n",file=fname,append=TRUE);
#	cat("> t1\nGTC-G-TCGG",file=fname,append=TRUE);
#	# construct a PhyloSim object,
#	# set the phylo object
#	sim<-PhyloSim(phylo=rcoal(4))
#	# read the alignment
#	readAlignment(sim,fname)
#	# remove alignment file
#	unlink(fname)
#	# plot the tree & alignment
#	plot(sim)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "readAlignment",
  class="PhyloSim",
  function(
    		this,
		file,
		format="fasta",
    		...
  ){

	aln<-toupper(read.dna(file=file,format=format,as.matrix=TRUE,as.character=TRUE));
	aln.names<-dimnames(aln)[[1]];

        if (!all(is.na(this$.phylo))) {
          tip.labels<-this$tipLabels;
          length.overlap <- length(intersect(tip.labels,aln.names))
          if(length.overlap != length(tip.labels)){
            throw("The alignment must contain all sequences corresponding to tip nodes!");
          }
          if (length(aln.names) > length(tip.labels)) {
            warning("Alignment has more sequences than the tree's leaf count -- either it contains ancestral sequences or something is wrong!")
          }
        }

	this$.alignment<-aln;

	return(invisible(this));
  
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getAlignmentLength
##
###########################################################################/**
#
# @RdocMethod getAlignmentLength
# 
# @title "Get the alignment length from a PhyloSim object" 
# 
# \description{ 
#	@get "title".
#
#	This method retruns the number of columns in the alignment stored in the PhyloSim object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a PhyloSim object and run a simulation:
#	sim<-Simulate(
#                     PhyloSim(phy=rcoal(3),
#                     root=NucleotideSequence(string="ATGC", proc=list(list(JC69())) ) )
#             )
#	# get the alignment length
#	getAlignmentLength(sim)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getAlignmentLength",
  class="PhyloSim",
  function(
    this,
    ...
  ){
		
		if(!all(is.na(this$.alignment))){
                  return(dim(this$.alignment)[2]);
		}
		else{
			throw("The alignment object is not set!\n");
		}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

###########################################################################/**
#
# @RdocMethod readTree
# 
# @title "Read tree from file" 
# 
# \description{ 
#	@get "title".
#
#	This method reads a tree by using the \code{read.tree} function from the \code{\link{ape}}
#	package and stores in the \code{PhyloSim} object. If an alignment is already attached
#       to the \code{PhyloSim} object, it must contain all sequences corresponding to tip nodes.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A PhyloSim object.} 
#	\item{file}{A file name specified by either a variable of mode character, or a double-quoted string.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	The PhyloSim object (invisible).
# } 
# 
# \examples{
#	# get a safe file name	
#	fname<-paste("PhyloSim_dummy_fas_",Sys.getpid(),sep="")
#	# write out a fasta alignment
#	cat("(a,(b,c));",file=fname);
#	# construct a PhyloSim object:
#	sim<-PhyloSim()
#	# read the alignment
#	readTree(sim,fname)
#	# remove alignment file
#	unlink(fname)
#	# plot the tree
#	plot(sim)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "readTree",
  class="PhyloSim",
  function(
    		this,
		file,
    		...
  ){
        tree <- read.tree(file)

        if (!any(is.na(this$.alignment))) {
          # Check for overlap between leaves and seqs.
          aln <- this$.alignment;
          aln.names <- dimnames(aln)[[1]];
          tip.labels <- tree$tip.label;
          aln.tree.overlap <- length(intersect(tip.labels,aln.names))
          if(aln.tree.overlap != length(tip.labels)){
            throw("The alignment must contain all sequences corresponding to tip nodes!");
          }
          if (length(aln.names) > length(tip.labels)) {
            warning("Alignment has more sequences than the tree's leaf count -- either it contains ancestral sequences or something is wrong!")
          }
        }
        
        this$.phylo <- tree
	return(invisible(this));  
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

###########################################################################/**
#
# @RdocMethod Undocumented
# \alias{Undocumented}
# \alias{newMatrix}
# \alias{setEquDist.CodonSubst}
# \alias{BrownianPath}
# \alias{buildFromPAML}
# \alias{checkConsistency}
# \alias{clearStates}
# \alias{areSynonymous}
# \alias{attachHookToNode}
# \alias{attachProcess}
# \alias{attachSeqToNode}
# \alias{copySubSequence}
# \alias{Debug}
# \alias{deleteSubSequence}
# \alias{detachHookFromNode}
# \alias{detachProcess}
# \alias{detachSeqFromNode}
# \alias{enableVirtual}
# \alias{exportStatTree}
# \alias{flagTotalRate}
# \alias{generateInsert}
# \alias{getAcceptBy}
# \alias{getAcceptWin}
# \alias{getAlignment}
# \alias{getAlphabet}
# \alias{getAlphabets}
# \alias{getAlphabet}
# \alias{getAncestral}
# \alias{getAncestral}
# \alias{getBaseFreqs}
# \alias{getBigRate}
# \alias{getBranchEvents}
# \alias{getCodonFreqs}
# \alias{getComments}
# \alias{getCumulativeRates}
# \alias{getCumulativeRatesFromRange}
# \alias{getDeletionTolerance}
# \alias{getDist}
# \alias{getEdge}
# \alias{getEdges}
# \alias{getEquDist}
# \alias{getEventRate}
# \alias{getEventRateAtSite}
# \alias{getEvents}
# \alias{getEventsAtSite}
# \alias{getGenerateBy}
# \alias{getHandler}
# \alias{getId}
# \alias{getInsertHook}
# \alias{getInsertionTolerance}
# \alias{getInsertionTolerance}
# \alias{getKappa}
# \alias{getLength}
# \alias{getLengthParam1}
# \alias{getLengthParam2}
# \alias{getLogFile}
# \alias{getLogLevel}
# \alias{getMatrix}
# \alias{getMaxLength}
# \alias{getMethodsList}
# \alias{getNedges}
# \alias{getNodes}
# \alias{getNtips}
# \alias{getOmegas}
# \alias{getParameterAtSite}
# \alias{getParameterAtSites}
# \alias{getPhylo}
# \alias{getProbs}
# \alias{getProcess}
# \alias{getProcesses}
# \alias{getProposeBy}
# \alias{getQMatrix}
# \alias{getRate}
# \alias{getRateList}
# \alias{getRateMultipliers}
# \alias{getRateParam}
# \alias{getRateParamList}
# \alias{getRootNode}
# \alias{getRootSeq}
# \alias{getScale}
# \alias{getScaledMatrix}
# \alias{getSeqFromNode}
# \alias{getSequence}
# \alias{getSequences}
# \alias{getSite}
# \alias{getSites}
# \alias{getSiteSpecificParamIds}
# \alias{getSiteSpecificParamList}
# \alias{getSize}
# \alias{getSizes}
# \alias{getState}
# \alias{getStates}
# \alias{getString}
# \alias{getSymbolFreqs}
# \alias{getSymbolLength}
# \alias{getSymbols}
# \alias{getTableId}
# \alias{getTargetState}
# \alias{getTemplateSeq}
# \alias{getTheta}
# \alias{getTipLabels}
# \alias{getTips}
# \alias{getToleranceMargin}
# \alias{getTotalRate}
# \alias{getTotalRates}
# \alias{getTotalRatesFromRange}
# \alias{getTransTable}
# \alias{getTreeLength}
# \alias{getType}
# \alias{getUniqueAlphabets}
# \alias{getUniqueProcesses}
# \alias{getWriteProtected}
# \alias{globalConsistencyCheck}
# \alias{hasSiteSpecificParameter}
# \alias{hasSymbols}
# \alias{hasUndefinedRate}
# \alias{insertSequence}
# \alias{intersect}
# \alias{list}
# \alias{isAttached}
# \alias{isEmpty}
# \alias{is}
# \alias{default}
# \alias{isStartCodon}
# \alias{isStopCodon}
# \alias{is}
# \alias{tip}
# \alias{Log}
# \alias{my}
# \alias{all}
# \alias{equal}
# \alias{newAAMatrix}
# \alias{omegaHist}
# \alias{omegaVarM0}
# \alias{omegaVarM1}
# \alias{omegaVarM10Cont}
# \alias{omegaVarM10Cont}
# \alias{omegaVarM2}
# \alias{omegaVarM3}
# \alias{omegaVarM4}
# \alias{Perform}
# \alias{plotParametersAtSites}
# \alias{plot}
# \alias{plusGamma}
# \alias{plusInvGamma}
# \alias{proposeLength}
# \alias{rescaleQMatrix}
# \alias{sampleState}
# \alias{sampleStates}
# \alias{saveAlignment}
# \alias{Scale}
# \alias{scaleTree}
# \alias{setAcceptBy}
# \alias{setAcceptWin}
# \alias{setAlignment}
# \alias{setAlphabet}
# \alias{setAlphabets}
# \alias{setAncestral}
# \alias{setBaseFreqs}
# \alias{setBigRate}
# \alias{setBranchEvents}
# \alias{setCodonFreqs}
# \alias{setCodonFreqs}
# \alias{setComments}
# \alias{setCumulativeRates}
# \alias{setDeletionTolerance}
# \alias{setDist}
# \alias{setEdges}
# \alias{setEquDist}
# \alias{setEquDist}
# \alias{setEvents}
# \alias{setGenerateBy}
# \alias{setHandler}
# \alias{setId}
# \alias{setInsertHook}
# \alias{setInsertionTolerance}
# \alias{setInsertionTolerance}
# \alias{setKappa}
# \alias{setKappa}
# \alias{setLength}
# \alias{setLengthParam1}
# \alias{setLengthParam2}
# \alias{setLogFile}
# \alias{setLogLevel}
# \alias{setMatrix}
# \alias{setMaxLength}
# \alias{setMethodsList}
# \alias{setName}
# \alias{setNedges}
# \alias{setNodes}
# \alias{setNtips}
# \alias{setOmegas}
# \alias{setParameterAtSite}
# \alias{setParameterAtSites}
# \alias{setPhylo}
# \alias{setPosition}
# \alias{setProbs}
# \alias{setProcess}
# \alias{setProcesses}
# \alias{setProposeBy}
# \alias{setQMatrix}
# \alias{setRate}
# \alias{setRateList}
# \alias{setRateMultipliers}
# \alias{setRateParam}
# \alias{setRateParamList}
# \alias{setRootNode}
# \alias{setRootSeq}
# \alias{setScale}
# \alias{setScaledMatrix}
# \alias{setSequence}
# \alias{setSequences}
# \alias{setSite}
# \alias{setSiteSpecificParamIds}
# \alias{setSiteSpecificParamList}
# \alias{setSize}
# \alias{setSizes}
# \alias{setState}
# \alias{setStates}
# \alias{setString}
# \alias{setSymbolLength}
# \alias{setSymbols}
# \alias{setTableId}
# \alias{setTargetState}
# \alias{setTemplateSeq}
# \alias{setTheta}
# \alias{setTipLabels}
# \alias{setTips}
# \alias{setToleranceMargin}
# \alias{setTotalRate}
# \alias{setTotalRates}
# \alias{setTransTable}
# \alias{setTreeLength}
# \alias{setType}
# \alias{setUniqueAlphabets}
# \alias{setUniqueProcesses}
# \alias{setWriteProtected}
# \alias{Simulate}
# \alias{Translate}
# \alias{translateCodon}
# \alias{virtualAssignmentForbidden}
# \alias{intersect.list}
# \alias{is.tip}
# \alias{my.all.equal}
# \alias{plot.PSRoot}
# \alias{revComp}
# \alias{readAlignment}
# \alias{readTree}
# \alias{getOmegaScalingFactor}
# \alias{saveLoadReference}
# \alias{getAlignmentLength}
# 
# @title "Undocumented object (PhyloSim package)" 
#
# \description{ 
#	@get "title".
#
#	See the corresponding specific methods if applicable.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{...}{Not used.} 
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "Undocumented",
  class="PhyloSim",
  function(
    		...
  ){
		cat("This method has no documentation!\n");	
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);
##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	

##
## AnyAlphabet
##
##########################################################################/** 
#
# @RdocClass AnyAlphabet
# 
# @title "The AnyAlphabet class"
# 
# \description{
#	This is a special Alphabet class which matches any alphabet. 
#	The '=='.Alphabet method always returns TRUE when one of the
#	compared objects inherits from AnyAlphabet. This behaviour is 
#	handy when creating processes that have no alphabet preference 
#	(like a deletion process).
#
#		@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create some alphabet objects
#	a<-BinaryAlphabet()
#	b<-NucleotideAlphabet()
#	any<-AnyAlphabet()
#	# compare objects
#	a == b
#	any == a
#	any == b
# }
# 
# @author
#
# \seealso{ 
# 	Alphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "AnyAlphabet",
  function(... ){

		this<-Alphabet(type="*ANY*",symbols=c());
		extend(this,
			"AnyAlphabet",
			 .any.flag=TRUE
			);

  },
  enforceRCC=TRUE
);

##
## BinaryAlphabet
##
##########################################################################/** 
#
# @RdocClass BinaryAlphabet
# 
# @title "The BinaryAlphabet class"
# 
# \description{ 
#	 Class of Alphabet objects with the c("0","1") symbol set.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a binary alphabet
#	b<-BinaryAlphabet()
#	# get alphabet summary
#	summary(b)
# }
# 
# @author
#
# \seealso{ 
# 	Alphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "BinaryAlphabet",
  function(... ){

		this<-Alphabet(type="Binary",symbols=c("0","1"));
		extend(this,"BinaryAlphabet");

  },
  enforceRCC=TRUE
);

##
## NucleotideAlphabet
##
##########################################################################/** 
#
# @RdocClass NucleotideAlphabet
# 
# @title "The NucleotideAlphabet class"
# 
# \description{ 
#	Class of Alphabet objects with the c("T","C","A","G") symbol
#	set, representing nucleotides.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a nucleotide alphabet
#	b<-NucleotideAlphabet()
#	# get alphabet summary
#	summary(b)
# }
# 
# @author
#
# \seealso{ 
# 	Alphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "NucleotideAlphabet",
  function(... ){

		this<-Alphabet(type="Nucleotide",symbols=c("T","C","A","G"));
		extend(this,"NucleotideAlphabet");

  },
  enforceRCC=TRUE
);

##
## AminoAcidAlphabet
##
##########################################################################/** 
#
# @RdocClass AminoAcidAlphabet
# 
# @title "The AminoAcidAlphabet class"
# 
# \description{ 
#	Class of Alphabet objects representing amino acids, using the
#	one-letter IUPAC amino acid codes as symbol set:
#	\preformatted{
#	IUPAC code	Amino acid
#
#	A		Alanine
#	C		Cysteine
#	D		Aspartic Acid
#	E		Glutamic Acid
#	F		Phenylalanine
#	G		Glycine
#	H		Histidine
#	I		Isoleucine
#	K		Lysine
#	L		Leucine
#	M		Methionine
#	N		Asparagine
#	P		Proline
#	Q		Glutamine
#	R		Arginine
#	S		Serine
#	T		Threonine
#	V		Valine
#	W		Tryptophan
#	Y		Tyrosine
#}
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	a<-AminoAcidAlphabet();
#	# get object summary
#	summary(a)
# }
# 
# @author
#
# \seealso{ 
# 	Alphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "AminoAcidAlphabet",
  function(... ){

		this<-Alphabet(
				type="Amino acid",
				symbols=c(
					"A",
					"R",
					"N",
					"D", 
					"C",
					"Q",
					"E",
					"G", 
					"H",
					"I",
					"L",
					"K",
					"M",
					"F",
					"P",
					"S", 
					"T",
					"W",
					"Y",
					"V"
				)
		 );
		extend(this,"AminoAcidAlphabet");

  },
  enforceRCC=TRUE
);


##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	

##
## BinarySequence
##
##########################################################################/** 
#
# @RdocClass BinarySequence
# 
# @title "The BinarySequence class"
# 
# \description{ 
#	Sequence objects aggregating Site objects having a BinaryAlphabet attached by default.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Name of the Sequence object.}
# 	\item{string}{A string specifying the length and the states of the Sequence object.}
#	\item{length}{The length of the sequence. Mutually exclusive with "string".}
# 	\item{processes}{A list of lists of Process objects, to be attached to the aggregated Site objects. Recycled if shorter than the length of the sequence.}
#	\item{ancestral.obj}{The ancestral object of the Sequence object (a valid Sequence or Process object).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create an empty BinarySequence object
#	s<-BinarySequence(length=50)
#	s
#	# set states
#	s$states<-c(0,0,1,0,1,1)
#	s
#	# create a sequence object by specifying a string
#	s<-BinarySequence(string="00000110010001111")
#	s
# }
# 
# @author
#
# \seealso{ 
# 	Sequence BinaryAlphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "BinarySequence",
  function(
    name=NA,
    string=NA,
    length=NA,
    processes=NA,
    ancestral.obj=NA,
    ...
	){

		if(!missing(string)){
			this<-Sequence(string=string,alphabets=list(BinaryAlphabet()));
		}
		else if(!missing(length)) {
			this<-Sequence(length=length,alphabets=list(BinaryAlphabet()));
		}
		else {
			this<-Sequence(alphabets=list(BinaryAlphabet()));
		}

		this<-extend(this, "BinarySequence");
		
		if(!missing(name)){
			this$name<-name;
		}
		
		if(!missing(processes)){
			setProcesses(this,processes);
		}
	
		if(!missing(ancestral.obj)){
			this$.ancestral<-ancestral.obj;
		}

		return(this);

  },
  enforceRCC=TRUE
);

##
## NucleotideSequence
##
##########################################################################/** 
#
# @RdocClass NucleotideSequence
# 
# @title "The NucleotideSequence class"
# 
# \description{ 
#	Sequence objects aggregating Site objects having a NucleotideAlphabet attached by default.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Name of the Sequence object.}
# 	\item{string}{A string specifying the length and the states of the Sequence object.}
#	\item{length}{The length of the sequence. Mutually exclusive with "string".}
# 	\item{processes}{A list of lists of Process objects, to be attached to the aggregated Site objects. Recycled if shorter than the length of the sequence.}
#	\item{ancestral.obj}{The ancestral object of the Sequence object (a valid Sequence or Process object).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create an empty NucleotideSequence object
#	s<-NucleotideSequence(length=50)
#	s
#	# set states
#	s$states<-c("A","A","G","T")
#	s
#	# create a sequence object by specifying a string
#	s<-NucleotideSequence(string="ATGCCGATTAGCAAA")
#	s
# }
# 
# @author
#
# \seealso{ 
# 	Sequence NucleotideAlphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "NucleotideSequence",
  function(
    name=NA,
    string=NA,
    length=NA,
    processes=NA,
    ancestral.obj=NA,
    ...
	){

		if(!missing(string)){
			this<-Sequence(string=string,alphabets=list(NucleotideAlphabet()));
		}
		else if(!missing(length)) {
			this<-Sequence(length=length,alphabets=list(NucleotideAlphabet()));
		}
		else {
			this<-Sequence(alphabets=list(NucleotideAlphabet()));
		}
		this<-extend(this, "NucleotideSequence");
		
		if(!missing(name)){
			this$name<-name;
		}
		
		if(!missing(processes)){
			setProcesses(this,processes);
		}
	
		if(!missing(ancestral.obj)){
			this$.ancestral<-ancestral.obj;
		}

		return(this);

  },
  enforceRCC=TRUE
);

##
## revComp
##
###########################################################################/**
#
# @RdocMethod revComp
# 
# @title "Reverse complmenet a NucleotideSequence object" 
# 
# \description{ 
#	@get "title".
#	
#	The method reverse complements the sequence "in place", no object cloning is performed.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A NucleotideSequence object} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	s<-NucleotideSequence(string="ATGC")
#	s
#	revComp(s)
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
        "revComp",
        class="NucleotideSequence",
        function(
                this,
                ...
        ){

		states<-rev(as.character(getStates(this)));	
		len<-length(states);
		if(len == 0){return(invisible(TRUE))}
		for(i in 1:len){
			if(states[[i]] == "NA"){
				state<-NA;
			}
			else if(states[i] == "A"){
				state<-"T";
			}
			else if(states[i] == "T"){
				state<-"A";
			}
			else if(states[i] == "G"){
				state<-"C";
			}
			else if(states[i] == "C"){
				state<-"G";
			} else {
				throw("Symbol not in NucleotideAlphabet!");
			}
			this$.sites[[i]]$.state<-state;
		}
                return(invisible(TRUE));
        },
        private=TRUE,
        protected=FALSE,
        overwrite=FALSE,
        conflict="warning",
        validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## AminoAcidSequence
##
##########################################################################/** 
#
# @RdocClass AminoAcidSequence
# 
# @title "The AminoAcidSequence class"
# 
# \description{ 
#	Sequence objects aggregating Site objects having an AminoAcidAlphabet attached by default.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{Name of the Sequence object.}
# 	\item{string}{A string specifying the length and the states of the Sequence object.}
#	\item{length}{The length of the sequence. Mutually exclusive with "string".}
# 	\item{processes}{A list of lists of Process objects, to be attached to the aggregated Site objects. Recycled if shorter than the length of the sequence.}
#	\item{ancestral.obj}{The ancestral object of the Sequence object (a valid Sequence or Process object).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create an empty AminoAcidSequence object
#	s<-AminoAcidSequence(length=50)
#	s
#	# set states
#	s$states<-c("C","C","G","Y")
#	s
#	# create a sequence object by specifying a string
#	s<-AminoAcidSequence(string="CNGGYCCNGYYYY")
#	s
# }
# 
# @author
#
# \seealso{ 
# 	Sequence AminoAcidAlphabet
# }
# 
#*/###########################################################################
setConstructorS3(
  "AminoAcidSequence",
  function(
    name=NA,
    string=NA,
    length=NA,
    processes=NA,
    ancestral.obj=NA,
    ...
	){

		if(!missing(string)){
			this<-Sequence(string=string,alphabets=list(AminoAcidAlphabet()));
		}
		else if(!missing(length)) {
			this<-Sequence(length=length,alphabets=list(AminoAcidAlphabet()));
		}
		else {
			this<-Sequence(alphabets=list(AminoAcidAlphabet()));
		}
		this<-extend(this, "AminoAcidSequence");
		
		if(!missing(name)){
			this$name<-name;
		}
		
		if(!missing(processes)){
			setProcesses(this,processes);
		}
	
		if(!missing(ancestral.obj)){
			this$.ancestral<-ancestral.obj;
		}

		return(this);
  },
  enforceRCC=TRUE
);

##
## CodonSequence
##
##########################################################################/** 
#
# @RdocClass CodonSequence
# 
# @title "The CodonSequence class"
# 
# \description{ 
#	Sequence objects aggregating Site objects having a CodonAlphabet attached by default.
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
#       \item{name}{Name of the Sequence object.}
#       \item{string}{A string specifying the length and the states of the Sequence object.}
#       \item{length}{The length of the sequence. Mutually exclusive with "string".}
#	\item{table.id}{The genetic code table to use in the attached CodonAlphabet object ("Standard" by default).}
#       \item{processes}{A list of lists of Process objects, to be attached to the aggregated Site objects. Recycled if shorter than the length of the sequence.}
#       \item{ancestral.obj}{The ancestral object of the Sequence object (a valid Sequence or Process object).}
#       \item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#       # create an empty CodonSequence object
#       s<-CodonSequence(length=50)
#       s
#       # set states
#       s$states<-c("ATG","CGA","TTT","CTA")
#       s
#       # create a sequence object by specifying a string
#       s<-CodonSequence(string="ATCTTTCGAATG")
#       s
# }
# 
# @author
#
# \seealso{ 
# 	@seeclass 
# }
# 
#*/###########################################################################
setConstructorS3(
  "CodonSequence",
  function(
    name=NA,
    string=NA,
    length=NA,
    table.id=1,
    processes=NA,
    ancestral.obj=NA,
    ...
	){

		if (!missing(string)){

			len<-((stringLength(string)/3));
			flen<-floor(len);

			this<-Sequence(length=flen,alphabets=list(CodonAlphabet(table.id=table.id)));
			if(len > flen){
				warning("The length of the provided string was not multiple of 3. The incomplete codon was discarded!\n");
			}

			nuc<-strsplit(string,"",fixed=TRUE)[[1]];


			j<-1;	# counter for the codon position
			for(i in seq(from=1,to=(flen * 3),by=3)){

					# get the codon:
					state<-paste(nuc[c(i,i+1,i+2)],collapse="");

					# Check for stop codons:
					if( isStopCodon(this$.sites[[j]]$.alphabet, state) ){
						throw("The CodonSequence objects does not accept stop codons as valid states!\n");
					}

					# Set the state:			
					setStates(this,state,j);		
					j<-j+1;
			}
			
		}
		else if(!missing(length)){
			this<-Sequence(length=length,alphabets=list(CodonAlphabet(table.id=table.id)));
		}
		else {
			this<-Sequence(alphabets=list(CodonAlphabet(table.id=table.id)));
		}

		this<-extend(this, "CodonSequence");
		
		if(!missing(name)){
			this$name<-name;
		}
		
		if(!missing(processes)){
			setProcesses(this,processes);
		}
	
		if(!missing(ancestral.obj)){
			this$.ancestral<-ancestral.obj;
		}

		return(this);

  },
  enforceRCC=TRUE
);

##  
## Method: getOmegas
##  
###########################################################################/**
#
# @RdocMethod getOmegas
# \alias{getOmegas.Sequence} 
# 
# @title "Get the omegas from a collection of sites" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
#	\item{process}{A process object inheriting from GY94.}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	# create a GY94 process
#	p<-GY94()
#	# create a CodonSequence object,
#	# attach a process p
#	s<-CodonSequence(length=20,processes=list(list(p)))
#	# set omega values in range 1:5
#	setOmegas(s,p,c(0.5,1,1.5),1:5)
#	# get omega values from siutes 1,2,3,10, and 20
#	getOmegas(s,p,c(1:3,10,20))
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getOmegas",
  class="CodonSequence",
  function(
    this,
		process,
		index,
    ...
  ){

		if(missing(process)){
      throw("No process given!\n");
    }
    else if(!is.GY94(process)){
      throw("The specified process is not a GY94 codon substitution process!\n");
    }
    rm<-getParameterAtSites(this=this,process=process,id="omega",index=index);
    return(as.numeric(lapply(rm,function(param){param$value})));
	

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: omegaHist
##  
###########################################################################/**
#
# @RdocMethod omegaHist
# 
# @title "Plot a histogram of omega values from a range" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
#	\item{process}{A process object inheriting from GY94.}
#	\item{breaks}{\code{breaks} parameter for \code{hist()}.}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The CodonSequence object (invisible).
# } 
# 
# \examples{
#	# create a GY94 process
#	p<-GY94()
#	# create a CodonSequence object,
#	# attach a process p
#	s<-CodonSequence(length=20,processes=list(list(p)))
#       # set omega values through omegaVarM2.CodonSequence
#       omegaVarM2(s,p,p0=0.5,p1=0.2,omega=1.5)
#       # get a histogram of omega values from the range 1:15
#       omegaHist(s,p,breaks=10,1:15)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "omegaHist",
  class="CodonSequence",
  function(
    this,
		process,
		breaks,
		index,
    ...
  ){

		if(missing(process)){
      throw("No process given!\n");
    }
    else if(!is.GY94(process)){
      throw("The specified process is not a GY94 codon substitution process!\n");
    }

		if(missing(index)){
			index<-seq(along.with=this$.sites);
		}

		if(missing(breaks)){
			hist(getOmegas(this,process,index));
		}
		else {
			omegas<-getOmegas(this,process,index);
			hist(omegas,breaks=breaks,main="Histogram of omega values",xlab="Omega",freq=FALSE);
		}
		return(invisible(this));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: setOmegas
###########################################################################/**
#
# @RdocMethod setOmegas
# \alias{setOmegas.Sequence} 
# 
# @title "Set the omegas for a collection of sites" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
#	\item{process}{A process object inheriting from GY94.}
#	\item{value}{A vector containing the new values of the site-process specific parameter, recycled if shorter than the index vector.}
#	\item{index}{A vector of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	# create a GY94 process
#	p<-GY94()
#	# create a CodonSequence object,
#	# attach a process p
#	s<-CodonSequence(length=20,processes=list(list(p)))
#	# set omega values in range 1:5
#	setOmegas(s,p,c(0.5,1,1.5),1:5)
#	# get omega values from siutes 1,2,3,10, and 20
#	getOmegas(s,p,c(1:3,10,20))
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setOmegas",
  class="CodonSequence",
  function(
	this,
	process,
	value,
	index,
    	...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(value)){
      throw("No new value specified!\n");
    }
    else if(!all(is.numeric(value)) ){
      throw("The new value must be a numeric vector!\n");
    }
    else {

      if(missing(index)){
        index<-seq(along.with=this$.sites);
      }
      else {
        index<-.checkIndexSanity(this, index);
      }

      setParameterAtSites(this, process=process, id="omega",value=value,index=index);
			return(invisible(TRUE));

    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: omegaVarM0 - one ratio
##  
###########################################################################/**
#
# @RdocMethod omegaVarM0
# 
# @title "The M0 (one-ratio) model of variable omega ratios among sites" 
# 
# \description{ 
#	@get "title".
#
#	This method sets the \code{omega} site-process specific parameter
#	in the specified range to values sampled from the M0 (one-ratio) model of
#	variable omega ratios among sites.
#
#       Distribution of omega values:
#       \preformatted{
#	CATEGORY	PROBABILITY
#
#	omega		1
#       }
# } 
#
# \references{
# Yang, Z., Nielsen, R., Goldman, N., Pedersen Krabbe, A-M. (2000) Codon-Substitution Models for Heterogeneous Selection Pressure at Amino Acid Sites - Genetics 155:431-449 \url{http://bit.ly/bvjucn}
#
# Goldman, N., Yang, Z. (1994) A codon-based model of nucleotide substitution for protein-coding DNA sequences - Mol Biol Evol 11(5):725-36 \url{http://bit.ly/aSVEoa}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
# 	\item{process}{A process object inheriting from GY94.} 
#	\item{omega}{The fixed omega value.}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94(kappa=2)
#	# create a CodonSequence object, attach process p
#	s<-CodonSequence(length=20, processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# sample omegas in range 1:5 from model M0
#	omegaVarM0(s,p,omega=2,1:5)
#	# get omega values	
#	getOmegas(s,p)
#	# get a histogram of omega values in range 1:5
#	omegaHist(s,p,breaks=50,1:5)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "omegaVarM0",
  class="CodonSequence",
  function(
    	this,
	process,
    	omega,
	index,
    	...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(omega)){
      throw("No new omega value specified!\n");
    }
    else if((!is.numeric(omega))| (length(omega) != 1)){
      throw("The new value must be a numeric vector of length 1!\n");
    }
    else {

      if(missing(index)){
        index<-seq(along.with=this$.sites);
      }
      else {
        index<-.checkIndexSanity(this, index);
      }

      setParameterAtSites(this, process=process, id="omega",value=omega,index=index);
      return(invisible(TRUE));

    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: omegaVarM1 - neutral
##  
###########################################################################/**
#
# @RdocMethod omegaVarM1
# 
# @title "The M1 (neutral) model of variable omega ratios among sites" 
# 
# \description{ 
#	@get "title".
#
#	This method sets the \code{omega} site-process specific parameter
#	in the specified range to values sampled from the M1 (neutral) model of
#	variable omega ratios among sites.
#
#       Distribution of omega values:
#       \preformatted{
#	CATEGORY	PROBABILITY
#
#	omega_0 = 0	p0
#	omega_1 = 1	1-p0
#       }
# } 
#
# \references{
# Yang, Z., Nielsen, R., Goldman, N., Pedersen Krabbe, A-M. (2000) Codon-Substitution Models for Heterogeneous Selection Pressure at Amino Acid Sites - Genetics 155:431-449 \url{http://bit.ly/bvjucn}
#
# Goldman, N., Yang, Z. (1994) A codon-based model of nucleotide substitution for protein-coding DNA sequences - Mol Biol Evol 11(5):725-36 \url{http://bit.ly/aSVEoa}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
# 	\item{process}{A process object inheriting from GY94.} 
#	\item{p0}{See above.}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94(kappa=2)
#	# create a CodonSequence object, attach process p
#	s<-CodonSequence(length=25, processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# sample omegas in range 1:20 from model M1
#	omegaVarM1(s,p,p0=0.5,1:20)
#	# get omega values	
#	getOmegas(s,p)
#	# get a histogram of omega values in range 1:20
#	omegaHist(s,p,breaks=50,1:20)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "omegaVarM1",
  class="CodonSequence",
  function(
    	this,
    	process,
   	p0,
	index,
    	...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0))| (length(p0) != 1)){
      throw("The new value must be a numeric vector of length 1!\n");
    }
		else if(p0 < 0 | p0 > 1){
			throw("The p0 parameter must be in the [0,1] interval!\n");
		}
    else {

      if(missing(index)){
        index<-seq(along.with=this$.sites);
      }
      else {
        index<-.checkIndexSanity(this, index);
      }

			for(site in this$.sites[index]){
				setParameterAtSite(this=process,site=site, id="omega", value=sample(c(0,1), size=1, replace=FALSE, prob=c(p0,(1-p0))));	
			}
			return(invisible(TRUE));

    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: omegaVarM2 - selection
##  
###########################################################################/**
#
# @RdocMethod omegaVarM2
# 
# @title "The M2 (selection) model of variable omega ratios among sites" 
# 
# \description{ 
#	@get "title".
#
#	This method sets the \code{omega} site-process specific parameter
#	in the specified range to values sampled from the M2 (selection) model of
#	variable omega ratios among sites.
#
#       Distribution of omega values:
#       \preformatted{
#	CATEGORY	PROBABILITY
#
#	omega_0 = 0	p0
#	omega_1 = 1	p1
#	omega_2 	1-p0-p1
#       }
# } 
#
# \references{
# Yang, Z., Nielsen, R., Goldman, N., Pedersen Krabbe, A-M. (2000) Codon-Substitution Models for Heterogeneous Selection Pressure at Amino Acid Sites - Genetics 155:431-449 \url{http://bit.ly/bvjucn}
#
# Goldman, N., Yang, Z. (1994) A codon-based model of nucleotide substitution for protein-coding DNA sequences - Mol Biol Evol 11(5):725-36 \url{http://bit.ly/aSVEoa}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
# 	\item{process}{A process object inheriting from GY94.} 
#	\item{p0}{See above.}
#	\item{p1}{See above.}
#	\item{omega_2}{See above.}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94(kappa=2)
#	# create a CodonSequence object, attach process p
#	s<-CodonSequence(length=25, processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# sample omegas in range 1:20 from model M2
#	omegaVarM2(s,p,p0=0.2,p1=0.3,omega_2=4,1:20)
#	# get omega values	
#	getOmegas(s,p)
#	# get a histogram of omega values in range 1:20
#	omegaHist(s,p,breaks=50,1:20)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "omegaVarM2",
  class="CodonSequence",
  function(
    		this,
		process,
    		p0,
		p1,
		omega_2,
		index,
    		...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0))| (length(p0) != 1)){
      throw("The p0 value must be a numeric vector of length 1!\n");
    }
		else if(p0 < 0 | p0 > 1){
			throw("The p0 parameter must be in the [0,1] interval!\n");
		}
    else if(missing(p1)){
      throw("No p1 value specified!\n");
    }
    else if((!is.numeric(p1))| (length(p1) != 1)){
      throw("The p1 value must be a numeric vector of length 1!\n");
    }
		else if(p1 < 0 | p1 > 1){
			throw("The p1 parameter must be in the [0,1] interval!\n");
		}
    else if(missing(omega_2)){
      throw("No omega value specified!\n");
    }
    else if((!is.numeric(omega_2))| (length(omega_2) != 1)){
      throw("The omega value must be a numeric vector of length 1!\n");
    }
    else {

      if(missing(index)){
        index<-seq(along.with=this$.sites);
      }
      else {
        index<-.checkIndexSanity(this, index);
      }

			for(site in this$.sites[index]){
				setParameterAtSite(this=process,site=site, id="omega", value=sample(c(0,1,omega_2), size=1, replace=FALSE, prob=c(p0,p1,(1-p0-p1))));	
			}
			return(invisible(TRUE));

    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: omegaVarM3 - discrete
##  
###########################################################################/**
#
# @RdocMethod omegaVarM3
# 
# @title "The M3 (discrete) model of variable omega ratios among sites" 
# 
# \description{ 
#	@get "title".
#
#	This method sets the \code{omega} site-process specific parameter
#	in the specified range to values sampled from the M3 (discrete) model of
#	variable omega ratios among sites.
#
#       Distribution of omega values:
#       \preformatted{
#	CATEGORY	PROBABILITY
#
#	omega_0		p0
#	omega_1		p1
#	omega_2 	p2
#	...		...
#	omega_k		pk
#       }
# } 
#
# \references{
# Yang, Z., Nielsen, R., Goldman, N., Pedersen Krabbe, A-M. (2000) Codon-Substitution Models for Heterogeneous Selection Pressure at Amino Acid Sites - Genetics 155:431-449 \url{http://bit.ly/bvjucn}
#
# Goldman, N., Yang, Z. (1994) A codon-based model of nucleotide substitution for protein-coding DNA sequences - Mol Biol Evol 11(5):725-36 \url{http://bit.ly/aSVEoa}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
# 	\item{process}{A process object inheriting from GY94.} 
#	\item{omegas}{A vector of omega values (omega_0 ... omega_k).}
#	\item{probs}{A vector of probabilities (p0 ... pk).}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94(kappa=2)
#	# create a CodonSequence object, attach process p
#	s<-CodonSequence(length=25, processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# sample omegas in range 1:20 from model M3
#	omegaVarM3(s,p,omegas=c(0,2,4),probs=c(1/3,1/3,1/3),1:20)
#	# get omega values	
#	getOmegas(s,p)
#	# get a histogram of omega values in range 1:20
#	omegaHist(s,p,breaks=50,1:20)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "omegaVarM3",
  class="CodonSequence",
  function(
    		this,
		process,
		omegas,
		probs,
		index,
    		...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(omegas)){
      throw("No omega values specified!\n");
    }
    else if((!is.numeric(omegas))){
      throw("The omegas must be numeric!\n");
    }
		else if(missing(probs)){
			throw("No probabilities specified!\n");
		}
		else if(!is.numeric(probs)){
			throw("The probabilities must be numeric!\n");
		}
		else if(length(omegas) != length(probs)){
			throw("The length of the \"omegas\" and \"probs\" vector must be the same!\n");
		}
		else if(!PSRoot$my.all.equal(sum(probs),1.0)){
			probs<-(probs/sum(probs));
			warning("The provided probabilities were scaked in order to sum to one!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(omegas, size=1, replace=FALSE, prob=probs));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: omegaVarM4 - freqs
##  
###########################################################################/**
#
# @RdocMethod omegaVarM4
# 
# @title "The M4 (freqs) model of variable omega ratios among sites" 
# 
# \description{ 
#	@get "title".
#
#	This method sets the \code{omega} site-process specific parameter
#	in the specified range to values sampled from the M4 (freqs) model of
#	variable omega ratios among sites.
#
#       Distribution of omega values:
#       \preformatted{
#	CATEGORY	PROBABILITY
#
#	omega_0 = 0	p0
#	omega_1 = 1/3	p1
#	omega_2 = 2/3	p2
#	omega_3	= 1	p3
#	omega_4 = 3	p4
#       }
# } 
#
# \references{
# Yang, Z., Nielsen, R., Goldman, N., Pedersen Krabbe, A-M. (2000) Codon-Substitution Models for Heterogeneous Selection Pressure at Amino Acid Sites - Genetics 155:431-449 \url{http://bit.ly/bvjucn}
#
# Goldman, N., Yang, Z. (1994) A codon-based model of nucleotide substitution for protein-coding DNA sequences - Mol Biol Evol 11(5):725-36 \url{http://bit.ly/aSVEoa}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object.} 
# 	\item{process}{A process object inheriting from GY94.} 
#	\item{probs}{A vector of probabilities (p0 ... p4).}
#	\item{index}{A vector of positions.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a GY94 object
#	p<-GY94(kappa=2)
#	# create a CodonSequence object, attach process p
#	s<-CodonSequence(length=25, processes=list(list(p)))
#	# sample states
#	sampleStates(s)
#	# sample omegas in range 1:20 from model M4
#	omegaVarM4(s,p,probs=c(2/5,1/5,1/5,1/10,1/10),1:20)
#	# get omega values	
#	getOmegas(s,p)
#	# get a histogram of omega values in range 1:20
#	omegaHist(s,p,breaks=50,1:20)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "omegaVarM4",
  class="CodonSequence",
  function(
    		this,
		process,
		probs,
		index,
    		...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
		else if(missing(probs)){
			throw("No probabilities specified!\n");
		}
		else if(!is.numeric(probs)){
			throw("The probs must be greater than zero!\n");
		}
		else if( length(probs) != 5){
			throw("The length of the \"probs\" vector must be 5!\n");
		}
		else if(!PSRoot$my.all.equal(sum(probs),1.0)){
			probs<-(probs/sum(probs));
			warning("The provided probabilities were scaked in order to sum to one!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		omegas<-c(0,(1/3),(2/3),1,3);
		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(omegas, size=1, replace=FALSE, prob=probs));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM5Cont - gamma
##  
setMethodS3(
  ".omegaVarM5Cont",
  class="CodonSequence",
  function(
    this,
		process,
		alpha,
		beta,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(alpha)){
      throw("No alpha (shape) value specified!\n");
    }
    else if((!is.numeric(alpha)) | (length(alpha) != 1)){
      throw("The alpha (shape) parameter must be a numeric vector of length 1!\n");
    }
		else if(alpha < 0){
			throw("The alpha (shape) must be greater than zero!\n");
		}
    else if(missing(beta)){
      throw("No beta (scale) value specified!\n");
    }
    else if((!is.numeric(beta)) | (length(beta) != 1)){
      throw("The beta (scale) parameter must be a numeric vector of length 1!\n");
    }
		else if(beta <= 0){
			throw("The beta (scale) must be strictly positive!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=rgamma(1,shape=alpha,scale=beta));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM6Cont - 2gamma
##  
setMethodS3(
  ".omegaVarM6Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		alpha0,
		beta0,
		alpha1,
		beta1,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("p0 must be in the [0,1] interval!\n");
		}
    else if(missing(alpha0)){
      throw("No alpha0 (shape0) value specified!\n");
    }
    else if((!is.numeric(alpha0)) | (length(alpha0) != 1)){
      throw("The alpha0 (shape0) parameter must be a numeric vector of length 1!\n");
    }
		else if(alpha0 < 0){
			throw("The alpha0 (shape0) must be greater than zero!\n");
		}
    else if(missing(beta0)){
      throw("No beta0 (scale0) value specified!\n");
    }
    else if((!is.numeric(beta0)) | (length(beta0) != 1)){
      throw("The beta0 (scale0) parameter must be a numeric vector of length 1!\n");
    }
		else if(beta0 <= 0){
			throw("The beta0 (scale0) must be strictly positive!\n");
		}
    else if(missing(alpha1)){
      throw("No alpha1 (shape1) value specified!\n");
    }
    else if((!is.numeric(alpha1)) | (length(alpha1) != 1)){
      throw("The alpha1 (shape1) parameter must be a numeric vector of length 1!\n");
    }
		else if(alpha1 < 0){
			throw("The alpha1 (shape1) must be greater than zero!\n");
		}
    else if(missing(beta1)){
      throw("No beta1 (scale1) value specified!\n");
    }
    else if((!is.numeric(beta1)) | (length(beta1) != 1)){
      throw("The beta1 (scale1) parameter must be a numeric vector of length 1!\n");
    }
		else if(beta1 <= 0){
			throw("The beta1 (scale1) must be strictly positive!\n");
		}


    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(c(rgamma(1,shape=alpha0,scale=beta0),rgamma(1,shape=alpha1,scale=beta1)),size=1,replace=FALSE,prob=c(p0,(1-p0)) ));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM7Cont - beta
##  
setMethodS3(
  ".omegaVarM7",
  class="CodonSequence",
  function(
    this,
		process,
		p,
		q,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p)){
      throw("No p value specified!\n");
    }
    else if((!is.numeric(p)) | (length(p) != 1)){
      throw("The p parameter must be a numeric vector of length 1!\n");
    }
		else if(p < 0){
			throw("The p parameter must be greater than zero!\n");
		}
    else if(missing(q)){
      throw("No q value specified!\n");
    }
    else if((!is.numeric(q)) | (length(q) != 1)){
      throw("The q parameter must be a numeric vector of length 1!\n");
    }
		else if(q < 0){
			throw("The q parameter must be positive!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=rbeta(1,shape1=p,shape2=q));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM8Cont - beta&omega
##  
setMethodS3(
  ".omegaVarM8Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		p,
		q,
		omega,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("The p0 parameter must be from the [0,1] interval!\n");
		}
    else if(missing(p)){
      throw("No p value specified!\n");
    }
    else if((!is.numeric(p)) | (length(p) != 1)){
      throw("The p parameter must be a numeric vector of length 1!\n");
    }
		else if(p < 0){
			throw("The p parameter must be greater than zero!\n");
		}
    else if(missing(q)){
      throw("No q value specified!\n");
    }
    else if((!is.numeric(q)) | (length(q) != 1)){
      throw("The q parameter must be a numeric vector of length 1!\n");
    }
		else if(q < 0){
			throw("The q parameter must be positive!\n");
		}
    else if(missing(omega)){
      throw("No omega value specified!\n");
    }
    else if((!is.numeric(omega)) | (length(omega) != 1)){
      throw("The omega parameter must be a numeric vector of length 1!\n");
    }
		else if(omega < 0){
			throw("The omega parameter must be positive!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(c(rbeta(1,shape1=p,shape2=q),omega),size=1,replace=FALSE,prob=(c(p0,(1-p0)))));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM9 - beta&gamma
##  
setMethodS3(
  ".omegaVarM9Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		p,
		q,
		alpha,
		beta,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("p0 must be in the [0,1] interval!\n");
		}
    else if(missing(p)){
      throw("No p value specified!\n");
    }
    else if((!is.numeric(p)) | (length(p) != 1)){
      throw("The p parameter must be a numeric vector of length 1!\n");
    }
		else if(p < 0){
			throw("The p must be greater than zero!\n");
		}
    else if(missing(q)){
      throw("No q value specified!\n");
    }
    else if((!is.numeric(q)) | (length(q) != 1)){
      throw("The q parameter must be a numeric vector of length 1!\n");
    }
		else if(q < 0){
			throw("The q must be greater than zero!\n");
		}
    else if(missing(alpha)){
      throw("No alpha (shape) value specified!\n");
    }
    else if((!is.numeric(alpha)) | (length(alpha) != 1)){
      throw("The alpha (shape) parameter must be a numeric vector of length 1!\n");
    }
		else if(alpha < 0){
			throw("The alpha (shape) must be greater than zero!\n");
		}
    else if(missing(beta)){
      throw("No beta (scale) value specified!\n");
    }
    else if((!is.numeric(beta)) | (length(beta) != 1)){
      throw("The beta (scale) parameter must be a numeric vector of length 1!\n");
    }
		else if(beta <= 0){
			throw("The beta (scale) must be strictly positive!\n");
		}


    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(c(rbeta(1,shape1=p,shape2=q),rgamma(1,shape=alpha,scale=beta)),size=1,replace=FALSE,prob=c(p0,(1-p0)) ));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM10Cont - beta&gamma+1
##  
setMethodS3(
  ".omegaVarM10Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		p,
		q,
		alpha,
		beta,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("p0 must be in the [0,1] interval!\n");
		}
    else if(missing(p)){
      throw("No p value specified!\n");
    }
    else if((!is.numeric(p)) | (length(p) != 1)){
      throw("The p parameter must be a numeric vector of length 1!\n");
    }
		else if(p < 0){
			throw("The p must be greater than zero!\n");
		}
    else if(missing(q)){
      throw("No q value specified!\n");
    }
    else if((!is.numeric(q)) | (length(q) != 1)){
      throw("The q parameter must be a numeric vector of length 1!\n");
    }
		else if(q < 0){
			throw("The q must be greater than zero!\n");
		}
    else if(missing(alpha)){
      throw("No alpha (shape) value specified!\n");
    }
    else if((!is.numeric(alpha)) | (length(alpha) != 1)){
      throw("The alpha (shape) parameter must be a numeric vector of length 1!\n");
    }
		else if(alpha < 0){
			throw("The alpha (shape) must be greater than zero!\n");
		}
    else if(missing(beta)){
      throw("No beta (scale) value specified!\n");
    }
    else if((!is.numeric(beta)) | (length(beta) != 1)){
      throw("The beta (scale) parameter must be a numeric vector of length 1!\n");
    }
		else if(beta <= 0){
			throw("The beta (scale) must be strictly positive!\n");
		}


    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }
	
		# It's not too elegant to fork the whole method for just shifting the gamma with 1...
		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(c(rbeta(1,shape1=p,shape2=q),(1 + rgamma(1,shape=alpha,scale=beta)) ),size=1,replace=FALSE,prob=c(p0,(1-p0)) ));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM11Cont - beta&normal>1
##  
setMethodS3(
  ".omegaVarM11Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		p,
		q,
		mean,
		sd,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("p0 must be in the [0,1] interval!\n");
		}
    else if(missing(p)){
      throw("No p value specified!\n");
    }
    else if((!is.numeric(p)) | (length(p) != 1)){
      throw("The p parameter must be a numeric vector of length 1!\n");
    }
		else if(p < 0){
			throw("The p must be greater than zero!\n");
		}
    else if(missing(q)){
      throw("No q value specified!\n");
    }
    else if((!is.numeric(q)) | (length(q) != 1)){
      throw("The q parameter must be a numeric vector of length 1!\n");
    }
		else if(q < 0){
			throw("The q must be greater than zero!\n");
		}
    else if(missing(mean)){
      throw("No mean specified!\n");
    }
    else if((!is.numeric(mean)) | (length(mean) != 1)){
      throw("The mean parameter must be a numeric vector of length 1!\n");
    }
    else if(missing(sd)){
      throw("No sd value specified!\n");
    }
    else if((!is.numeric(sd)) | (length(sd) != 1)){
      throw("The sd parameter must be a numeric vector of length 1!\n");
    }
		else if( sd < 0){
      throw("The sd parameter must be positive!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		rnorm.gt.1<-function(mean=NA,sd=NA){
			# This is probably the most primitive way to truncate the distribution!
			tmp<-rnorm(1,mean=mean,sd=sd);
			while( tmp <= 1){
				tmp<-rnorm(1,mean=mean,sd=sd);
			};
			return(tmp);
		}

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample(c(rbeta(1,shape1=p,shape2=q), (rnorm.gt.1(mean=mean,sd=sd))),size=1,replace=FALSE,prob=c(p0,(1-p0)) ));	
		}
		return(invisible(TRUE));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM12Cont - 0&2normal>0
##  
setMethodS3(
  ".omegaVarM12Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		p1,
		sd1,
		mean2,
		sd2,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("p0 must be in the [0,1] interval!\n");
		}
    else if(missing(p1)){
      throw("No p1 value specified!\n");
    }
    else if((!is.numeric(p1)) | (length(p1) != 1)){
      throw("The p1 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p1 < 0) | (p1 > 1)){
			throw("p1 must be in the [0,1] interval!\n");
		}
    else if(missing(sd1)){
      throw("No sd1 value specified!\n");
    }
    else if((!is.numeric(sd1)) | (length(sd1) != 1)){
      throw("The sd1 parameter must be a numeric vector of length 1!\n");
    }
		else if( sd1 < 0){
      throw("The sd1 parameter must be positive!\n");
		}
    else if(missing(mean2)){
      throw("No mean2 specified!\n");
    }
    else if((!is.numeric(mean2)) | (length(mean2) != 1)){
      throw("The mean2 parameter must be a numeric vector of length 1!\n");
    }
    else if(missing(sd2)){
      throw("No sd2 value specified!\n");
    }
    else if((!is.numeric(sd2)) | (length(sd2) != 1)){
      throw("The sd2 parameter must be a numeric vector of length 1!\n");
    }
		else if( sd2 < 0){
      throw("The sd2 parameter must be positive!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		rnorm.gt.0<-function(mean=NA,sd=NA){
			# This is probably the most primitive way to truncate the distribution!
			tmp<-rnorm(1,mean=mean,sd=sd);
			while( tmp <= 0){
				tmp<-rnorm(1,mean=mean,sd=sd);
			};
			return(tmp);
		}

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample( 
				c(0,rnorm.gt.0(mean=1,sd=sd1),rnorm.gt.0(mean=mean2,sd=sd2)),
				size=1,
				replace=FALSE,
				prob=c(p0,((1-p0)*p1),((1-p0)*(1-p1)))
			));	
		}
		return(invisible(TRUE));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##  
## Method: .omegaVarM13Cont - 3normal>0
##  
setMethodS3(
  ".omegaVarM13Cont",
  class="CodonSequence",
  function(
    this,
		process,
		p0,
		p1,
		sd0,
		sd1,
		mean2,
		sd2,
		index,
    ...
  ){

  if(missing(process)){
      throw("No process specified!\n");
    }
    if(!is.GY94(process)){
      throw("The sepcified process is not a GY94 codon substitution process!\n");
    }
    else if(missing(p0)){
      throw("No p0 value specified!\n");
    }
    else if((!is.numeric(p0)) | (length(p0) != 1)){
      throw("The p0 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p0 < 0) | (p0 > 1)){
			throw("p0 must be in the [0,1] interval!\n");
		}
    else if(missing(p1)){
      throw("No p1 value specified!\n");
    }
    else if((!is.numeric(p1)) | (length(p1) != 1)){
      throw("The p1 parameter must be a numeric vector of length 1!\n");
    }
		else if( (p1 < 0) | (p1 > 1)){
			throw("p1 must be in the [0,1] interval!\n");
		}
    else if(missing(sd0)){
      throw("No sd0 value specified!\n");
    }
    else if((!is.numeric(sd0)) | (length(sd0) != 1)){
      throw("The sd0 parameter must be a numeric vector of length 1!\n");
    }
		else if( sd0 < 0){
      throw("The sd0 parameter must be positive!\n");
		}
    else if(missing(sd1)){
      throw("No sd1 value specified!\n");
    }
    else if((!is.numeric(sd1)) | (length(sd1) != 1)){
      throw("The sd1 parameter must be a numeric vector of length 1!\n");
    }
		else if( sd1 < 0){
      throw("The sd1 parameter must be positive!\n");
		}
    else if(missing(mean2)){
      throw("No mean2 specified!\n");
    }
    else if((!is.numeric(mean2)) | (length(mean2) != 1)){
      throw("The mean2 parameter must be a numeric vector of length 1!\n");
    }
    else if(missing(sd2)){
      throw("No sd2 value specified!\n");
    }
    else if((!is.numeric(sd2)) | (length(sd2) != 1)){
      throw("The sd2 parameter must be a numeric vector of length 1!\n");
    }
		else if( sd2 < 0){
      throw("The sd2 parameter must be positive!\n");
		}

    if(missing(index)){
    index<-seq(along.with=this$.sites);
    }
    else {
      index<-.checkIndexSanity(this, index);
    }

		rnorm.gt.0<-function(mean=NA,sd=NA){
			# This is probably the most primitive way to truncate the distribution!
			tmp<-rnorm(1,mean=mean,sd=sd);
			while( tmp <= 0){
				tmp<-rnorm(1,mean=mean,sd=sd);
			};
			return(tmp);
		}

		for(site in this$.sites[index]){
			setParameterAtSite(this=process,site=site, id="omega", value=sample( 
				c(rnorm.gt.0(mean=0,sd=sd0),rnorm.gt.0(mean=1,sd=sd1),rnorm.gt.0(mean=mean2,sd=sd2)),
				size=1,
				replace=FALSE,
				prob=c(p0,((1-p0)*p1),((1-p0)*(1-p1)))
			));	
		}
		return(invisible(TRUE));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## 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="CodonSequence", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }
			
		  may.fail<-function(this) {
	
				for(pos in seq(along.with=this$.sites)){
					if(!is.CodonAlphabet(this$.sites[[pos]]$.alphabet)){
						throw("The alphabet attached to site ",pos," is not a codon alphabet!\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: Translate
##  
###########################################################################/**
#
# @RdocMethod Translate
# 
# @title "Translate a CodonSequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A CodonSequence object} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The translation as an AminoAcidSequence object.
# } 
# 
# \examples{
#	# create a CodonSequence object
#	s<-CodonSequence(string="ATCTTTCGAATGGGGCCCTCCCGA")
#	# get the translation as an AminoAcidSequence object
#	as<-Translate(s)
#	as
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "Translate",
  class="CodonSequence",
  function(
    this,
    ...
  ){ 

			# Create an amino acid sequence of proper length:
			that<-AminoAcidSequence(
					name=paste("Translation of",this$name),
					length=this$length
			);

			# Setting the states, using the site alphabet to translate codons for greater flexibility.
			for (pos in seq(along.with=this$.sites)){
				setState(that$.sites[[pos]], translateCodon(this$.sites[[pos]]$alphabet, this$.sites[[pos]]$state) );
			}

			return(that);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass Process
# 
# @title "The Process class"
# 
# \description{ 
#
#	This is the class representing a generic process acting on Site and Sequence objects. Process objects can be attached
#	to Site objects if the associated Alphabet objects match.
#
#	The processes can have site-process-specific parameters.
#	The templates for site-process-specific parameters and their default values are stored in the Process objects and
#       copied into the Site object when the process is attached. See the documentation of the Site class for more details.
#
#	The rate multiplier parameter (id="rate.multiplier") is
#	present in the Process class and is inherited by all descendant classes.
#	
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the Process object: a character vector of length one.}
#	\item{alphabet}{The associated Alphabet object.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@methods
# }
# 
# \examples{ 
#	# create a Process object
#	p<-Process(name="MyProc",alphabet=AminoAcidAlphabet())	
#	# check if it's a Process object
#	is.Process(p)
#	# check object consistency
#	checkConsistency(p)
#	# set process name
#	p$name<-"Ppppproccc"
#	# get process name
#	p$name
#	# get unique process identifier
#	p$id
#	# get the list of site specific paramters and paramter IDs
#	p$siteSpecificParamList
#	p$siteSpecificParamIds
#	# get Process object summary
#	summary(p)
#	# clone process object
#	pp<-clone(p)
#	# test object identity
#	p == p
#	p == pp
#	# create a site object
#	s<-Site(alphabet=AminoAcidAlphabet())
#	# attach process to Site object
#	attachProcess(s,p)
#	# get events at specified site
#	getEventsAtSite(p,s)	# empty list
#	# detach process via virtual field
#	s$processes<-list()
#	# attach processes via virtual field
#	s$processes<-list(p,pp)
#	# set the value of the rate multiplier for Site s
#	setParameterAtSite(p,s,id="rate.multiplier",value=2)
#	# get the value of the rate multiplier for Site s
#	getParameterAtSite(p,s,id="rate.multiplier")
# }
# 
# @author
#
# \seealso{ 
# 	@seeclass 
# }
# 
#*/###########################################################################
setConstructorS3(
	"Process",
	function( 
		name=NA,
		alphabet=NA,
		... 
		){

		this<-extend(
			PSRoot(),
			"Process",
			.name=NA,
			.id=NA,
			.alphabet=NA,
			.site.specific.param.list=list(),
			.event.template=NA,
			.write.protected=FALSE,
			.is.process=TRUE
		);
		.addSiteSpecificParameter(
			this,
			id="rate.multiplier",
			name="Rate multiplier",
			value=as.double(1),
			type="numeric"
		);
		
		STATIC<-TRUE;	

		if(!missing(alphabet)){
			this$alphabet<-alphabet;
			STATIC<-FALSE;
		}

		if (!missing(name)){
			this$name<-name;
			STATIC<-FALSE;
		} else {
			this$name<-"Anonymous";
		}

		if(!STATIC) {
			this$.event.template<-Event(process=this);
		}

		this;
	},
	enforceRCC=TRUE
);

##
## Method: is.Process
##
###########################################################################/**
#
# @RdocDefault is.Process
# 
# @title "Check if an object is an instance of the Process class" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#	# create some objects
#	a<-Site();
#	p<-Process()
#	# check if they inherit from Process
#	is.Process(a)
#	is.Process(p)
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "is.Process",
  class="default",
  function(
    this,
    ...
  ){

    if(!is.PSRoot(this)) {return(FALSE)}
   	if(!is.null(this$.is.process)){return(TRUE)}
    if ( inherits(this, "Process")) {
      this$.is.process<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## 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="Process",
  function(
    this,
    ...
  ){
		
			if(is.null(this$.alphabet)) {
				throw("Process alphabet is NULL!\n");
			}
			else if(is.null(this$.name)) {
				throw("Process name is NULL!\n");
			}
			if(is.null(this$.site.specific.param.list)) {
				throw("Site specific parameter list is NULL!\n");
			}

			wp<-this$writeProtected;		
			if (wp) {
				this$writeProtected<-FALSE;
			}
			
			may.fail<-function(this) {
				# Do not reset alphabet for substirution processes
				# as that would wipe out the rates:
				if (!is.na(this$alphabet) & !is.GeneralSubstitution(this)) {
					this$alphabet<-this$alphabet;
				}			

			}
			tryCatch(may.fail(this),finally=this$writeProtected<-wp);
			
			.checkSiteSpecificParamList(this,plist=this$.site.specific.param.list);			
	
			return(invisible(TRUE));

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkSiteSpecificParamList
##
setMethodS3(
  ".checkSiteSpecificParamList",
  class="Process",
  function(
    this,
		plist,
    ...
  ){
		
			if (missing(plist)) {
					throw("No list given!\n");
			}			

			if(!is.list(plist)) {
				throw("Site specific parameter list is invalid!\n");
			} else {
				for (p in plist) {
						if (!setequal(names(p),c("name","value","type"))) {
								throw("Process-site specific parameter list inconsistent!\n");
						}
						else {
								if (length(p$name) == 0 | !is.character(p$name)) {
									throw("Site specific process parameter name invalid!\n");
								}
								else if (length(p$type) == 0 | !is.character(p$type)) {
									throw("Site specific process parameter type invalid!\n");
								}
								else if (length(intersect(class(p$value),p$type)) == 0 ) {
									throw(paste("The site specific parameter \"",p$name,"\" supposed to be \"",p$type,"\", but it is something else!\n",sep=""));
							}
						}
				}

			}
			return(invisible(TRUE));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: ==.Process
##
###########################################################################/**
#
# @RdocMethod ==
# \alias{!=.Process}
# 
# @title "Check whether the two supplied Process objects are identical" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{e1}{A Process object.} 
# 	\item{e2}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	TRUE or FALSE; 
# } 
# 
# \examples{
#	# create some Process objects
#	p1<-Process()
#	p2<-clone(p1)
#	# check object equality
#	p1 == p1
#	p1 == p2
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "==",
  class="Process",
  function(
    e1,
    e2,
    ...
  ){
		
		equals(e1, e2);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: !=.Process
##
setMethodS3(
  "!=",
  class="Process",
  function(
    e1,
    e2,
    ...
  ){
		
		!equals(e1, e2);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .addSiteSpecificParameter
##
setMethodS3(
  ".addSiteSpecificParameter",
  class="Process",
  function(
    this,
		id,
		name,
		value,
		type,
    ...
  ){
		
		if (missing(id)) {throw("No id given!\n")}
		else if (missing(name)) {throw("No name given!\n")}
		else if (missing(value)) {throw("No value given!\n")}
		else if (length( intersect(class(value),type) ) == 0 ) {
			throw("The specified default value is not of the correct type!\n");
		}
		
		id<-as.character(id);
		this$.site.specific.param.list[[id]]<-list(
            "name"=name,
            "value"=value,
						"type"=type
        );

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getId
##	
###########################################################################/**
#
# @RdocMethod getId
# 
# @title "Get the unique identifier of a Process object" 
# 
# \description{ 
#	@get "title".
#	The unique identifier is the concatenation of the class, the object name as returned by getName() and the object hash 
#	as returned by hashCode().
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a Process object
#	p<-Process()
#	# get unique id
#	getId(p)
#	# get unique id via virtual field
#	p$id
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getId", 
	class="Process", 
	function(
		this,
		...
	){

		this$.id;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .setId
##	
setMethodS3(
	".setId", 
	class="Process", 
	function(
		this,
		...
	){
	
	this.class<-class(this)[1];
	this$.id<-paste(this.class,this$.name,hashCode(this),sep=":");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setId
##	
###########################################################################/**
#
# @RdocMethod setId
#
# @title "Forbidden action: setting the unique Process object identifier"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setId", 
	class="Process", 
	function(
		this,
	  	value,	
		...
	){

	throw("Id is generated automatically and it cannot be set!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getName
##	
###########################################################################/**
#
# @RdocMethod getName
# 
# @title "Get the name of a Process object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A charcter vector of length one.
# } 
# 
# \examples{
#	# create a Process object
#	p<-Process()
#	# get object name
#	getName(p)
#	# get name via virtual field
#	p$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getName", 
	class="Process", 
	function(
		this,
		...
	){

		this$.name;
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setName
##	
###########################################################################/**
#
# @RdocMethod setName
# 
# @title "Set the name of a Process object" 
# 
# \description{ 
#	@get "title".
#
#	This method also updates the unique identifier of the Process object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{new.name}{A character vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Returns the new name (invisible).
# } 
# 
# \examples{
#	# create object
#	p<-Process()
#	# get name
#	p$name
#	# set new name
#	getName(p)
#	# get name and id
#	p$name
#	p$id
#	# set new name via virtual field
#	p$name<-"Procey"
#	p$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setName", 
	class="Process", 
	function(
		this,
		new.name,
		...
	){
		
		.checkWriteProtection(this);	
		this$.name<-as.character(new.name);
		.setId(this);
		invisible(new.name);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSiteSpecificParamList
##	
###########################################################################/**
#
# @RdocMethod getSiteSpecificParamList
# 
# @title "Get the list of site specific parameters of a Process object"
# 
# \description{ 
#	@get "title".
#	Every site specific parameter is a list storing the name, the identifier and the type of the given parameter.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of site specific parameters.
# } 
# 
# \examples{
#	# create a process object
#	p<-Process()
#	# get the list of site specific parameters
#	getSiteSpecificParamList(p)
#	# get it via virtual field
#	p$siteSpecificParamList
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSiteSpecificParamList", 
	class="Process", 
	function(
		this,
		...	
	){
		this$.site.specific.param.list;
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSiteSpecificParamList
##	
###########################################################################/**
#
# @RdocMethod setSiteSpecificParamList
#
# @title "Forbidden action: setting the site specific paramter list for a Process object"
#
# \description{
#       @get "title".
#	Use .addSiteSpecificParameter to add new site specific paramters when implementing new processes.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################

setMethodS3(
	"setSiteSpecificParamList", 
	class="Process", 
	function(
		this,
	  	value,	
		...	
	){
		throw("You should not set the siteSpecificParamList directly!\n");
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSiteSpecificParamIds
##	
###########################################################################/**
#
# @RdocMethod getSiteSpecificParamIds
# 
# @title "Get the site specific paramter identifiers from a Process object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A charcter vector.
# } 
# 
# \examples{
#	# create process object
#	p<-Process()
#	# get site specific parameter identifiers
#	getSiteSpecificParamIds(p)
#	# via virtual field
#	p$siteSpecificParamIds
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSiteSpecificParamIds", 
	class="Process", 
	function(
		this,
		...	
	){
		names(this$.site.specific.param.list);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSiteSpecificParamIds
##	
###########################################################################/**
#
# @RdocMethod setSiteSpecificParamIds
#
# @title "Forbidden action: setting the paramter identifiers of the site specific paramters from a Process object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################

setMethodS3(
	"setSiteSpecificParamIds", 
	class="Process", 
	function(
		this,
	  value,	
		...	
	){
		throw("You should not set the siteSpecificParamIds directly!\n");
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAlphabet
##	
###########################################################################/**
#
# @RdocMethod getAlphabet
# 
# @title "Get the Alphabet object associated with a given Process object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An Alphabet object.
# } 
# 
# \examples{
#	# create a process object
#	p<-Process(alphabet=NucleotideAlphabet())
#	# get associated Alphabet object
#	getAlphabet(p)
#	# via virtual field
#	p$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAlphabet", 
	class="Process", 
	function(
		this,
		...	
	){
			this$.alphabet;
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAlphabet
##	
###########################################################################/**
#
# @RdocMethod setAlphabet
# 
# @title "Assotiate an Alphabet object with a Process object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{new.alphabet}{A valid Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Alphabet object (invisible).
# } 
# 
# \examples{
#	# create objects
#	a<-AminoAcidAlphabet()
#	p<-Process()
#	# assotiate p with Alphabet object a
#	setAlphabet(p,a)
#	p$alphabet
#	# assotiate p with a new NucleotideAlphabet via virtual field
#	p$alphabet<-NucleotideAlphabet()
#	p$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAlphabet", 
	class="Process", 
	function(
		this,
		new.alphabet,
		...	
	){
		
			.checkWriteProtection(this);	
			if (!is.Alphabet(new.alphabet)) {throw("The alphabet object is invalid!\n")}
			else {
				this$.alphabet<-new.alphabet;				
			}
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEventsAtSite
##	
###########################################################################/**
#
# @RdocMethod getEventsAtSite
# 
# @title "Generate the list of active Event objects given a Site object" 
# 
# \description{ 
#	@get "title".
#	The Process object must be attached to the specified Site object.
#
#	This method is crucial for the simulations. For the Process class it returns an empty list. 
#	Descendant classes should implement meaningful getEventsAtSite methods. 
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{site}{A valid Site object.} 
# 	\item{position}{The position of the site in the enclosing Sequence object (if any).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An empty list.
# } 
# 
# \examples{
#	# create objects
#	a<-NucleotideAlphabet()
#	p<-Process(alphabet=a)
#	s<-Site(alphabet=a)
#	# attach Process p to Site s
#	s$processes<-list(p)
#	# get active Event objects (empty list)
#	getEventsAtSite(p,s)
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventsAtSite", 
	class="Process", 
	function(
		this,
		site,
		position,
		...	
	){
		
		# Returns a list of event objects;	
		#e1<-Event(name="A->T",rate=0.2,process=this);	
		#e2<-clone(e1);
		#e1$name<-"Insertion";
		#list(e1,e2);
		list();
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: getWriteProtected
##
###########################################################################/**
#
# @RdocMethod getWriteProtected
#  
# @title "Check if the object is write protected" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#
#       # create an object
#       o<-Process()
#       # toggle write protection
#       o$writeProtected<-TRUE
#       # check if it's write protected
#       getWriteProtected(o)
#       # check write protection via virtual field
#       o$writeProtected
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getWriteProtected",
  class="Process",
  function(
    this,
    ...
  ){

    this$.write.protected;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setWriteProtected
##
###########################################################################/**
#
# @RdocMethod setWriteProtected
#  
# @title "Set the write protection field for an object" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{value}{A logical vector of size one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or FALSE.
# } 
# 
# \examples{
#
#	# create an object
#	o<-Process()
#	# toggle write protection
#	setWriteProtected(o,TRUE)
#	# check write protection
#	o$writeProtected
#	# set write protection via virtual field
#	o$writeProtected<-FALSE
#	o$writeProtected
#	
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setWriteProtected",
  class="Process",
  function(
    this,
    value,
    ...
  ){

    if(!is.logical(value)) {throw("The new value must be logical!\n")}
    else {
      this$.write.protected<-value;
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: hasUndefinedRate
##
###########################################################################/**
#
# @RdocMethod hasUndefinedRate
# 
# @title "Check if the Process object has undefined rate parameters" 
# 
# \description{ 
#	@get "title".
#
#	For the instances of the Process class this method always returns FALSE.
#	Descendant classes should implement more meaningful methods.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	FALSE
# } 
# 
# \examples{
#	# create object
#	p<-Process()
#	# check if has undefined rates
#	hasUndefinedRate(p)	# return FALSE
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "hasUndefinedRate",
  class="Process",
  function(
    this,
    ...
  ){

		return(FALSE);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkWriteProtection
##
setMethodS3(
  ".checkWriteProtection",
  class="Process",
  function(
    this,
    value,
    ...
  ){

    if(exists(x="PSIM_FAST")){
 	    return(FALSE);
    }
    if(this$writeProtected) {throw("Cannot set value because the object is write protected!\n")}
    else {return(FALSE)}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: clone
##
###########################################################################/**
#
# @RdocMethod clone
#
# @title "Clone a process object"
#
# \description{
#       @get "title".
#       Write protection is set to FALSE for the new Process object.
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{A Process object.}
#       \item{...}{Not used.}
# }
#
# \value{
#       A Process object.
# }
#
# \examples{
#       # create a process object
#       p<-Process()
#       # clone process object
#       pp<-clone(p)
#       # check identity
#       p == pp
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "clone",
  class="Process",
  function(
    this,
    ...
  ){

			tmp<-clone.Object(this);
			if(tmp$writeProtected){
					tmp$writeProtected<-FALSE;
			}
		
			# Reassingning name to
			# force Id update.
			tmp$name<-tmp$name;
			tmp;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: as.character.Process
##	
###########################################################################/**
#
# @RdocMethod as.character
#
# @title "Get the character representation of a Process object"
#
# \description{
#       @get "title".
#	The string returned is the unique Process object identifier (class name + process name + object hash).
# }
#
# @synopsis
#
# \arguments{
#       \item{x}{A Process object}
#       \item{...}{Not used.}
# }
#
# \value{
#  A character vector of length one.
# }
#
# \examples{
#
#       # create a Process object
#       p<-Process()
#	# get charatcer representation
#	x<-as.character(p)
#	print(x)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="Process", 
	function(
		x,
		...	
	){
			x$id;
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .addSummaryAlphabet
##	
setMethodS3(
	".addSummaryAlphabet", 
	class="Process", 
	function(
		this,
		...	
	){

		
			if(!is.na(this$alphabet)) {
     	 	alphabet_symbols<-paste(this$alphabet$symbols,collapse=" ");
      	this$.summary$"Alphabet"<-paste("\n","  Type: ",this$alphabet$type,"\n","  Symbols: ", alphabet_symbols,sep="");
    	} else {
       	 this$.summary$"Alphabet"<-NA
    	}
		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .addSummaryNameId
##	
setMethodS3(
	".addSummaryNameId", 
	class="Process", 
	function(
		this,
		...	
	){

		if(is.null(this$.summary$"Name")){
			this$.summary$"Name"<-this$name;
		}
		if(is.null(this$.summary$"Id")){
			this$.summary$"Id"<-this$id;
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: summary.Process
##	
###########################################################################/**
#
# @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<-NucleotideAlphabet()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="Process", 
	function(
		object,
		...	
	){
		this<-object;
		.addSummaryNameId(this);

		# Skip the alphabet for InDel processes
		if(!is.GeneralInDel(this)){
			.addSummaryAlphabet(this);
		}
			
			tmp<-character();
			param_list<-this$siteSpecificParamList;
			counter<-0;		
	
			for (id in names(param_list)) {
					param<-param_list[[id]];	
					tmp<-paste(tmp,
						"\n  Id: ",id,
						"\n  Name: ",param$name,
						"\n  Type: ",param$type,
						"\n  Default value: ",param$value,
						sep=""
										);
										counter<-counter+1;
										if ( counter < length(param_list) ){
											tmp<-paste(tmp,"\n");
										}
										
			}	
		
			header<-paste("Site specific parameters (",length(param_list),")",sep="");
			this$.summary[[header]]<-tmp;
			if(getWriteProtected(this)) {
				this$.summary$"Write protected"<-TRUE;
			}			

			NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: hasSiteSpecificParameter
##
###########################################################################/**
#
# @RdocMethod hasSiteSpecificParameter
# 
# @title "Check if a Process object has the site-process specific parameter with the given id" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{id}{The identifier of the site-process specific parameter of interest.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a process object
#	p<-Process()
#	# check whether it has the "rate.multiplier" site-process specific paramter
#	hasSiteSpecificParameter(p,"rate.multiplier");	# TRUE
#	# check whether it has the "omega" site-process specific paramter
#	hasSiteSpecificParameter(p,"omega");	# FALSE
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "hasSiteSpecificParameter",
  class="Process",
  function(
    this,
    id,
    ...
  ){
			if (missing(id)) {throw("Parameter identifier is missing!\n")}
			else if ( length (intersect((as.vector(this$siteSpecificParamIds) == id),TRUE) ) == 0 ) {
					return(FALSE);
			} else {
				return(TRUE);
			}
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getParameterAtSite
##
###########################################################################/**
#
# @RdocMethod getParameterAtSite
# 
# @title "Get the value of a site-process specific paramter from a Site object attached to a Process object" 
# 
# \description{ 
#	@get "title".
#	The Process object must be attached to the Site object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{site}{A Site object.} 
#	\item{id}{The identifier of the site-process specific parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The site-process specific parameter, which is a list containing the following keys: id, name, value, type.
# } 
# 
# \examples{
#	# create a Site and a Process object
#	a<-Alphabet()
#	s<-Site(alphabet=a)
#	p<-Process(alphabet=a)
#	# attach the process
#	attachProcess(s,p)
#	# get the value of the rate multiplier
#	getParameterAtSite(p,s,"rate.multiplier")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getParameterAtSite",
  class="Process",
  function(
    this,
    site,
    id,
    ...
  ){
			if (missing(id)) {throw("Parameter identifier is missing!\n")}
			
			if (.checkTriplett(this,site,id)){
				id<-as.character(id);
				list (
					id=id,
					name=site$.processes[[getId(this)]]$site.params[[id]]$name,
					value=site$.processes[[getId(this)]]$site.params[[id]]$value,
					type=site$.processes[[getId(this)]]$site.params[[id]]$type
				);
			}
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .getParameterAtSiteFast
##
setMethodS3(
  ".getParameterAtSiteFast",
  class="Process",
  function(
    this,
    site,
    id,
    ...
  ){
				site$.processes[[this$.id]]$site.params[[as.character(id)]]$value;
  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setParameterAtSite
##
###########################################################################/**
#
# @RdocMethod setParameterAtSite
# \alias{setParameterAtSite.FastFieldDeletor} 
# @title "Set the value of a site-process specific paramter in a Site object attached to a Process object" 
# 
# \description{ 
#	@get "title".
#	The Process object must be attached to the Site object. The new value must be compatible with the type
#	of the site-process specific parameter.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Process object.} 
# 	\item{site}{A Site object.} 
#	\item{id}{The identifier of the site-process specific parameter.}
#	\item{value}{The new value for the parameter.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The site-process specific parameter, which is a list containing the following keys: id, name, value, type.
# } 
# 
# \examples{
#	# create a Site and a Process object
#	a<-BinaryAlphabet()
#	s<-Site(alphabet=a)
#	p<-Process(alphabet=a)
#	# attach the process
#	attachProcess(s,p)
#	# set the value of the rate multiplier
#	setParameterAtSite(p,s,"rate.multiplier",2)
#	# get the value of the rate multiplier
#	getParameterAtSite(p,s,"rate.multiplier")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setParameterAtSite",
  class="Process",
  function(
    this,
    site,
    id,
    value,
    ...
  ){

    if(!exists(x="PSIM_FAST")){
	if (missing(id)) {throw("Parameter identifier is missing!\n")};
    }
     	id<-as.character(id);
			
	if (.checkTriplett(this,site,id)){

		type<-site$.processes[[this$id]]$site.params[[id]]$type;
    if(!exists(x="PSIM_FAST")){
		if (length(intersect(class(value),type)) == 0 ) {throw("The new value is of wrong type!\n")}
    }
		site$.processes[[this$id]]$site.params[[id]]$value<-value;
	
	}

	site$.total.rate<-NA;
	if(!is.na(site$.sequence)){
	site$.sequence$.cumulative.rate.flag<-TRUE;
	}
	invisible(this);
				
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkTriplett
##
setMethodS3(
  ".checkTriplett",
  class="Process",
  function(
    this,
    site,
		id,
		...
  ){
		
			if(exists(x="PSIM_FAST")){ return(TRUE) }
					
			if (!is.Site(site)) {throw ("Site object not valid!\n")}
			else if (!hasSiteSpecificParameter(this,id)) {
				throw(paste("The process",this$id,"has no site specific paramter with id:",id,"!\n",sep=" "));
			}
			else if (!isAttached(site,this)) {throw("Process is not attached to site!\n")} else {
				return(TRUE);
			}
  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass QMatrix
# 
# @title "The QMatrix class"
# 
# \description{ 
#	This is the class representing rate matrices. The QMatrix objects store two rate matrices: one contains
#       the rates provided by the user (unscaled rate matrix), the other matrix (scaled rate matrix) is rescaled so the 
#       expected number of subsitutions per unit time is equal to one when the process is at equlibrium.
#	The scaled rate matrices, along with the site-process-specific rate multiplier
#	parameters define the rates of the Event objects generated by the associated GeneralSubstitution objects.          	
#
#	The QMatrix objects have a bidirectonal relationship with the GeneralSubstitution object as they store a reference 
#	to the associated process objects. QMatrix objects do not have a write-protection field, but they use the one
#	from the associated GeneralSubstitution object.
#
#	Usually there is no need to interact with the QMatrix objects directly, so this class
#	is mainly used internally.	
#	
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the QMatrix object (a character vector of length one).}
#	\item{alphabet}{An Alphabet object.}
#	\item{rate.list}{A list of unscaled event rates and the associated event names. It will be passed to the \code{setRateList.QMatrix} method.}
#	\item{process}{A GeneralSubstitution object to be associated with the QMatrix object.}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a QMatrix object by providing an Alphabet object and rates
#	m<-QMatrix(name="Susie Q", alphabet=BinaryAlphabet(), rate.list=list("1->0"=2,"0->1"=3))
#	# get object summary
#	summary(m)
#       # create a GeneralSubstitution object by
#       # providing an Alphabet object and the rates
#       p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#       # get the QMatrix object from p
#       m<-p$QMatrix
#	# get various object properties
#	m
#	is.QMatrix(m)
#	m$name
#	m$id
#	m$alphabet
#	# get the associated process
#	m$process
#	# get the unscaled rate of "0->1"
#	getRate(m,"0->1")
#	# get the scaled rate of "0->1"
#	getEventRate(m,"0->1")
#	# get the list of unscaled rates	
#	m$rateList
#	# get unscaled rate matrix
#	m$matrix
#	# get scaled rate matrix
#	m$scaledMatrix
# }
# 
# @author
#
# \seealso{ 
# 	GeneralSubstitution Alphabet Process
# }
# 
#*/###########################################################################
setConstructorS3(
  "QMatrix",
  function( 
		name="Anonymous",
		alphabet=NA,
		rate.list=NA,
		process=NA,
		... 
		)	{

		this<-PSRoot();
   		this<-extend(
     			 this,
      			"QMatrix",
			.name=NA,
			.alphabet=NA,
			.rate.matrix=NA,
			.orig.matrix=NA,
		  	.norm.const=NA,
			.process=NA,
			.is.q.matrix=TRUE
    		);
		
		this$name<-name;

		if(!missing(process)){
			this$process<-process;
		}

		if(!missing(alphabet)){
			this$alphabet<-alphabet;
		}

		if(!missing(rate.list)){
			if(missing(alphabet)){
				throw("Cannot set rates because the alphabet is not specified!\n")
			}
			this$rateList<-rate.list;
		}

    return(this);
  },
  enforceRCC=TRUE
);

##	
## Method: .buildRateMatrix
##	
setMethodS3(
	".buildRateMatrix", 
	class="QMatrix", 
	function(
		this,
		...
	){

		size<-this$alphabet$size;
		symbols<-this$alphabet$symbols;

		# Setting the dimension names
		# for the original rates matrix:
		if(!isEmpty(this$.alphabet)){
			this$.orig.matrix<-matrix(nrow=size,ncol=size);
			colnames(this$.orig.matrix)<-symbols;
			rownames(this$.orig.matrix)<-symbols;
		}
		# Copy to the scaled matrix:
		this$.rate.matrix<-this$.orig.matrix;
	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency
##	
###########################################################################/**
#
# @RdocMethod	checkConsistency
# 
# @title "Check object consistency"
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
#
# \arguments{ 
#       \item{this}{An object.} 
#       \item{check.process}{Check the associated process 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="QMatrix", 
	function(
		this,
		check.process=TRUE,
		...
	){

			if(is.Process(this$.process)){

      		wp<-this$.process$.write.protected;
      		if (wp) {
			# Cannot use virtual field here because of 
			# some obscure errror:
        		this$.process$.write.protected<-FALSE;
      		}
			}
      may.fail<-function(this) {
					
				# Reassing name:
				this$name<-this$name;
				# Do not reassign alphabet as that will wipe out the rates!
				if(!is.na(this$.alphabet) & !is.Alphabet(this$.alphabet)){
					throw("QMatrix alphabet is invalid!\n");
				}
		
				# Check if the original rate matrix is a matrix or NA.
				if(!is.matrix(this$.orig.matrix) & !all(is.na(this$.orig.matrix))){
						throw("The original rates matrix is invalid!\n");
				}	
				# Check original rates matrix size:
				else if(!all(dim(this$.orig.matix) != c(this$.alphabet$.size, this$.alphabet$.size))) {
					throw("The original rates matrix is of wrong size!");
				}
				# Check if the rescaled rate matrix is a matrix or NA.
				if(!is.matrix(this$.rate.matrix) & !all(is.na(this$.rate.matrix))){
						throw("The rescaled rates matrix is invalid!\n");
				}	

				# Check rescaled rates matrix size:
				else if(!all(dim(this$.rates.matix) != c(this$.alphabet$.size, this$.alphabet$.size))) {
					throw("The original rates matrix is of wrong size!");
				}

				# Flag for not having NA-as in the matrices.
				COMPLETE<-TRUE;

			
				if(is.matrix(this$.orig.matrix) ){
					if(any(is.na(this$.orig.matrix))){
						warning("Some rates are undefined!\n");
						COMPLETE<-FALSE;
					}
					# Watch out for the operator precedence here!
					else if ( (!all(is.numeric(this$.orig.matrix))) & (!all(is.na(this$.orig.matrix))) ){
						print(this$.orig.matrix)
						throw("The original rates matrix has non-numeric elements!\n");
					}
				}
				
				if(is.matrix(this$.orig.matrix) ){
					if( any(is.na(this$.orig.matrix)) & COMPLETE ){
						COMPLETE<-FALSE;
						throw("The original rates matrix is complete, but the rescaled matrix has undefined elements!\n");
					}
					# Watch out for the operator precedence here!
					else if ( (!all(is.numeric(this$.orig.matrix)) & (!all(is.na(this$.orig.matrix)))) ){
						throw("The original rates matrix has non-numeric elements!\n");
					}
				}

				# Check the normalizing constant:
				if( length(this$.norm.const) != 1 | (!is.na(this$.norm.const) & !is.numeric(this$.norm.const)) ){
					 throw("Normalizing constant is invalid!\n");
				}

				# Check the normalization:
				if(is.matrix(this$.orig.matrix) & is.matrix(this$.rate.matrix) & COMPLETE ){
						if(!PSRoot$my.all.equal(this$.rate.matrix, (this$.norm.const * this$.orig.matrix)) ){
							throw("The scaled matrix is inconsistent with the original matrix and the normalizing constant!\n");
						}
				}

				# Check the process:
				if(check.process==TRUE){
					 if(is.Process(this$.process)){
							# Check for alphabet compatibility:
							if(this$.alphabet != this$.process$alphabet){
								throw("Process/QMatrix alphabet mismatch!\n");
							}
							# Check if the parent process QMatrix is this object:
							if(!equals(this$.process$.q.matrix, this) ){
								throw("Parent process QMatrix is not identical with self!\n");
							}
					 }
					 else if(!is.na(this$.process)){
							throw("Process entry is invalid!\n");
					 }
				}
				
      
			}
      tryCatch(may.fail(this),finally={if(is.Process(this$.process)){this$.process$.write.protected<-wp}});
			return(invisible(TRUE));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .callRateRescaling
##	
setMethodS3(
	".callRateRescaling", 
	class="QMatrix", 
	function(
		this,
		guess.equ=TRUE,
		...
	){

		# Usually called when the rate matrix chenges.
		# If the Q matrix has a parent process with a valid equilibrium distribution:
		if(is.Process(this$.process) & !any(is.na(as.vector(this$.orig.matrix))) ){

		if(guess.equ){
			# Try to guess the new equlibrium distribution:
			if(!.setEquDistFromGuess(this$.process)){
						# Fill with NA-s if failed with guessing:
      	    .initEquDist(this$.process);
      	}
		}
			# Rescale if the equilibrium distribution was succesfully set:
			if(all(!is.na(this$.process$equDist))){
				rescaleQMatrix(this$.process);
			}

		}

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getName
##	
###########################################################################/**
#
# @RdocMethod getName
# 
# @title "Get the name of a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A charcter vector of length one.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# set/get name
#	setName(m,"Susie Q")
#	getName(m)
#	# set/get name via virtual field
#	m$name<-"Q"
#	m$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getName", 
	class="QMatrix", 
	function(
		this,
		...
	){

		this$.name;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setName
##	
###########################################################################/**
#
# @RdocMethod setName
# 
# @title "Set the name of a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
#	\item{value}{A character vector of length one.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new object name.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# set/get name
#	setName(m,"Susie Q")
#	getName(m)
#	# set/get name via virtual field
#	m$name<-"Q"
#	m$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setName", 
	class="QMatrix", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);
	if(missing(value)){
		throw("No new value provided!\n");
	}
	else{
		value<-as.character(value);
		if(stringLength(value) == 0){
			throw("Cannot set empty name!");
		} else {
			this$.name<-value;
		}
	}
	return(this$.name);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getProcess
##	
###########################################################################/**
#
# @RdocMethod getProcess
# 
# @title "Get the process object associated with a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A process object, most likely one which inherits from GeneralSubstitution.
# } 
# 
# \examples{
#	# Create a GeneralSubstitution object
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet())
#	p
#	# get the associated QMatrix object from p
#	m<-p$qMatrix
#	summary(m)
#	# get the associated process from m
#	m$process
#	# clone p
#	pp<-clone(p)
#	# assotiate m with pp
#	pp$qMatrix<-m
#	# assotiate pp with m
#	m$process<-pp
#	m$process
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getProcess", 
	class="QMatrix", 
	function(
		this,
		...
	){

		this$.process;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setProcess
##	
###########################################################################/**
#
# @RdocMethod setProcess
# 
# @title "Assotiate a process object with a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
#	\item{value}{A Process object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Process object.
# } 
# 
# \examples{
#	# Create a GeneralSubstitution object
#	p<-GeneralSubstitution(alphabet=BinaryAlphabet())
#	p
#	# get the associated QMatrix object from p
#	m<-p$qMatrix
#	summary(m)
#	# get the associated process from m
#	m$process
#	# clone p
#	pp<-clone(p)
#	# assotiate m with pp
#	pp$qMatrix<-m
#	# assotiate pp with m
#	m$process<-pp
#	m$process
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setProcess", 
	class="QMatrix", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
		if(missing(value)){
			throw("No new value provided!\n");
		}
		else if (!is.Process(value)){
			throw("Process object invalid!\n");
		} 
		else {
			this$.process<-value;
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAlphabet
##	
###########################################################################/**
#
# @RdocMethod getAlphabet
# 
# @title "Get the Alphabet object associated with a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An Alphabet object.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# set the alphabet
#	setAlphabet(m,NucleotideAlphabet())
#	# get the alphabet
#	getAlphabet(m)
#	# set alphabet via virtual field
#	m$alphabet<-BinaryAlphabet()
#	summary(m)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAlphabet", 
	class="QMatrix", 
	function(
		this,
		...
	){

		this$.alphabet;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAlphabet
##	
###########################################################################/**
#
# @RdocMethod setAlphabet
# 
# @title "Set the Alphabet object for a QMatrix object" 
# 
# \description{ 
#	@get "title".
#
#	This method rebuilds the scaled and unscaled rate matrices and so sets all rates to NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
#	\item{value}{An Alphabet object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Alphabet object.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# set the alphabet
#	setAlphabet(m,NucleotideAlphabet())
#	# get the alphabet
#	getAlphabet(m)
#	# set alphabet via virtual field
#	m$alphabet<-BinaryAlphabet()
#	summary(m)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAlphabet", 
	class="QMatrix", 
	function(
		this,
		value,
		...
	){

	.checkWriteProtection(this);

	if(!exists(x="PSIM_FAST")){

	if(missing(value)){
		throw("No new value provided!\n");
	}
	else if(!is.Alphabet(value)) {
		throw("Alphabet object invalid!\n");
	}
	else if(is.Process(this$.process)){
		if(value != this$.process$alphabet){
		throw("The new alphabet should match with the one from the subsitution process!\n");
		}
	}
	if(is.matrix(this$.rate.matrix)){
			warning("Be aware that setting a new alphabet wipes out completely the rate matrix!\n");
	}
	
	}
	
	this$.alphabet<-value;
	.buildRateMatrix(this);
	return(this$.alphabet);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .nameToDim
##	
setMethodS3(
	".nameToDim", 
	class="QMatrix", 
	function(
		this,
		name,
		...
	){

		# split the name
		substitution<-rbind(strsplit(name,split="->",fixed=TRUE)[[1]]);
		if(length(substitution) != 2 ) {
			throw("Substitution event name was invalid!");
		}

		# Check if symbols are valid:
		if(!hasSymbols(this$.alphabet, substitution)){
				throw("All symbols must be in the alphabet!\n");
		}

		# Return a vector with the DIMNAMES:
		colnames(substitution)<-c("from","to");
		rownames(substitution)<-c("Substitution");
		substitution;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .nameToDimFast
##	
setMethodS3(
	".nameToDimFast", 
	class="QMatrix", 
	function(
		this,
		name,
		...
	){

		substitution<-rbind(strsplit(name,split="->",fixed=TRUE)[[1]]);
		colnames(substitution)<-c("from","to");
		rownames(substitution)<-c("Substitution");
		substitution;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .dimToName
##	
setMethodS3(
	".dimToName", 
	class="QMatrix", 
	function(
		this,
		dim,
		...
	){
		paste(dim,collapse="->");
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEventRate
##	
###########################################################################/**
#
# @RdocMethod getEventRate
# 
# @title "Get the unscaled rate of an event from a QMatrix object" 
# 
# \description{ 
#       @get "title".
#       
#       This method return the element corresponding to a given event from the scaled rate matrix stored in a QMatrix object.
#       The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#       event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	This method returns NA if the resacling of the rates was not performed.
#	The scaling is performed by the \code{rescaleQMatrix.GeneralSubstitution} method.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A QMatrix object.} 
#       \item{name}{The name of the event.}
#       \item{from}{The initial state.}
#       \item{to}{Target state.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A Numeric vector of length one.
# } 
# 
# \examples{
#       # create a QMatrix object
#       # provide an Alphabet object and the rates
#       m<-QMatrix(alphabet=BinaryAlphabet(), rate.list=list("0->1"=1,"1->0"=1))
#       # get the unscaled rate of "0->1" by name
#       getEventRate(m,"0->1")  # retruns NA
#       # get the unscaled rate of "0->1" by states
#       getEventRate(m,from="0",to="1")	# returns NA
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventRate", 
	class="QMatrix", 
	function(
		this,
		name=NA,
		from=NA,
		to=NA,
		...
	){

			# Event specified by name:
			if(!missing(name) & missing(from) & missing(to)){
				# convert to dimnames
				tmp<-.nameToDim(this, name);
				# Return the rate from the rescaled matrix: 
				return(this$.rate.matrix[tmp[1],tmp[2]]);
			}
			# Event specified by from= and to=
			else if(missing(name) & !missing(from) & !missing(to)){
				# Check symbols:
				if(!hasSymbols(this$.alphabet, c(from,to))){
					throw("All symbols must be in the alphabet!\n")
				}
				else{
					# Get the rate from the rescaled matrix:
					return(this$.rate.matrix[as.character(from),as.character(to)]);
				}
			}
			else {
				throw("The substitution should be specified by name or by the \"from\" and \"to\" arguments!\n");
			}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .getEventRateFast
##	
setMethodS3(
	".getEventRateFast", 
	class="QMatrix", 
	function(
		this,
		name=NA,
		...
	){
				# convert to dimnames
				tmp<-.nameToDimFast(this, name);
				# Return the rate from the rescaled matrix: 
				return(this$.rate.matrix[tmp[1],tmp[2]]);
	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRate
##	
###########################################################################/**
#
# @RdocMethod getRate
# 
# @title "Get an unscaled rate of an event from a QMatrix object" 
# 
# \description{ 
#       @get "title".
#       
#       This method gets the element corresponding to a given event form the \emph{unscaled} rate matrix.
#       a given event. The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#       event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A QMatrix object.} 
#       \item{name}{The name of the event.}
#       \item{from}{The initial state.}
#       \item{to}{Target state.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A Numeric vector of length one.
# } 
# 
# \examples{
#       # create a QMatrix object
#       # provide an Alphabet object and the rates
#       m<-QMatrix(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#       # get the unscaled rate of "0->1" by name
#       getRate(m,"0->1")       
#       # get the unscaled rate of "0->1" by states
#       getRate(m,from="0",to="1")
# } 
# 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRate", 
	class="QMatrix", 
	function(
		this,
		name=NA,
		from=NA,
		to=NA,
		...
	){

			# Event specified by name:
			if(!missing(name) & missing(from) & missing(to)){
				# Convert to dimnames:
				tmp<-.nameToDim(this, name);
				# return unscaled rate:
				return(this$.orig.matrix[tmp[1],tmp[2]]);
			}
			# Event specified by from= and to=:
			else if(missing(name) & !missing(from) & !missing(to)){
				# check symbols:
				if(!hasSymbols(this$.alphabet, c(from,to))){
					throw("All symbols must be in the alphabet!\n")
				}
				else{
				# return unscaled rate:
					return(this$.orig.matrix[as.character(from),as.character(to)]);
				}
			}
			else {
				throw("The substitution should be specified by name or by the \"from\" and \"to\" arguments!\n");
			}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: setRate
##	
###########################################################################/**
#
# @RdocMethod setRate
# 
# @title "Set an unscaled rate in a QMatrix object" 
# 
# \description{ 
#       @get "title".
#       
#       This method sets the element corresponding to a given event in the unscaled rate matrix.
#       The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#       event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A QMatrix object.} 
#       \item{name}{The name of the event.}
#       \item{value}{The new value of the rate.}
#       \item{from}{The initial state.}
#       \item{to}{Target state.}
#       \item{scale}{Call rate rescaling.}
#       \item{diag}{Calculate diagonal elements.}
#       \item{guess.equ}{Guess equilibrium distribution.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A Numeric vector of length one.
# } 
# 
# \examples{
#       # create a QMatrix object
#       # provide an Alphabet object and the rates
#       m<-QMatrix(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#       # set the unscaled rate by event name
#       setRate(m,"0->1",2)
#       # get the unscaled rate of "0->1" by name
#       getRate(m,"0->1")       
#       # set the unscaled rate by states
#       setRate(m,"0->1",0.5)
#       # set the unscaled rate of "0->1" by states
#       setRate(m,"0->1",0.5)
#       # get the unscaled rate of "0->1" by states
#       getRate(m,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRate", 
	class="QMatrix", 
	function(
		this,
		name=NA,
		value,
		from=NA,
		to=NA,
		scale=TRUE,
		diag=TRUE,
		guess.equ=TRUE,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){

		if (isEmpty(this$.alphabet)){
				throw("Alphabet is valid but empty, so no rates are defined!\n");
		}
		else if(missing(value)) {
			throw("No new value provided!\n");}
		else if(!is.numeric(value)) {
			throw("Rate must be numeric!\n");
		}
		else if (value < 0){
			throw("Cannot set negative rate!\n");
		}
	}
			
			.from<-character();		
			.to<-character();		
		
			# Event specified by name:		
			if(!missing(name) & missing(from) & missing(to)){
				# convert to dimnames:
				tmp<-.nameToDim(this, name);
				.from<-tmp[1];
				.to<-tmp[2];
				
			}
			# Event specified by from= and to=:
			else if(missing(name) & !missing(from) & !missing(to)){
				# check the symbols
				if(!hasSymbols(this$.alphabet, c(from,to))){
					throw("All symbols must be in the alphabet!\n")
				}
				else{
				.from<-as.character(from);
				.to<-as.character(to);
				}
			}
			else {
				throw("The substitution should be specified by name or by the \"from\" and \"to\" arguments!\n");
			}
				
				# Complain if tried to modify a diagonal element:
				if(.from == .to){
					throw("Modification of diagonal elements is not allowed!\n");
				}
				else {
				
					# Set the rate in the original rates matrix:	
			 		this$.orig.matrix[.from, .to]<-value;
			 		# Set the new diagonal element in the original rates matrix:
					if (diag == TRUE) {
			 			this$.orig.matrix[.from, .from]<-.calculateDiagonal(this, symbol=.from);
					}
					
					# Call rate rescaling, this will set the new values
					# in the rescaled rates matrix:
			 		if(scale==TRUE){
						.callRateRescaling(this,guess.equ);
			 		}
			}
		 return(invisible(value));


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateList
##	
###########################################################################/**
#
# @RdocMethod getRateList
# 
# @title "Get a list of events and their unscaled rates from a QMatrix object" 
# 
# \description{ 
#       @get "title".
#
#       This method returns the list of event rates from the \emph{unscaled} rate matrix. 
#       The returned list contains the rates associated with the corresponding event names.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A GeneralSubstitution object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       A list of event rates.
# } 
# 
# \examples{
#       # create a GeneralSubstitution object
#       # provide an Alphabet object and the rates
#       p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the QMatrix object from p
#	m<-p$QMatrix
#       # get the event rates from the unscaled Q matrix
#       getRateList(m)
#       # get rates from the unscaled rate matrix via virtual field
#       m$rateList
#       # set rates in the unscaled rate matrix
#       setRateList(m, list("0->1"=1,"1->0"=1))
#       m$rateList
#       # set rates in the unscaled rate matrix via virtual field
#       m$rateList<-list("0->1"=3,"1->0"=1);
#	m$rateList
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateList", 
	class="QMatrix", 
	function(
		this,
		...
	){
		# Be gentle and return an empty list if the
		# alphabet is empty:
		if( isEmpty(this$.alphabet) ){
				return(list());	
		}
		else {
				# Fill in the rates list:
				rates<-list();
				for(i in this$.alphabet$symbols){
					for(j in this$.alphabet$symbols){
						if(i != j){
							name<-paste(i,j,sep="->");
							rate<-getRate(this, from=i, to=j);
							rates[[name]]<-rate;
						}
					}
				}
				return(rates);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateList
##	
###########################################################################/**
#
# @RdocMethod	setRateList
# 
# @title "Setting the unscaled rates stored in a QMatrix object" 
# 
# \description{ 
#       @get "title".
#       
#       This method set the rates in the \emph{unscaled} Q  matrix based on the provided list containing even names
#       and the associated rates. The rate must be specified for every event!
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A QMatrix object.} 
#       \item{value}{A list with the events names and the associated rates.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       The QMatrix object (invisible).
# } 
# 
# \examples{
#       # create a GeneralSubstitution object
#       # provide an Alphabet object and the rates
#       p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the QMatrix object from p
#	m<-p$QMatrix
#       # get the event rates from the unscaled Q matrix
#       getRateList(m)
#       # get rates from the unscaled rate matrix via virtual field
#       m$rateList
#       # set rates in the unscaled rate matrix
#       setRateList(m, list("0->1"=1,"1->0"=1))
#       m$rateList
#       # set rates in the unscaled rate matrix via virtual field
#       m$rateList<-list("0->1"=3,"1->0"=1);
#	m$rateList
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateList", 
	class="QMatrix", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
		if(!is.Alphabet(this$.alphabet)){
			throw("Cannot set rates because alphabet is undefined!\n");
		}
		if(missing(value)) {
			throw("No new value provided!\n");}
		else if(!is.list(value)) {
			throw("The new value must be a list!\n");
		} else {

			# Check if all of the rates are specified!
			expected<-.genExpected(this);
	
			# Check for missing rates:		
			if(length(tmp<-setdiff(expected,names(value))) != 0 ){
					throw("The rate matrix is not specified correctly, the following rates are missing: ",paste(tmp,collapse=" "),"!\n");
			}

			# Warn the user about the superfluous rates:
			if(length(tmp<-setdiff(names(value),expected)) != 0 ){
					warning("The following rates were not expected by this process: ",paste(tmp,collapse=" "),", so they were ignored!\n");
					# Getting rid of unexpected rates:
					value[tmp]<-NULL;
			}

				# set the rate matrix if all is OK!
				for (name in names(value)){
					setRate(this,name=name,value=(value[[name]]),scale=FALSE,diag=FALSE);
				}

				# Set diagonal elements:
				for (sym in this$alphabet$symbols){
					this$.orig.matrix[sym, sym]<-.calculateDiagonal(this, sym);
				}
	
				# Call the parent process object to guess the new equlibrium distribution and rescale
				# rates:
				.callRateRescaling(this);

		}
		return(invisible(this))


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .genExpected
##	
setMethodS3(
	".genExpected", 
	class="QMatrix", 
	function(
		this,
		...
	){

      expected<-list();
      sym<-this$alphabet$symbols;

      # Cretae the list of expected rates:
      for(i in sym){
        for(j in sym){
          if(i != j){
          expected<-c(expected,paste(i,j,sep="->"));
          }
        }
      }
			return(expected);
		

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .calculateDiagonal
##	
setMethodS3(
	".calculateDiagonal", 
	class="QMatrix", 
	function(
		this,
		symbol=NA,
		...
	){

		if(!missing(symbol)){
			# convert diname to dim:
			index<-.symToIndex(this, symbol=symbol);
		}
		else {
			throw("Symbol not specified!\n");
		}
			# Return -1 * sum of the off-diagonal elements
			# from the row specified by the index:
			return(-sum((this$.orig.matrix[symbol,])[-index] ));
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .symToIndex
##	
setMethodS3(
	".symToIndex", 
	class="QMatrix", 
	function(
		this,
		symbol=NA,
		...
	){

		if(exists(x="PSIM_FAST")){
			return(which(rownames(this$.orig.matrix) == symbol));
		}

		if(missing(symbol)){
			throw("No symbol specified");
		} else {
			index<-which(rownames(this$.orig.matrix) == symbol);
			if(length(index) == 0){
				print(symbol);
				throw("Symbol not in rate matrix!\n");
			}
			else if (length(index) > 1){
				throw("Rate matrix is inconsistent!\n");
			}
			return(index);
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getMatrix
##	
###########################################################################/**
#
# @RdocMethod	getMatrix
# 
# @title "Get the unscaled rate matrix form a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix object.
# } 
# 
# \examples{
#       # create a GeneralSubstitution object
#       # provide an Alphabet object and the rates
#       p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the QMatrix object from p
#	m<-p$QMatrix
#	# get the unscaled rate matrix from m
#	m$matrix
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getMatrix", 
	class="QMatrix", 
	function(
		this,
		...
	){

		this$.orig.matrix;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setMatrix
##	
###########################################################################/**
#
# @RdocMethod setMatrix
#
# @title "Forbidden action: setting the unscaled rate matrix for a QMatrix object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setMatrix", 
	class="QMatrix", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getScaledMatrix
##	
###########################################################################/**
#
# @RdocMethod	getScaledMatrix
# 
# @title "Get the scaled rate matrix form a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A matrix object.
# } 
# 
# \examples{
#       # create a GeneralSubstitution object
#       # provide an Alphabet object and the rates
#       p<-GeneralSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the QMatrix object from p
#	m<-p$QMatrix
#	# get the scaled rate matrix from m
#	m$scaledMatrix
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getScaledMatrix", 
	class="QMatrix", 
	function(
		this,
		...
	){

		this$.rate.matrix;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setScaledMatrix
##	
###########################################################################/**
#
# @RdocMethod setScaledMatrix
#
# @title "Forbidden action: setting the scaled rate matrix for a QMatrix object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setScaledMatrix", 
	class="QMatrix", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: Scale
##	
###########################################################################/**
#
# @RdocMethod Scale
# 
# @title "Scale the scaled rate matrix stored in a QMatrix object by the provided factor" 
# 
# \description{ 
#	@get "title".
#
#	This methods sets the scaled rate matrix to \code{unscaled_matrix * constant}.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
#	\item{constant}{The scaling factor (a numeric vector of length one).}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The QMatrix object (invisible).
# } 
# 
# \examples{
#	# create a QMatrix object
#	# , provide Alphabet object and rates
#	m<-QMatrix(name="Susie Q", alphabet=BinaryAlphabet(), rate.list=list("1->0"=2,"0->1"=3))
#	# get object summary
#	summary(m)
#	# perform scaling
#	Scale(m, 1/0.666)
#	# get object summary
#	summary(m)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"Scale", 
	class="QMatrix", 
	function(
		this,
		constant=NA,
		...
	){

	if(!exists(x="PSIM_FAST")){

		if(missing(constant)){
			throw("No scaling constant specified!\n");
		}
		if(!is.numeric(constant)){
			throw("Scaling constant must be numeric!\n");
		}
	}
			 
			 # Set the rescaled matrix to the original matrix
			 # multiplied by the given constant:
			 this$.rate.matrix<-(this$.orig.matrix * constant);
			 # store the current rescaling constant:
			 this$.norm.const<-constant;
			 return(invisible(this));
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: as.character
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Return the character representation of a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# get the character representation
#	as.character(m)
#	# the same, but implicitly
#	m
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="QMatrix", 
	function(
		x,
		...
	){
		
		x$id

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: print
##	
###########################################################################/**
#
# @RdocMethod print
# 
# @title "Print the character representation of a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The character representation of the QMatrix object.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# print the character representation
#	print(m)
#	# the same, but implicitly
#	m
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"print", 
	class="QMatrix", 
	function(
		x,
		...
	){

		print.default(x$.orig.matrix);

	},
	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<-QMatrix(alphabet=BinaryAlphabet(), rate.list=list("0->1"=1,"1->0"=3))
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="QMatrix", 
	function(
		object,
		...
	){

		this<-object;
		this$.summary$"Name"<-this$name;
		this$.summary$"Id"<-this$id;
		this$.summary$"Attached to process"<-this$process;
	  this$.summary$"Unscaled rate matrix"<-paste( "\n\n\t",paste(capture.output(print(this$.orig.matrix)),collapse="\n\t"),"\n",sep="");
		this$.summary$"Scaling factor"<-this$.norm.const;
	  this$.summary$"Scaled rate matrix"<-paste( "\n\n\t",paste(capture.output(print(this$.rate.matrix)),collapse="\n\t"),"\n",sep="");
	
		
		NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## setId
##
###########################################################################/**
#
# @RdocMethod setId
#
# @title "Forbidden action: setting the unique identifier for a QMatrix object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
  "setId",
  class="QMatrix",
  function(
    this,
    value,
    ...
  ){

  throw("Id is generated automatically and it cannot be set!\n");

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getId
##
###########################################################################/**
#
# @RdocMethod	getId
# 
# @title "Get the unique identifier of a QMatrix object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A QMatrix object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a QMatrix object
#	m<-QMatrix()
#	# get object id
#	getId(m)
#	# get object id via virtual field
#	m$id
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getId",
  class="QMatrix",
  function(
    this,
    ...
  ){

  this.class<-class(this)[1];
  id<-paste(this.class,this$.name,hashCode(this),sep=":");

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: getWriteProtected
##
###########################################################################/**
#
# @RdocMethod getWriteProtected
#  
# @title "Check if the object is write protected" 
# 
# \description{ 
#       @get "title".
#
#	QMatrix object do not have a write protection flag of their own, but they use the one from the 
#	associated Process object.
#       Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A QMatrix object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       TRUE or FALSE
# } 
# 
# 
# @author 
# 
# \seealso{ 
#       getWriteProtected.Process
# } 
# 
#*/###########################################################################
setMethodS3(
  "getWriteProtected",
  class="QMatrix",
  function(
    this,
    ...
  ){

	# return false if no process is attached:
	if(!is.Process(this$.process)) {
			return(FALSE);
	}
	else {
			# The flag from the parent process is used!
			return(getWriteProtected(this$.process));
	}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: is.QMatrix
##
###########################################################################/**
#
# @RdocDefault is.QMatrix
# 
# @title "Check if an object is an instance of the QMatrix class" 
# 
# \description{ 
#       @get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{An object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       TRUE or FALSE.
# } 
# 
# \examples{
#       # create some objects
#       m<-QMatrix()
#       p<-Process()
#       # chek if they inherit from QMatrix
#       is.GeneralSubstitution(m)
#       is.GeneralSubstitution(p)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass
# } 
# 
#*/###########################################################################
setMethodS3(
  "is.QMatrix",
  class="default",
  function(
    this,
    ...
  ){

    if(!is.PSRoot(this)) {return(FALSE)}
    if(!is.null(this$.is.process)){return(TRUE)}
    if ( inherits(this, "QMatrix")) {
      this$.is.q.matrix<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: setWriteProtected
##
###########################################################################/**
#
# @RdocMethod setWriteProtected
#  
# @title "Set the write protection field for a QMatrix object" 
# 
# \description{ 
#       @get "title".
#
#	QMatrix object do not have a write protection flag of their own, but they use the one from the 
#	associated Process object.
#       Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{A QMatrix object.} 
#	\item{value}{A logical vector of size one.}
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       TRUE or FALSE
# } 
# 
# 
# @author 
# 
# \seealso{ 
#       setWriteProtected.Process
# } 
# 
#*/###########################################################################
setMethodS3(
  "setWriteProtected",
  class="QMatrix",
  function(
    this,
		value,
    ...
  ){

		throw("The QMatrix objects use the write protection flags of the enclosing substitution process, modify that (if exists)!\n");

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkWriteProtection
##
setMethodS3(
  ".checkWriteProtection",
  class="QMatrix",
  function(
    this,
    ...
  ){

   if(!exists(x="PSIM_FAST")){
	return(FALSE);
   }
   
 	if(this$writeProtected) {throw("Cannot set value because the object is write protected!\n")}
    	else {return(FALSE)}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Copyright 2009 Botond Sipos	
## See the file ../COPYING for licensing issues.	
##	
##########################################################################/** 
#
# @RdocClass Sequence
# 
# @title "The Sequence class"
# 
# \description{ 
#	
#	This is the class representing a sequence. The backbone of the Sequence objects are
#	lists aggregating Site objects. The class has fields for keeping track of cumulative
#	site rates, the sum of all active event rates and methods for performing actions 
#	on a collection of sites (positions).
#
#	The Sequence objects have a field specifying an ancestral object, which can be a Sequence
#	object (when the object is obtained through clone() ) or the "Root insertion process" object 
#	(for newly created objects).
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
#	\item{name}{The name of the Sequence object.}
# 	\item{string}{A string containing symbols belonging to the associated Alphabet object. 
#	It can be used to set the initial states of the aggregated Site objects. It also specifies the length of the sequence}
# 	\item{length}{The length of the sequence. It cannot be used when 'string' is specified.}
# 	\item{alphabets}{A list of Alphabet objects to be associated with the Site objects. 
#	The list is recycled in the case it is shorter than the sequence length.}
# 	\item{processes}{A list of lists of Process objects to be attached 
#	(recycled if shorter than sequence length). }
# 	\item{ancestral.obj}{The ancestral object (Sequence or Process).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
#	# create a sequence object by
#	# providng alphabets, processes and states
#	s.one<-Sequence(
#		name="Seq",
#		string="AATTGGCCTTAAGGCCTTAA",
#		alphabets=list(NucleotideAlphabet()),
#		processes=list(list(JC69()))
#	)
#	s.one
#	# check if inherits from Sequence
#	is.Sequence(s.one)
#	# get object summary
#	summary(s.one)
#	# create a sequence object,
#	# specifying length, alphabets
#	# and ancestral object
#	s<-Sequence(
#		name="Seq",
#		length=20,
#		ancestral.obj=s.one
#	)
#	# get sequence string
#	s$string
#	# get the list of site objects
#	s$sites
#	# get object id
#	s$id
#	# set and get name
#	s$name<-"SeqSeq"
#	s$seq
#	# get length
#	s$length
#	# get and set ancestral object
#	s$ancestral
#	s$ancestral<-Sequence();
#	# set alphabets
#	setAlphabets(s,list(NucleotideAlphabet()))
#	# set states
#	# "A"-s in the range 1:10
#	setStates(s,"A",1:10)
#	# a pattern of "ATGC"-s in the range 11:20
#	setStates(s,c("A","T","G","C"),11:20)
#	# get states from range 10:12
#	getStates(s,10:12)
#	# attach a JC69 process to range 1:10
#	jc69<-JC69()
#	attachProcess(s,jc69,1:10)
#	# set the rate multiplier site-process specific parameter for jc69
#	setParameterAtSites(s,jc69,"rate.multiplier",2,1:10)
#	# get "rate.multiplier" for jc69 from range 1:2
#	getParameterAtSites(s, jc69, "rate.multiplier",1:2)
#	# attach a GTR process to range 11:20
#	gtr<-GTR()
#	attachProcess(s,gtr,11:20)
#	# set and get rate multipliers for gtr
#	setRateMultipliers(s, gtr, c(0,5,1), 11:20)
#	getRateMultipliers(s, gtr, 11:20)
#	# get processes from range 1:5
#	getProcesses(s,1:5)
#	# replace the processes with a (GTR, JC69), JC69 pattern
#	s$processes<-list(list(GTR(), JC69()), list(JC69()))
#	# get processes from range 1:2
#	getProcesses(s,1:2)
#	# get unique processes
#	s$uniqueProcesses
#	# get unique alphabets
#	s$uniqueAlphabets
#	# get symbol frequencies
#	getSymbolFreqs(s)
#	# get the big rate
#	s$bigRate
#	# get a vector of total rates from range 1:4
#	getTotalRatesFromRange(s,1:4)
#	# get a vector of cumulative rates from range 1:4
#	getCumulativeRatesFromRange(s,1:4)
#	# reset all site states	
#	clearStates(s)
#	s
#	# sample states from the equilibrium distributions
#	# of the attached substitution processes
#	sampleStates(s)
#	s	
#	# clone s
#	s.clone<-clone(s)
#	# insert a sequence in s.clone after position 2
#	insertSequence(s.clone,NucleotideSequence(string="AAAAAA"),2)
#	s.clone
#	# delete positions 1,2,3 and 10
#	deleteSubSequence(s.clone, c(1:3,10))
#	s.clone
#	# copy positions 7:10 into a new sequence object
#	sc<-copySubSequence(s.clone, 7:10)
#	sc
#	# get events from sc in the range 1:2
#	getEvents(sc,1:2)
# }
# 
# @author
#
# \seealso{ 
# 	Alphabet Site Process Event
# }
# 
#*/###########################################################################
setConstructorS3(
	"Sequence",
	function(
		name=NA,
		string=NA,
		length=NA,
		alphabets=NA,
		processes=NA,
		ancestral.obj=NA,
		...
	){

		# Marking the instance as static by default:	
		STATIC<-TRUE;	

		# Extending the PSRoot class:
		this<-extend(
			PSRoot(),
			"Sequence",
			.name="Anonymous",
			.length=NA,
			.sites=list(),
			.ancestral.obj=NA,
			.cumulative.rates=NA,
			.total.rates=NA,
			.cumulative.rate.flag=TRUE,
			.flagged.sites=integer(0),
			.write.protected=FALSE,
			.is.sequence=TRUE,
			.root.ins=NA
		);

		# Initializing the variables for length and states:
		len<-0;
		str<-list();

		# Optional argument: name
		if(!missing(name)) {
			this$name<-name;
			STATIC<-FALSE;
		}
		
		# The user can specify a sequence
		# or the sequence length, but not both.		
		if (!missing(string) & !missing(length)) {
			throw("You can specify the sequence, or the sequence length, but not both!\n");}
		else if (!missing(string)){
			STATIC<-FALSE;
			# An alphabet list must be specified along the sequence! 
			if(missing(alphabets)) {throw("A list of valid alphabets must be specified when a string is given!\n");}
		}

		# Deal with the string or length argument:
		if (!missing(length)) {
			STATIC<-FALSE;
			len<-length;
		}
		else if( !missing(string) ) {
					str<-strsplit(string,split="",fixed=TRUE)[[1]];
					len<-length(str);
		}
		this$.length<-len;

		root.ins<-NA;
		if (!is.Process(Sequence$.root.ins)) {
			# Dummy proces used as ancestral object for sites.
			this$.root.ins<-Process(name="Root insertion process");
			this$.root.ins$comments<-"This is just a dummy process object serving as ancestral for newly created site and sequence objects.";
			root.ins<-this$.root.ins;
		} else {
			root.ins<-Sequence$.root.ins
		}

		# Site template object:
			 site.template<-Site(
            			ancestral=root.ins,
            			sequence=this
          	);	
	

		# Clone and store the site objects:
		if(!STATIC) {
			if ( len > 0 ) {
				for(position in 1:len) {
					 this$.sites[[position]]<-clone.Object(site.template);
				}
			}

		}	
		
		# Optional argument: ancestral object
		if (!missing(ancestral.obj)) {
			STATIC<-FALSE;
			this$ancestral<-ancestral.obj;
		} else {
			this$ancestral<-root.ins;
		}

		# Setting the alphabets:
		if(!missing(alphabets)) {
			STATIC<-FALSE;
			# setAlphabets will check the arguments
			setAlphabets(this, alphabets);
		}
	
		# Setting the processes:
		if (!missing(processes)) {
			STATIC<-FALSE;
			# setProcesses will take care about the arguments
			# and deal with alphabet mismatch.
			setProcesses(this,processes)	
		}

			# Initializing these vectors properly is
			# importtant for the insertion method!
			this$.total.rates<-double(len);
			this$.cumulative.rates<-double(len);

		if(!STATIC){

			# Now we are prepared to set the states:	
			if (!missing(string)) {
				setStates(this, str);
			}

			# Calculate cumulative rates for the first time, but only if
			# states are defined. This is expensive, as total rates are calculated.
			if (!missing(string) & (length(str) > 0) ) {
				.recalculateCumulativeRates(this);
			}

		}

		return(this);
	},
	enforceRCC=TRUE
);

##	
## Method: is.Sequence
##	
###########################################################################/**
#
# @RdocDefault is.Sequence
# 
# @title "Check whether an object inherits from the Sequence class" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#	# create some objects
#	seq<-Sequence(length=10)
#	a<-Alphabet()
#	# check if they inherit from Sequence
#	is.Sequence(seq)
#	is.Sequence(a)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"is.Sequence", 
	class="default", 
	function(
		this,
		...
	){

		if(!is.PSRoot(this)) {return(FALSE)}
   	if(!is.null(this$.is.sequence)){return(TRUE)}
    if ( inherits(this, "Sequence")) {
      this$.is.sequence<-TRUE;
      return(TRUE);
    } else {
      return(FALSE)
    }

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: checkConsistency
##	
###########################################################################/**
#
# @RdocMethod	checkConsistency
# 
# @title "Check object consistency"
# 
# \description{ 
#		@get "title".
# } 
# 
# @synopsis 
#
# \arguments{ 
#       \item{this}{An object.} 
#       \item{omit.sites}{Do not check aggregated site objects.} 
#       \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="Sequence", 
	function(
		this,
		omit.sites=FALSE,
		...
	){

		if(this$length != length(this$.sites)) {
			throw("Sequence length inconsistency detected");
		} else if (length(this$.cumulative.rates) != this$.length) {
			throw("Cumulative rates vector length mismatch!\n");
		} else if (length(this$.total.rates) != this$.length) {
			throw("Total rates vector length mismatch!\n");
		} else if (!identical(this$.cumulative.rates, cumsum(this$.total.rates))) {
			throw("Cumulative rates vector is not consistent with total rates vector!\n");
		}

		if(!is.numeric(this$.flagged.sites)) {
			throw("Flagged sites vector is not numeric!\n");
		} else if (length(this$.flagged.sites) > 0) {
			if ( (min(this$.flagged.sites) < 1) | ( max(this$.flagged.sites) > this$.length) ) {
				throw("Inconsistency in the flagged sites vector!\n");
			}	
		}

		if(!is.character(this$.name)) {
			throw("Sequence name is invalid!\n");
		} else if(stringLength(this$.name) == 0) {
			throw("Sequence name is of length zero!\n");
		}

		if(!is.Sequence(this$.ancestral.obj) & !is.Process(this$.ancestral.obj)) {
			throw("The ancestral object is invalid!\n");
		}
		if(!is.logical(this$.cumulative.rate.flag)) {
			throw("Cumulative rate flag is not logical!\n");
		}

		# Calling consistency check on sites.
		# This will be painfully slow!
		if(!omit.sites){
			for(site in this$.sites){
				checkConsistency(site);
			}
		}
		return(invisible(TRUE));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: getId
##
###########################################################################/**
#
# @RdocMethod getId
# 
# @title "Get the unique identifier of a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The identifier is the concatenation of the object name and the object hash code as returned
#	by hashCode().
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A charcter vector of length one.
# } 
# 
# \examples{
#	# create a Sequence object.
#	s<-Sequence(length=5)
#	# get id
#	getId(s)
#	# get id via virtual field
#	s$id
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getId",
  class="Sequence",
  function(
    this,
    ...
  ){

  this.class<-class(this)[1];
  id<-paste(this.class,this$.name,hashCode(this),sep=":");

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setId
##	
###########################################################################/**
#
# @RdocMethod setId
#
# @title "Forbidden action: setting the unique identifier of a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setId", 
	class="Sequence", 
	function(
		this,
	  	value,	
		...
	){

	throw("Id is generated automatically and it cannot be set!\n");

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getName
##	
###########################################################################/**
#
# @RdocMethod getName
# 
# @title "Get the name of a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create object
#	s<-Sequence(length=10);
#	# get object name
#	getName(s)
#	# get name via virtual field
#	s$name
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getName", 
	class="Sequence", 
	function(
		this,
		...
	){

		this$.name;
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setName
##	
###########################################################################/**
#
# @RdocMethod setName
# 
# @title "Set the name of a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{new.name}{A character vector of length one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new object name (invisible).
# } 
# 
# \examples{
#	# create a Sequence object
#	s<-Sequence(name="MySeq",length=4)
#	# get sequence name
#	s$name
#	# rename object
#	setName(s,"SO")
#	s$name
#	# rename via virtual field
#	s$name<-"SeqSeq"
#	s$name
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setName", 
	class="Sequence", 
	function(
		this,
		new.name,
		...
	){
		
		.checkWriteProtection(this);	
		this$.name<-as.character(new.name);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getString
##	
###########################################################################/**
#
# @RdocMethod getString
# 
# @title "Get the string representation of a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The string representation is the concatenation of the states of the 
#	aggregated Site object. Undefined states (NA-s) are represented by question marks.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create object
#	s<-Sequence(length=10)
#	# get character representation
#	getString(s)	# a bunch of '?'-s
#	# get string reperesentation via virtual field
#	s$string
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getString", 
	class="Sequence", 
	function(
		this,
		...
	){
			str<-character();
			for(site in this$.sites){
					if(is.na(site$.state)){
							if(is.Alphabet(site$.alphabet)){
								str<-c(str,rep("?",site$.alphabet$.symbolLength));
							}
							else {
								str<-c(str,"?");
							}
					}
					else {
						str<-c(str,site$.state);
					}
			}
			return(paste(str,collapse=""));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setString
##	
###########################################################################/**
#
# @RdocMethod setString
#
# @title "Forbidden action: setting the string representation of a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setString", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getLength
##	
###########################################################################/**
#
# @RdocMethod getLength
# 
# @title "Get the number of Site objects aggregated in a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An integer vector of length one.
# } 
# 
# \examples{
#	# create a Sequence object
#	s<-Sequence(length=5)
#	# get sequence length
#	getLength(s)
#	# get length via virtual field
#	s$length
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getLength", 
	class="Sequence", 
	function(
		this,
		...
	){

		this$.length;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setLength
##	
###########################################################################/**
#
# @RdocMethod setLength
#
# @title "Forbidden action: setting the length of a Sequence object"
#
# \description{
#       @get "title".
#	The length of the Sequence objects can be specified when the object is constructed,
#	or modified later by the "insertSequence" and "deleteSubSequence" methods. 
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################

setMethodS3(
	"setLength", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSites
##	
###########################################################################/**
#
# @RdocMethod getSites
# 
# @title "Get the list of the Site object aggregated in a Sequence object" 
# 
# \description{ 
#	@get "title".
#	Warning: there is no setSites method!
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Site objects.
# } 
# 
# \examples{
#	# create a sequence object
#	s<-Sequence(alphabets=list(NucleotideAlphabet()),string="AATTGCCC")
#	# get the list of aggregated Site objects
#	getSites(s)
#	# get Site objects via virtual field
#	s$sites
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSites", 
	class="Sequence", 
	function(
		this,
		...
	){
	
		this$.sites;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getStates
##	
###########################################################################/**
#
# @RdocMethod getStates
# 
# @title "Get the states of a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{index}{An integer vector specifying a set of positions. 
#	It is set to 1:seq$length if omitted.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector.
# } 
# 
# \examples{
#	# create a sequence object
#	s<-Sequence(alphabets=list(NucleotideAlphabet()),string="AATTGCCCCCTTGG")
#	# get all Site states
#	getStates(s)
#	# get the states for a collection of sites
#	getStates(s,c(1:3,5,8))
#	# get states via virtual field
#	s$states
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getStates", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){

		 if (missing(index)) {
      index<-seq(along.with=this$.sites);
    } else {
			index<-.checkIndexSanity(this, index);
		}
    lapply(
      this$.sites[index],
      function(site) {
          site$.state;
      }
    );

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setStates
##	
###########################################################################/**
#
# @RdocMethod setStates
# 
# @title "Set the states for a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The value vector is recycled, which is useful when creating repeated patterns.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{value}{A character vector containg the states (recycled if shorter than the index vector). The states must be compatible with the corresponding Alphabet object.}
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a sequence object of length 10
#	s<-Sequence(alphabets=list(NucleotideAlphabet()),length=10)
#	# set the states in some ranges
#	setStates(s,c("A","T","A"),index=1:5)
#	setStates(s,c("G","C"),index=6:10)
#	# display sequence
#	s
#	# set the states for the whole Sequence object
#	setStates(s,c("A","T","T","A"))
#	s
#	# set states via virtual field
#	s$states<-c("A","T")
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setStates", 
	class="Sequence", 
	function(
		this,
		value,
		index,
		...
	){

		.checkWriteProtection(this);	
		if(missing(value)) {
			throw("No new values specified!\n");
		}
	  else if (missing(index)) {
      index<-seq(along.with=this$.sites);
    } else {
			index<-.checkIndexSanity(this, index);
		}
		# Recycling value vector by using rep().
    if (length(value) < length(this$.sites) ) {
        value<-rep(as.character(value),length.out=length(index))
    }
		
    for (i in 1:length(index)) {
        this$.sites[[ index[[i]] ]]$state<-value[i];
    }
		# Flagging the changed sites:
		this$.cumulative.rate.flag<-TRUE;
		this$.flagged.sites<-c(this$.flagged.sites, index);
		.recalculateCumulativeRates(this);

    invisible(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAlphabets
##	
###########################################################################/**
#
# @RdocMethod getAlphabets
# 
# @title "Get the list of the Alphabet objects attached to the Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Alphabet objects.
# } 
# 
# \examples{
#	# create a Sequence object with NucleotideAlphabet
#	#and BinaryAlphabet objects attached
#	s<-Sequence(alphabets=list(NucleotideAlphabet(),BinaryAlphabet()),length=5)	
#	setStates(s,c("A","0"))
#	# get the list of attached Alphabet objects
#	getAlphabets(s)
#	# get Alphabets from a range
#	getAlphabets(s,c(2:3,5))
#	# get alphabets via virtual field
#	s$alphabets
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAlphabets", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){
	
 		if (missing(index)) {
      index<-seq(along.with=this$.sites);
    } else {
			index<-.checkIndexSanity(this, index);
		}
    lapply(
      this$.sites[index],
      function(site) {
          site$alphabet;
      }
    );	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAlphabets
##	
###########################################################################/**
#
# @RdocMethod setAlphabets
# 
# @title "Assotiate Alphabet objects to a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{value}{A list of Alphabet objects, recycled if shorter than the index vector.} 
# 	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a Sequence object
#	s<-Sequence(length=10)	
#	# set the alphabets for range 1:5
#	setAlphabets(s,list(NucleotideAlphabet(),BinaryAlphabet()),1:5)
#	# set the alphabets for range 6:10	
#	setAlphabets(s,list(AminoAcidAlphabet()),6:10)
#	# get the list of attached Alphabet objects
#	getAlphabets(s)
#	# get Alphabets from a range
#	getAlphabets(s,c(2:3,5))
#	# set alphabets via virtual field
#	s$alphabets<-list(BinaryAlphabet(),NucleotideAlphabet())
#	# get alphabets via virtual field
#	s$alphabets
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAlphabets", 
	class="Sequence", 
	function(
		this,
		value,
		index,
		...
	){

		.checkWriteProtection(this);	
		if(missing(value)) {
			throw("No new values specified!\n");
		}
		if(!is.list(value)) {
			throw("The value parameter must be a list!\n");
		} else {
				for(a in value) {
					if(!is.Alphabet(a)) {
						throw("The value parameter must be a list of valid alphabet objects!\n");
					}
				}
		}

	  if (missing(index)) {
      index<-seq(along.with=this$.sites);
    } else {
			index<-.checkIndexSanity(this, index);	
		}

		# Recycling value vector. rep() cannot be used here,
		# because we loose the object references!

    value.counter<-1;
    for (i in index)  {
        if(value.counter > length(value)) {
          value.counter<-1;
        }
	setAlphabet(this$.sites[[i]], value[[value.counter]]);

        value.counter<-(value.counter + 1);
    }
    invisible(this);
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getUniqueAlphabets
##	
###########################################################################/**
#
# @RdocMethod getUniqueAlphabets
# 
# @title "Get the list of unique Alphabet objects associated to Site objects aggaregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The returned list contains unique instances of the Alphabet class. The symbol sets are not compared, so
#	two instances of the same class are considered to be different.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Alphabet objects.
# } 
# 
# \examples{
#	# create a Sequence object with some Alphabet objects attached
#	s<-Sequence(
#               alphabets=list(NucleotideAlphabet(),
#               BinaryAlphabet(),
#               NucleotideAlphabet()),
#               length=10
#               )	
#	# get the list of attached alphabets
#	s$alphabets
#	# get the unique list of attahced Alphabet objects
#	getUniqueAlphabets(s)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getUniqueAlphabets",
	class="Sequence", 
	function(
		this,
		...
	){
	
	tmp<-list();			
    	lapply(
      	this$.sites,
      	function(site) {
		tmp<<-c(tmp,list(site$.alphabet))
      	}
	);
	return(unique(tmp));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setUniqueAlphabets
##	
###########################################################################/**
#
# @RdocMethod setUniqueAlphabets
#
# @title "Forbidden action: setting the list of unique Alphabet objects attached to the Site object aggregated by a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setUniqueAlphabets", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: attachProcess
##	
###########################################################################/**
#
# @RdocMethod attachProcess
# 
# @title "Attach a Process object to a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.}
# 	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a Sequence object of length 6
#	s<-Sequence(length=10,alphabets=list(NucleotideAlphabet()))
#	# attach a JC69 substitution process 
#	attachProcess(s,JC69())
#	# get the list of attached processes 
#	s$processes
#	# attach the GTR substitution process to range 3:6
#	attachProcess(s,GTR(),3:6)
#	# get the list of attached processes 
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"attachProcess", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){

		.checkWriteProtection(this);	
	 if(!exists(x="PSIM_FAST")){
		if(!is.Process(process)){
			throw("Process object invalid!\n");
		}
	 }
 		if (missing(index)) {
      		index<-seq(along.with=this$.sites);
    		} else {
			index<-.checkIndexSanity(this, index);	
		}

		for(i in index){
				attachProcess(this$.sites[[i]],process);
		}
		return(invisible(this));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: detachProcess
##	
###########################################################################/**
#
# @RdocMethod detachProcess
# 
# @title "Detach a Process object from a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
# 	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a sequence object with two processes attached
#	p<-JC69()
#	s<-Sequence(length=4,alphabets=list(NucleotideAlphabet()),processes=list(list(p,K80())))
#	# get the list of attached processes
#	s$processes
#	# detach JC69 from range c(1,4)
#	detachProcess(s,p,c(1,4))
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"detachProcess", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){

		.checkWriteProtection(this);	
	 if(!exists(x="PSIM_FAST")){
		if(!is.Process(process)){
			throw("Process object invalid!\n");
		}
	}
 		if (missing(index)) {
      		index<-seq(along.with=this$.sites);
    		} else {
			index<-.checkIndexSanity(this, index);
		}
		lapply(
      		this$.sites[index],
      		function(site) {
        	detachProcess(site,process);
      }
    );	
		return(invisible(this));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getProcesses
##	
###########################################################################/**
#
# @RdocMethod getProcesses
# 
# @title "Get the Process objects attached to the Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of lists of Process objects.
# } 
# 
# \examples{
#	# create a sequence object with some processes attached
#	s<-Sequence(
#               length=4,
#               alphabets=list(NucleotideAlphabet()),
#               processes=list(list(JC69(),K80()),list(GTR()))
#               )
#	# get the list of lists of attached processes from positions 1 and 3
#	getProcesses(s,c(1,3))
#	# get processes via virtual field
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getProcesses", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){
	
 	if (missing(index)) {
      	index<-seq(along.with=this$.sites);
    	} else {
			index<-.checkIndexSanity(this, index);
		}

    	lapply(
      	this$.sites[index],
      	function(site) {
        site$processes;
      }
    );	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getUniqueProcesses
##	
###########################################################################/**
#
# @RdocMethod getUniqueProcesses
# 
# @title "Get the list of unique Process instances attached to the Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Process objects.
# } 
# 
# \examples{
#	# create a sequence object and attach processes
#	p<-JC69()
#	s<-Sequence(
#               length=4,
#               alphabets=list(NucleotideAlphabet()),
#               processes=list(list(p,K80()),list(p))
#               )
#	# get the unique list of attached Process instances
#	getUniqueProcesses(s)
#	# via virtual field
#	s$uniqueProcesses
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getUniqueProcesses", 
	class="Sequence", 
	function(
		this,
		...
	){
	
		tmp<-list();			
      lapply(
      this$.sites,
      function(site) {
				tmp<<-c(tmp,site$processes)
      }
		);
		return(unique(tmp));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setUniqueProcesses
##	
###########################################################################/**
#
# @RdocMethod setUniqueProcesses
#
# @title "Forbidden action: setting the list of unique Process instances attached to the sites of a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setUniqueProcesses", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setProcesses
##	
###########################################################################/**
#
# @RdocMethod setProcesses
# 
# @title "Specify a set of Process objects to be attached to a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The Process objects in a given inner list correspond to the set of processes to be attached to one Site object. 
#	Process objects already attached to a given Site are skipped. Attached processes which are not memebers of the list
#	are detached, so specifying an empty list will detach all processes.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{value}{A list of list of Process objects, recycled if shorter than the index vector.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a sequence of length 5
#	s<-Sequence(length=5,alphabets=list(NucleotideAlphabet()));
#	# set a pattern of processes
#	setProcesses(s,list(list(JC69(),K81())))
#	# get attached processes
#	s$processes
#	# detach all processes from range 1:3
#	setProcesses(s,list(list()),1:3)
#	s$processes
#	# detach all processes via virtual field
#	s$processes<-list(list())
#	# create a process pattern in the full sequence via virtual field
#	s$processes<-list(list(JC69()),list(GTR(),K80()))
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setProcesses", 
	class="Sequence", 
	function(
		this,
		value,
		index,
		...
	){

		.checkWriteProtection(this);	

		if(!is.list(value)) {
			throw("The value parameter must be a list!\n");
		} else {
			lapply(
					value,
					function(element) {
						if(!is.list(element)){
							throw("The value parameter must be a list of lists containing process objects!\n");
						}
					}
			);
		}

	  	if (missing(index)) {
      		index<-seq(along.with=this$.sites);
    		} else {
			index<-.checkIndexSanity(this, index);	
		}

    		value.counter<-1;

		# Recycling value vector. rep() cannot be used here,
		# because we loose the object references!
    		for (i in index)  {
        	if(value.counter > length(value)) {
          		value.counter<-1;
        	}
		setProcesses(this$.sites[[i]], value[[value.counter]]);
	
        	value.counter<-(value.counter + 1);
    	}
    	invisible(this);
	
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setParameterAtSites
##	
###########################################################################/**
#
# @RdocMethod setParameterAtSites
# 
# @title "Set the values of a site-process specific paramater for a process and a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A valid Process object.} 
# 	\item{id}{The identifier of the site-process specific parameter.} 
#	\item{value}{A vector containing the new values of the site-process specific parameter, recycled if shorter than the index vector. It should be consistent with the type of the parameter.}
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a sequence, attach a process
#	p<-K80()
#	s<-Sequence(length=6,alphabets=list(NucleotideAlphabet()),processes=list(list(p)))
#	# set a new pattern of rate multipliers in the range 1:3,
#   # the default value is 1.0 by the way
#	setParameterAtSites(s,p,"rate.multiplier",c(2,3),1:3)
#	# get rate multipliers
#	getParameterAtSites(s,p,"rate.multiplier")
#	# set a new value for the whole sequence
#	setParameterAtSites(s,p,"rate.multiplier",0.5)
#	# get rate multipliers
#	getParameterAtSites(s,p,"rate.multiplier")
# } 
# 
# @author 
# 
# \seealso{ 
# 	Site Process @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setParameterAtSites", 
	class="Sequence", 
	function(
		this,
		process,
		id,
		value,
		index,
		...
	){

		.checkWriteProtection(this);

	 if(!exists(x="PSIM_FAST")){

		if(missing(process)) {
			throw("No process given!\n");
		}
		else if(!is.Process(process)){
			throw("Process object invalid!\n");}
		else if (missing(id)) {
			throw("No site-process specific parameter id given!\n");
		} else if (!is.character(id)) {
			throw("Parameter id must be character!\n");
		} else if (missing(value)){
			throw("No new value given!\n");
		}
	}

		if (missing(index)) {
			index<-seq(along.with=this$.sites);
		} else {
			index<-.checkIndexSanity(this, index);
		}
	
		if(length(value) == 1) {
			lapply(
				this$.sites[index],
				function(site){
					setParameterAtSite(process,site,id,value);
				}
			);
		} else {
			
			counter<-1;
			lapply(
				this$.sites[index],
				function(site){
					if( counter > length(value) ){
						counter<<-1;
					}	
					setParameterAtSite(process,site,id,value[[counter]]);
					counter<<-(counter+1);

				}
			);
				
		}

		return(invisible(this));

		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateMultipliers
##	
###########################################################################/**
#
# @RdocMethod setRateMultipliers
# 
# @title "Set the values of the rate multiplier parameters for a given Process object and a collection of Site  object aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method just calls \code{setParameterAtSites(this=this,process=process,id="rate.multiplier",value=value,index=index)} See setParameterAtSites.Sequence for details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A valid Process object.} 
#	\item{value}{A numeric vector containing the new values of the site-process specific parameter, recycled if shorter than the index vector.}
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	setParameterAtSites.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateMultipliers", 
	class="Sequence", 
	function(
		this,
		process,
		value,
		index,
		...
	){

	
		if(missing(process)){
			throw("No process given!\n");
		}
		else if(missing(value)){
			throw("No value provided!\n");
		}
		#else if(!is.GeneralSubstitution(process)){
		#	throw("The specified process is not a substitution process!\n");
		#}
		setParameterAtSites(this=this,process=process,id="rate.multiplier",value=value,index=index);
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateMultipliers
##	
###########################################################################/**
#
# @RdocMethod getRateMultipliers
# 
# @title "Get the values of the rate multiplier parameters for a given Process object and a collection of Site  object aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method just calls \code{getParameterAtSites(this=this,process=process,id="rate.multiplier",index=index)} See getParameterAtSites.Sequence for details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A valid Process object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector with the current values of the rate multiplier in the specified range.
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	setParameterAtSites.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateMultipliers", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){

		if(missing(process)){
			throw("No process given!\n");
		}
		
		rm<-getParameterAtSites(this=this,process=process,id="rate.multiplier",index=index);
		return(as.numeric(lapply(rm,function(param){param$value})));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getParameterAtSites
##	
###########################################################################/**
#
# @RdocMethod getParameterAtSites
# 
# @title "Get the values of a site-process specific paramater for a process and a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A valid Process object.} 
# 	\item{id}{The identifier of the site-process specific parameter.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of site specific paramters. A site specific paramter is a list storing the id, the name, the value 
#	and the type of the parameter.
# } 
# 
# \examples{
#	# create a sequence, attach a process
#	p<-K80()
#	s<-Sequence(length=6,alphabets=list(NucleotideAlphabet()),processes=list(list(p)))
#	# set a new pattern of rate multipliers in the 
#   # range 1:3, the default value is 1.0 by the way
#	setParameterAtSites(s,p,"rate.multiplier",c(2,3),1:3)
#	# get rate multipliers
#	getParameterAtSites(s,p,"rate.multiplier")
#	# set a new value for the whole sequence
#	setParameterAtSites(s,p,"rate.multiplier",0.5)
#	# get rate multipliers
#	getParameterAtSites(s,p,"rate.multiplier")
# } 
# 
# @author 
# 
# \seealso{ 
# 	Site Process @seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getParameterAtSites", 
	class="Sequence", 
	function(
		this,
		process,
		id,
		index,
		...
	){

	 if(!exists(x="PSIM_FAST")){

		if(missing(process)) {
			throw("No process given!\n");
		}
		else if(!is.Process(process)){
			throw("Process object invalid!\n");}
		else if (missing(id)) {
			throw("No site-process specific parameter id given!\n");
		} else if (!is.character(id)) {
			throw("Parameter id must be character!\n");
		}
	}

		if (missing(index)) {
			index<-seq(along.with=this$.sites);
		} else {
				index<-.checkIndexSanity(this, index);
		}	
		
		lapply(
			this$.sites[index],
			function(site){
				getParameterAtSite(process,site,id);
			}
		);
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEvents
##	
###########################################################################/**
#
# @RdocMethod getEvents
# 
# @title "Get the list of active Event objects for a set of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Event objects.
# } 
# 
# \examples{
#	# create a sequence with a process attached
#	s<-Sequence(
#               string="ATGC",
#               alphabets=list(NucleotideAlphabet()),
#               processes=list(list(JC69()))
#               )
#	# get the active events from range 1:3
#	getEvents(s,1:3)
#	# get all active events via virtual field
#	s$events
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEvents", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){
		
 	if (missing(index)) {
      		index<-seq(along.with=this$.sites);
	} else {
        	index<-.checkIndexSanity(this, index);
    	}

	tmp<-list();
    	for (i in index){
		# Setting the .positions field for then Events.
		this$.sites[[i]]$.position<-i;
        	tmp<-c(tmp, getEvents(this$.sites[[i]]));
		# Deleting the .position field;
		this$.sites[[i]]$.position<-NULL;
    	}
	tmp;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getTotalRatesFromRange
##	
###########################################################################/**
#
# @RdocMethod getTotalRatesFromRange
# 
# @title "Get the vector of total site rates for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	# create a sequence with some processes attached
#	s<-Sequence(
#               string="ATGC",
#               alphabets=list(NucleotideAlphabet()),
#               processes=list(list(JC69()),list(JC69(),GTR()))
#               )
#	# get total rates for positions 1 and 3
#	getTotalRatesFromRange(s,c(1,3))
#	# get all total rates via virtual field
#	s$totalRates	# via the "getTotalRates.Sequence" method
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getTotalRatesFromRange", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){


	if (missing(index)) {
      	index<-seq(along.with=this$.sites);
    	} else {
        	index<-.checkIndexSanity(this, index);
    	}

	
		if (this$.cumulative.rate.flag){
			.recalculateCumulativeRates(this);
		}

		this$.total.rates[index];
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getTotalRates
##	
###########################################################################/**
#
# @RdocMethod getTotalRates
# 
# @title "Get the total site rates from a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method simply calls \code{getTotalRatesFromRange(this)}.
#	See \code{getTotalRatesFromRange.Sequence} for more details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector containing the total site rates.
# } 
# 
# @author 
# 
# \seealso{ 
# 	getTotalRatesFromRange.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"getTotalRates", 
	class="Sequence", 
	function(
		this,
		...
	){

		getTotalRatesFromRange(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setTotalRates
##	
###########################################################################/**
#
# @RdocMethod setTotalRates
#
# @title "Forbidden action: setting the list of total site rates for a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setTotalRates", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
##	
## Method: getAncestral
##	
###########################################################################/**
#
# @RdocMethod getAncestral
# 
# @title "Get the ancestral object of a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Sequence object or a Process object.
# } 
# 
# \examples{
#	# create a sequence object
#	s<-Sequence(length=4)
#	# get ancestral object
#	getAncestral(s)	# newly created sequences have the "Root insertion process" as ancestral
#	# clone sequence
#	cs<-clone(s)
#	# get ancestral object id via virtual field
#	cs$ancestral$id
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAncestral", 
	class="Sequence", 
	function(
		this,
		...
	){

	this$.ancestral.obj;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getCumulativeRatesFromRange
##	
###########################################################################/**
#
# @RdocMethod getCumulativeRatesFromRange
# 
# @title "Get the cumulative site rates for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# \examples{
#	# create a sequence with some processes attached
#	s<-Sequence(
#               string="ATGC",
#               alphabets=list(NucleotideAlphabet()),
#               processes=list(list(JC69()),list(JC69(),GTR()))
#               )
#	# get cumulative rates for positions 1 and 3
#	getCumulativeRatesFromRange(s,c(1,3))
#	# get all cumulative rates via virtual field
#	s$cumulativeRates	# via the "getCumulativeRates.Sequence" method
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getCumulativeRatesFromRange", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){

		if (missing(index)) {
      			index<-seq(along.with=this$.sites);
    		} else {
        		index<-.checkIndexSanity(this, index);
   		}


		if (this$.cumulative.rate.flag){
			.recalculateCumulativeRates(this);
		}

		this$.cumulative.rates[index];


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

setMethodS3(
	".getCumulativeRatesFast", 
	class="Sequence", 
	function(
		this,
		...
	){

		if (this$.cumulative.rate.flag){
			.recalculateCumulativeRates(this);
		}

		this$.cumulative.rates;

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .recalculateCumulativeRates
##	
setMethodS3(
	".recalculateCumulativeRates", 
	class="Sequence", 
	function(
		this,
		target.site,
		...
	){
		
		length<-this$.length;
		if(length ==  0){
			return();
		}

		total.rates<-this$.total.rates;
		sites<-this$.sites;
		flagged.sites<-this$.flagged.sites;

		if( length(flagged.sites) == 0 ) {
			# Fresh start:
			total.rates<-as.numeric(lapply(sites,getTotalRate));

		} else {
			# We have some flagged sites, recalculate just their total rates:
			total.rates[flagged.sites]<-as.numeric(lapply(sites[flagged.sites],getTotalRate));
		}
		
		this$.total.rates<-total.rates;
		this$.cumulative.rates<-cumsum(total.rates);	
		this$.flagged.sites<-integer(0);
		this$.cumulative.rate.flag<-FALSE;
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getCumulativeRates
##	
###########################################################################/**
#
# @RdocMethod getCumulativeRates
# 
# @title "Get the total site rates from a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method simply calls \code{getCumulativeRatesFromRange(this)}.
#	See \code{getCumulativeRates.Sequence} for more details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector containing the total site rates.
# } 
# 
# @author 
# 
# \seealso{ 
# 	getCumulativeRatesFromRange.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"getCumulativeRates", 
	class="Sequence", 
	function(
		this,
		...
	){

		getCumulativeRatesFromRange(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setCumulativeRates
##	
###########################################################################/**
#
# @RdocMethod setCumulativeRates
#
# @title "Forbidden action: setting the cumulative rates for the sites aggregated by a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setCumulativeRates", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getBigRate
##	
###########################################################################/**
#
# @RdocMethod getBigRate
# 
# @title "Get the sum of all active event rates from a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The sum of active event rates depends on all Site object states and on the attached Process objects. 
#	It basically returns the last element of the cumulative site rates vector.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#	# create a nucleotide sequence attach a process
#	s<-NucleotideSequence(length=5);
#	s$processes<-list(list(JC69()))
#	# get the sum of active event rates
#	getBigRate(s)	# returns NA because site states are undefined
#	# set site states
#	s$states<-c("A","T")
#	# get big rate via virtual field
#	s$bigRate
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getBigRate", 
	class="Sequence", 
	function(
		this,
		...
	){
	
		if (length(this$.sites) > 0) {
			if(this$.cumulative.rate.flag)	{
				.recalculateCumulativeRates(this);	
			}
			return(this$.cumulative.rates[this$.length]);
		} else {
			return(NA);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setBigRate
##	
###########################################################################/**
#
# @RdocMethod setBigRate
#
# @title "Forbidden action: setting the sum of total active event rates for a Sequence object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setBigRate", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		virtualAssignmentForbidden(this);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAncestral
##	
###########################################################################/**
#
# @RdocMethod setAncestral
# 
# @title "Set the ancestral object of a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{value}{A Sequence or a Process object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new ancestral object (invisible).
# } 
# 
# \examples{
#	# create a nucleotide sequence and a process object
#	s<-NucleotideSequence(string="AGCT")
#	p<-Process(name="MyProcess")
#	# set the p as the ancestral of s
#	setAncestral(s,p)
#	s$ancestral
#	# clone s
#	cs<-clone(s)
#	# set cs as ancestral of s via virtual field
#	s$ancestral<-cs
#	# get ancestral ids
#	s$ancestral$id
#	cs$ancestral$id
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAncestral", 
	class="Sequence", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);	
		if (!is.Sequence(value) & ! is.Process(value)) {
			throw("Ancestral object must be a sequence or a process!\n");
		}	else {
			this$.ancestral.obj<-value;
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: clone.Sequence
##	
###########################################################################/**
#
# @RdocMethod clone
# 
# @title "Clone a Sequence object" 
# 
# \description{ 
#	@get "title".
#
#	The cloning of Sequence objects involves the cloning of all aggregated Site objects. Because of that the 
#	cloning of long sequences is quite expensive.
#	The cloned Site objects have the orginal Site objects as ancestral.
#	The new Sequence objects has the original object as ancestral.	
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Sequence object.
# } 
# 
# \examples{
#	# cretate a nucleotide sequence
#	s<-NucleotideSequence(string="ATG")
#	# clone the sequence
#	cs<-clone(s)
#	# get some properties
#	equals(s,s)
#	equals(s,cs)
#	cs$ancestral
#	cs$sites[[1]]$ancestral
# } 
# 
# @author 
# 
# \seealso{ 
# 	Sequence clone.Object
# } 
# 
#*/###########################################################################
setMethodS3(
	"clone", 
	class="Sequence", 
	function(
		this,
		...
	){

		# Cloning the whole sequence object:
		that<-clone.Object(this)
		# Disabling write protection:
		if(that$writeProtected) {
			that$writeProtected<-FALSE
		}
		# Setting the ancestral sequence:
		that$.ancestral.obj<-this
		# Resetting comments:
		that$.comments<-list()

		# Cloning sites:
		clone.sites<-that$.sites
        if(this$.length > 0) {
            for (i in 1:this$.length) {
                site<-this$.sites[[i]]
                clone<-clone.Object(site)
                clone$.ancestral<-site
                clone$.sequence<-that
                clone.sites[[i]]<-clone
            }
        }
		that$.sites<-clone.sites
		
		# Setting the name:
		that$name<-paste("clone of",this$.name)
		return(that)
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: getWriteProtected
##
###########################################################################/**
#
# @RdocMethod getWriteProtected
#  
# @title "Check if the object is write protected" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE
# } 
# 
# \examples{
#
#       # create an object
#       o<-Sequence()
#       # toggle write protection
#       o$writeProtected<-TRUE
#       # check if it's write protected
#       getWriteProtected(o)
#       # check write protection via virtual field
#       o$writeProtected
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getWriteProtected",
  class="Sequence",
  function(
    this,
    ...
  ){

    this$.write.protected;

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkIndexSanity
##
setMethodS3(
  ".checkIndexSanity",
  class="Sequence",
  function(
    this,
    index,
    ...
  ){

		if (length(index) == 0 ) {
				return(c());
		}
           if(!exists(x="PSIM_FAST")){
	  
	   if( length(index) == 1 ) {
			if(is.na(index)) {
				warning("Index vector is NA! Coercing to empty vector!\n");
				return(c());
			} 
			if (is.nan(index)) {
				warning("Index vector is NaN! Coercing to empty vector!\n");
				return(c());
			}

		}

		if(min(index) < 1 ) {
			throw("Index vector element ",min(index)," too small!\n");
		}
		if( max(index) > this$.length ) {
			throw("Index vector element ",max(index)," too big!\n");
		}
	     }
		return(index);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);
##
## Method: setWriteProtected
##
###########################################################################/**
#
# @RdocMethod setWriteProtected
#  
# @title "Set the write protection field for an object" 
# 
# \description{ 
#	@get "title".
#	Write protected objects cannot be modified through get/set methods and virtual fields.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{value}{A logical vector of size one.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or FALSE.
# } 
# 
# \examples{
#
#	# create an object
#	o<-Sequence()
#	# toggle write protection
#	setWriteProtected(o,TRUE)
#	# check write protection
#	o$writeProtected
#	# set write protection via virtual field
#	o$writeProtected<-FALSE
#	o$writeProtected
#	
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setWriteProtected",
  class="Sequence",
  function(
    this,
    value,
    ...
  ){

    if(!is.logical(value)) {throw("The new value must be logical!\n")}
    else {
      this$.write.protected<-value;
    }

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkWriteProtection
##
setMethodS3(
  ".checkWriteProtection",
  class="Sequence",
  function(
    this,
    value,
    ...
  ){

    if(getWriteProtected(this)) {throw("Cannot set value because the object is write protected!\n")}
    else {return(FALSE)}

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: summary.Sequence
##	
###########################################################################/**
#
# @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<-Sequence()
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="Sequence", 
	function(
		object,
		...
	){

		 this<-object;
		 this$.summary$"Name"<-this$name;
		 this$.summary$"Id"<-this$id;
		 this$.summary$"Length"<-this$length;
		 this$.summary$"Big rate"<-this$bigRate;
		 this$.summary$"Ancestral object"<-this$ancestral$id;

		 if(this$.cumulative.rate.flag) {
		 	this$.summary$"Cumulative rate flag"<-TRUE;
		 }
		 if(length(this$.flagged.sites) > 0 ) {
		 	this$.summary$"Flagged sites"<-paste(this$.flagged.sites,collapse=" ");
		 }
		 if(this$writeProtected) {
		 	this$.summary$"Write protected"<-TRUE;
		 }
		


			NextMethod();
		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: as.character.Sequence
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Get the string representation of a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The string representation is the concatenation of the states of the 
#	aggregated Site object. Undefined states (NA-s) are represented by question marks.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create object
#	s<-Sequence(length=10)
#	# get character representation
#	as.character(s)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="Sequence", 
	function(
		x,
		...
	){

		getString(x);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: plot
##	
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Plot the total site rates for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or FALSE.
# } 
# 
# \examples{
#	# create a nucleotide sequence with a process attached
#	s<-NucleotideSequence(string="ATGGCCA",processes=list(list(JC69())))
#	# plot total rates in range 1:4
#	plot(s,1:4)
#	# plot all total rates
#	plot(s)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"plot", 
	class="Sequence", 
	function(
		x,
		index=NA,
		...
	){
  
    this<-x;
    if(this$length == 0) {
      warning("The sequence leght is zero, nothing to plot here!\n");
      return(invisible(FALSE));
    }
		if( length(unique(this$totalRates)) == 1 & any(is.na(unique(this$totalRates))) ){
      warning("The total rates are undefined, nothing to plot here!\n");
      return(invisible(FALSE));
		}
    else {
      if(missing(index)) {
        index<-seq(along.with=1:this$length,by=1);
      }
      if(this$.cumulative.rate.flag){
        .recalculateCumulativeRates(this);
      }
      what<-this$.total.rates[c(index)]

      plot(
        x=index,
        y=what,
        type="h",
        lwd=1,
        col="blue",
        main=paste("Total rate plot for sequence", this$id),
        xlab="Position",
        ylab="Total rate",
				ylim=c(0,max(what)),
        xlim=c(min(index),max(index)),
				xaxt="n"
      );
	axis(side=1, at=index, labels=index);
	
	return(invisible(TRUE));
    	}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: plotParameterAtSites
##	
###########################################################################/**
#
# @RdocMethod plotParametersAtSites
# 
# @title "Plot the value of a site-process specifc paramter for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	The type of the paramter must be numeric. The Process object must be attached to all positions specified 
#	in the index vector. 
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
# 	\item{id}{The identifier of the site-process specific parameter.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or FALSE.	
# } 
# 
# \examples{
#	# create a nucleotide sequence with a process attached
#	p<-JC69()
#	s<-NucleotideSequence(string="ATGGCCA",processes=list(list(p)))
#	# plot rate multipliers in range 1:4
#	plotParametersAtSites(s,p,"rate.multiplier",1:4)
#	# plot rate multiplier for the full sequence
#	plotParametersAtSites(s,p,"rate.multiplier")
# } 
# 
# @author 
# 
# \seealso{ 
# 	Site Process Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"plotParametersAtSites", 
	class="Sequence", 
	function(
		this,
		process,
		id,
		index,
		...
	){


    	if(this$length == 0) {
      	warning("The sequence leght is zero, nothing to plot here!\n");
      	return(invisible(FALSE));
    	}
    	if(missing(index)) {
      		index<-seq(along.with=1:this$.length,by=1);
    	}
		what<-apply(as.array(index),1,
			function(pos){
				tmp<-getParameterAtSites(this,process,id,pos)[[1]]$value;
				if(!is.numeric(tmp)){
					throw("Plot method failed becuase encountered non-numeric parameter value!\n");
				}
				return(tmp);
			}
		);
      plot(
        x=index,
        y=what,
        type="h",
        lwd=1,
        col="blue",
        main=paste("Plot of parameter",id,"for process",process$id),
        xlab="Position",
        ylab="Value",
        xlim=c(min(index),max(index)),
				ylim=c(0,max(what)),
				xaxt="n"
      );
	axis(side=1, at=index, labels=index);
	invisible(TRUE);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setDeletionTolerance
##	
###########################################################################/**
#
# @RdocMethod setDeletionTolerance
# 
# @title "Set the deletion tolerance site-process specific parameter for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method does some error checking and the calls \code{setParameterAtSites(this=this,process=process,id="deletion.tolerance",value=value,index=index)}.
#	See \code{setParameterAtSites.Sequence} for more details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
# 	\item{value}{A numeric vector, recycled if shorter than the index vector.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	setParameterAtSites.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"setDeletionTolerance", 
	class="Sequence", 
	function(
		this,
		process,
		value,
		index,
		...
	){

	 if(!exists(x="PSIM_FAST")){
		if(missing(process)){
			throw("No process given!\n");
		}
		else if (missing(value)){
			throw("No value provided!\n");
		}
		else if(!inherits(process,"GeneralDeletor")){
			throw("The specified process is not an insertion process!\n");
		}
	}
		setParameterAtSites(this=this,process=process,id="deletion.tolerance",value=value,index=index);
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getDeletionTolerance
##	
###########################################################################/**
#
# @RdocMethod getDeletionTolerance
# 
# @title "Get the deletion tolerance site-process specific parameter for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method does some error checking and the calls \code{getParameterAtSites(this=this,process=process,id="deletion.tolerance",index=index)}.
#	See \code{getParameterAtSites.Sequence} for more details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	getParameterAtSites.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"getDeletionTolerance", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){

	 if(!exists(x="PSIM_FAST")){
		if(missing(process)){
			throw("No process given!\n");
		}
		if(!inherits(process,"GeneralDeletor")){
			throw("The specified process is not an insertion process!\n");
		}
	}
		rm<-getParameterAtSites(this=this,process=process,id="deletion.tolerance",index=index);
		return(as.numeric(lapply(rm,function(param){param$value})));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setInsertionTolerance
##	
###########################################################################/**
#
# @RdocMethod setInsertionTolerance
# 
# @title "Set the insertion tolerance site-process specific parameter for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method does some error checking and the calls \code{setParameterAtSites(this=this,process=process,id="insertion.tolerance",value=value,index=index)}.
#	See \code{setParameterAtSites.Sequence} for more details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
# 	\item{value}{A numeric vector, recycled if shorter than the index vector.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	setParameterAtSites.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"setInsertionTolerance", 
	class="Sequence", 
	function(
		this,
		process,
		value,
		index,
		...
	){
	
	    if(!exists(x="PSIM_FAST")){
		if(missing(process)){
			throw("No process given!\n");
		}
		else if (missing(value)){
			throw("No value provided!\n");
		}
		else if(!inherits(process,"GeneralInsertor")){
			throw("The specified process is not an insertion process!\n");
		}
            }
		setParameterAtSites(this=this,process=process,id="insertion.tolerance",value=value,index=index);
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getInsertionTolerance
##	
###########################################################################/**
#
# @RdocMethod getInsertionTolerance
# 
# @title "Get the insertion tolerance site-process specific parameter for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method does some error checking and the calls \code{getParameterAtSites(this=this,process=process,id="insertion.tolerance",index=index)}.
#	See \code{getParameterAtSites.Sequence} for more details.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector.
# } 
# 
# 
# @author 
# 
# \seealso{ 
# 	getParameterAtSites.Sequence
# } 
# 
#*/###########################################################################
setMethodS3(
	"getInsertionTolerance", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){

	 if(!exists(x="PSIM_FAST")){
		if(missing(process)){
			throw("No process given!\n");
		}
		if(!inherits(process,"GeneralInsertor")){
			throw("The specified process is not an insertion process!\n");
		}
	}
		rm<-getParameterAtSites(this=this,process=process,id="insertion.tolerance",index=index);
		return(as.numeric(lapply(rm,function(param){param$value})));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: sampleStates
##	
###########################################################################/**
#
# @RdocMethod sampleStates
# 
# @title "Sample the states for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#	This method samples new states from the equlibrium distribution of the attched process(es) for sites
#	having undefined states (NA). 
#	If a site has more than one substitution process attached, then the method samples the new state from the 
#	mixture of equlibrium distributions. The weight of each equlibrium distribution is proportional to the 
#	site-process specific rate multiplier of the corresponding process at the given site. 
#
#	Sites having defined states are not touched. All sites with undefined states must have at least one 
#	substitution process (object inheriting from GeneralSubstitution) attached.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a nucleotide sequence
#	s<-NucleotideSequence(length=80)
#	# create some processes
#	jc69<-JC69(); 				# Jukes-Cantor
#	hky<-HKY(base.freqs=c(0.1,0.4,0.1,0.4)) # "GC-rich" HKY
#	# attach the processes
#	s$processes<-list(list(jc69)) # jc is attached to all sites
#	attachProcess(s,hky,60:80)  # hky is attached to range 60:80
#	# tweak rate multiplier for hky
#	setRateMultipliers(s,hky,10,60:80)
#	# set states in range 1:20
#	setStates(s,"A",1:20)
#	# sample remaining states
#	sampleStates(s)
#	# print sequence
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	sampleState.GeneralSubstitution GeneralSubstitution
# } 
# 
#*/###########################################################################
setMethodS3(
	"sampleStates", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){

		if(!missing(index)){
			index<-.checkIndexSanity(this, index);
		}
		else {
			index<-seq(along.with=this$.sites);
		}
	
    for(site in this$.sites[index]){
    # Sample states from the equlibrium distributions if
    # the state is NA:
      if(is.na(site$state)){
        # Assemble the list of substitution processes:
        subst.proc<-list();
        for (proc in site$processes){
          if(is.GeneralSubstitution(proc)){
              subst.proc<-c(subst.proc, list(proc));
            }
        }

        # Complain if we have no substitution processes to sample from:
        if(length(subst.proc) == 0){
          throw("Site state is NA and no substitution processes are attached. Cannot sample state!\n");
        }

        site.rates<-as.numeric(lapply(
            subst.proc,
            function(proc){
              return(getParameterAtSite(proc, site,"rate.multiplier")$value);
            }
        ));

        # Normalizing site rates:
        site.rates<-site.rates/sum(site.rates);

        # Single subst process:
        if(length(subst.proc) == 1){
          site$state<-sampleState(subst.proc[[1]]);
        }
        else {
          # Sample a substitution process according to the rate multipliers:
          nproc<-sample(x=c(1:length(subst.proc)),size=1, replace=FALSE, prob=site.rates);
          # Sample the state from the winner process:
          site$state<-sampleState(subst.proc[[nproc]]);
        }
      } # if is.na...

    	}

	return(invisible(this));
	
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: clearStates
##	
###########################################################################/**
#
# @RdocMethod clearStates
# 
# @title "Set the states of a collection of Site objects aggregated by a Sequence object to undefined (NA)" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a nucleotide sequence
#	s<-NucleotideSequence(string="ATGC")
#	s
#	# set states to NA in the range 2:3	
#	clearStates(s,2:3)
#	s
#	# set all states to NA
#	clearStates(s)
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"clearStates", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){

		if(!missing(index)){
			index<-.checkIndexSanity(this, index);
		}
		else {
			index<-seq(along.with=this$.sites);
		}
	
    		for(site in this$.sites[index]){
			site$.state<-NA;
			site$.total.rate<-NA;
    		}
		
		this$.cumulative.rate.flag<-TRUE;

		return(invisible(this));
	
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setOmegas
##	
setMethodS3(
	"setOmegas", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){
		
		# dummy method to force the creation of the generic function
		setOmegas.CodonSequence(this,process,index,...);
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getOmegas
##	
setMethodS3(
	"getOmegas", 
	class="Sequence", 
	function(
		this,
		process,
		index,
		...
	){
		
		# dummy method to force the creation of the generic function
		getOmegas.CodonSequence(this,process,index,...);

		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSymbolFreqs
##	
###########################################################################/**
#
# @RdocMethod getSymbolFreqs
# 
# @title "Get a table with the frequencies of the states of a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An integer vector specifying a set of positions. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A table.
# } 
# 
# \examples{
#	# create a nucleotide sequence
#	s<-NucleotideSequence(length=30,processes=list(list(JC69())))
#	# sample states
#	sampleStates(s)
#	# get state frequencies from ranges 1:10 and 20:30
#	getSymbolFreqs(s,c(1:10,20:30))
#	# get symbol frequencies for the full sequence
#	getSymbolFreqs(s)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSymbolFreqs", 
	class="Sequence", 
	function(
		this,
		index,
		...
	){
		
			if(!missing(index)){
				index<-.checkIndexSanity(this, index);
			} else {
				index<-seq(along.with=this$.sites);
			}

			prop.table(table(as.character(lapply(this$.sites[index],getState))));
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .discretizeGamma
##	
setMethodS3(
	".discretizeGamma", 
	class="Sequence", 
	function(
		this,
		shape,
		ncat,
		...
	){
		# figure out cutting points	
		cut<-apply(rbind(1:(ncat-1)/ncat),1, function(x){qgamma(x,shape=shape,rate=shape)})	
		cut<-c(0,cut,Inf);

		# incomplete gamma function
		Igamma<-function(x,a){
			pgamma(x,shape=a, scale=1)
		}

		# function to calculate a category mean
		cm<-function(a,b,shape,ncat){
			( Igamma(b * shape, shape+1) - Igamma(a * shape,shape+1)) * ncat;
		}
		
		# calculate category means
		means<-c();
		for (i in 1:(length(cut)-1)){
			means<-c(means,cm(cut[i], cut[i+1], shape, ncat));
		}
		
		# return a vector with the means
		return(means);

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: plusGamma
##	
###########################################################################/**
#
# @RdocMethod plusGamma
# 
# @title "Sample the rate multiplier parameters of a Process from a Gamma distribution for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#
#	The gamma distribution is discretized by calculating the means of the portions corresponding 
#	to the categories having equal probabilities. If the \code{ncat} argument is not numeric, the 
#	rates are sampled from the continuous gamma distribution.
# } 
#
# \references{
#	Yang, Z. (1994) Maximum likelihood phylogenetic estimation from DNA sequences with variable 
#	rates over sites: approximate methods - Journal of Molecular Evolution 39:306-314 \url{http://dx.doi.org/10.1007/BF00160154}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
# 	\item{shape}{The shape parameter of the gamma distribution.} 
# 	\item{index}{A vector of positions.} 
# 	\item{ncat}{Numer of categories in the discretized gamma distribution (4 by default).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible);
# } 
# 
# \examples{
#	# create a sequence
#	s<-NucleotideSequence(length=20)
#	# attach a process
#	p<-JC69()
#	attachProcess(s,p)
#	# get rate multipliers
#	getRateMultipliers(s,p)	# the default value is 1.0
#	# sample rate multipliers in range 1:5 from a discrete 
#	#gamma distribution with shape parameter 0.5
#	plusGamma(s,p,0.5,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)	# the default value is 1.0
#	# sample rates from a continuous gamma distribution 
#	# with shape parameter 0.5
#	plusGamma(s,p,0.5,ncat="cont")
#	# get rate multipliers
#	getRateMultipliers(s,p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"plusGamma", 
	class="Sequence", 
	function(
		this,
		process,
		shape,	
		index,
		ncat=4,
		...
	){

		if(missing(process)){
			throw("No process specified!\n");
		}
		else if(missing(shape)){
			throw("No shape parameter specified!\n");
		}
		else if(!all(is.numeric(shape)) | length(shape) != 1){
			throw("The shape parameter must be a numeric vector of lenght 1!\n");	
		}
		
			if(missing(index)){
				index<-seq(along.with=this$.sites);
			}
			else {
				index<-.checkIndexSanity(this, index);
			}
		
			if(!is.numeric(ncat)){
				# continuous gamma	
				setParameterAtSites(this, process=process, id="rate.multiplier",value=rgamma(length(index),shape=shape,rate=shape),index=index);
			}
			else{
				setParameterAtSites(this, process=process, id="rate.multiplier",sample(.discretizeGamma(this,shape,ncat),size=length(index),replace=TRUE),index=index);
			}
			return(invisible(this));
	
		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: plusInvGamma
##	
###########################################################################/**
#
# @RdocMethod plusInvGamma
# 
# @title "Sample the rate multiplier parameters of a Process from an I+Gamma distribution for a collection of Site objects aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
#
#	The gamma distribution is discretized by calculating the means of the portions corresponding 
#	to the categories having equal probabilities. If the \code{ncat} argument is not numeric, the 
#	rates are sampled from the continuous gamma distribution.
# } 
#
# \references{
#	Gu X, Fu, YX, Li, WH (1995) Maximum likelihood estimation of the heterogeneity of substitution 
#	rate among nucleotide sites - Mol. Biol. Evol. 12(4):546-57 \url{http://bit.ly/aE6xF0}
#
#	Yang, Z (1994) Maximum likelihood phylogenetic estimation from DNA sequences with variable 
#	rates over sites: approximate methods - Journal of Molecular Evolution 39:306-314 \url{http://dx.doi.org/10.1007/BF00160154}
# }
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
# 	\item{process}{A Process object.} 
# 	\item{pinv}{The proportion of invariant sites.} 
# 	\item{shape}{The shape parameter of the gamma distribution.} 
# 	\item{index}{A vector of positions.} 
# 	\item{ncat}{Numer of categories in the discretized gamma distribution (4 by default).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible);
# } 
# 
# \examples{
#	# create a sequence
#	s<-NucleotideSequence(length=20)
#	# attach a process
#	p<-JC69()
#	attachProcess(s,p)
#	# get rate multipliers
#	getRateMultipliers(s,p)	# the default value is 1.0
#	# sample rate multipliers in range 1:5 from I+discrete Gamma
#	plusInvGamma(s,p,pinv=0.5,shape=0.5,1:5)
#	# get rate multipliers
#	getRateMultipliers(s,p)	# the default value is 1.0
#	# sample rates from an I+continuos Gamma model
#	plusInvGamma(s,p,pinv=0.5,shape=0.5,1:5,ncat="cont")
#	# get rate multipliers
#	getRateMultipliers(s,p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"plusInvGamma", 
	class="Sequence", 
	function(
		this,
		process,
		pinv,
		shape,	
		index,
		ncat=4,
		...
	){

		if(missing(process)){
			throw("No process specified!\n");
		}
		else if(missing(pinv)){
			throw("No proportion of invariant sites given!\n");
		}
		else if(!all(is.numeric(pinv)) | length(pinv) != 1){
			throw("The pinv parameter must be a numeric vector of lenght 1!\n");	
		}
		else if(pinv > 1){
			throw("Tpe proportion of invariant sites cannot be larger than 1.!");
		}
		else if(missing(shape)){
			throw("No shape parameter specified!\n");
		}
		else if(!all(is.numeric(shape)) | length(shape) != 1){
			throw("The shape parameter must be a numeric vector of lenght 1!\n");	
		}
		else {
		
			if(missing(index)){
				index<-seq(along.with=this$.sites);
			}
			else {
				index<-.checkIndexSanity(this, index);
			}

			# discretize gamma distribution
			dg<-c()
			if(is.numeric(ncat)){
				dg<-.discretizeGamma(this,shape,ncat);
			}

			# Iterating over the sites specified by the index vector:
			
			for(site in index){

				# Choose between invariant and gamma:
				type<-sample(c("INV","GAMMA"),size=1, replace=FALSE, prob=c( pinv, (1-pinv) ) );

				if(type == "INV"){
					setParameterAtSites(this, process=process, id="rate.multiplier",value=0,index=c(site));
				}
				else {
					if(!is.numeric(ncat)){
						# continuous gamma	
						setParameterAtSites(this, process=process, id="rate.multiplier",value=rgamma(1,shape=shape,rate=shape),index=c(site));
					}
					else{
						setParameterAtSites(this, process=process, id="rate.multiplier",sample(dg,size=1),index=c(site));
					}
				}
		
			}

	
		}
		return(invisible(this));	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: insertSequence
##
###########################################################################/**
#
# @RdocMethod insertSequence
# 
# @title "Insert a Sequence object into another Sequence object after a specified position" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{The target Sequence object.} 
# 	\item{insert}{The Sequence object to be inserted.} 
# 	\item{position}{The position after the Sequence object will be inserted.} 
# 	\item{process}{The Process object performing the insertion (optional).} 
# 	\item{paranoid}{If TRUE, then the consistency of teh target objects is checked more rigurously after insertion.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create some sequence objects.
#	target<-NucleotideSequence(string="AAAAAAAAAAA")
#	insert<-NucleotideSequence(string="GGGGGGGGGGG")
#	# insert after position 5
#	insertSequence(target,insert,5)
#	# print the target sequence
#	target
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "insertSequence",
  class="Sequence",
  function(
    		this,
		insert,
		position,
		process=NA,
		paranoid=FALSE,
    ...
  ){

		.checkWriteProtection(this);
		 if(!exists(x="PSIM_FAST")){

		if(missing(insert)) {
			throw("Insert sequence object is missing!\n");
		}
		else if (missing(position)) {
			throw("Insertion position is missing!\n");
		}

		if(!is.Sequence(insert)) {
			throw("Insert object not valid!\n");
		}
		else if (this$length == 0 & position != 0 ) {
			throw("Acceptor sequence length is zero! The only valid insertion position is 0!\n");	
		}
		else if ( !( position >= 0 & position <=(this$.length + 1))) {
			throw("Insertion position ",position," is invalid!\n");
		}
	        
	        }

	 # Just return if insert has zero length:	
	 if(insert$length == 0){
			warning("The length of the sequence to be inserted is zero! Nothing to do here!\n");
			return(invisible(FALSE));	
	 } 
	 # Clone insert object:
	 insert<-clone(insert);

	 # Set the generator process:
	 if(!missing(process)) {
			if( (length(process) == 0) | !is.Process(process)){
				throw("Process object invalid!\n");
			}
	 } else {
			process<-Sequence$.root.ins;
	 }
	 for(site in insert$.sites) {
				site$.ancestral<-process;
				site$.sequence<-this;
	 }

	 # Recalculate cumulative rates if the flag is on:
	 if(this$.cumulative.rate.flag) {
			.recalculateCumulativeRates(this);
	 }

	 # Flagging cumulative rates:
		this$.cumulative.rate.flag<-TRUE;

		# Inserting new site objects:

		if ( position == this$.length) {
			# Insertion at the end of the sequence;
			this$.sites<-c(this$.sites,insert$.sites);
			this$.total.rates<-c(this$.total.rates,rep(c(NA),times=insert$.length) );
			this$.cumulative.rates<-c(this$.cumulative.rates,rep(NA,times=insert$.length) );

		} else if (position == 0) {
			# Insertion in the sequence
			this$.sites<-c(insert$.sites, this$.sites);
			this$.total.rates<-c(rep(NA,times=insert$.length),this$.total.rates);
      			this$.cumulative.rates<-c(rep(NA,times=insert$.length),this$.cumulative.rates);

		} else {
			# Insertion at position 0
			this$.sites<-c(this$.sites[1:position],insert$.sites,this$.sites[(position+1):this$.length]);
			this$.total.rates<-c(this$.total.rates[1:position],rep(NA,times=insert$.length),this$.total.rates[(position+1):this$.length]);
			this$.cumulative.rates<-c(this$.cumulative.rates[1:position],rep(NA,times=insert$.length),this$.cumulative.rates[(position+1):this$.length]);

		}

	 # Checking if lengths are consistent:
	  if(!exists(x="PSIM_FAST")){	

		if(length(this$.sites) != (this$.length + insert$.length)) {
			throw("Length inconsistency after insertion!\n");
		}
	  }

	# Setting new length:	
	this$.length<-(this$.length + insert$.length);
	# Flagging the inserted sites:
		this$.flagged.sites<-c(this$.flagged.sites,(position+1):(position+insert$.length));

	 if(!exists(x="PSIM_FAST")){
		if(length(this$.total.rates) != this$.length) {
			throw("Total rates vector inconsistency after insertion!\n");
		}
		if(length(this$.cumulative.rates) != this$.length) {
			throw("Cumulative rates vector inconsistency after insertion!\n");
		}
	}

	# Recalculating cumulative rates:
		.recalculateCumulativeRates(this);

	# Paranoid check of total rates:

	if(paranoid) {	
		for (i in 1:this$.length) {
				if(this$.sites[[i]]$totalRate != this$.total.rates[[i]]) {
					throw("Object total rates inconsistent with total rates vector!\n");
				}
		}
	}

	# Deleting the insert:
	rm(insert);

	return(invisible(this));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: deleteSubSequence
##
###########################################################################/**
#
# @RdocMethod deleteSubSequence
# 
# @title "Delete a collection of sites aggregated by a Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An index vector specifying a collection of sites to be deleted. It is set to 1:seq$length if omitted.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE or errror.
# } 
# 
# \examples{
#	# create a nucleotide sequence
#	s<-NucleotideSequence(string="ATATATATATATATAT")
#	# delete sites 2, 4 and 6
#	deleteSubSequence(s,c(2,4,6))
#	s
#	# delete sites in the range 3:6
#	deleteSubSequence(s,3:6)
#	s
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "deleteSubSequence",
  class="Sequence",
  function(
    		this,
		index,
    		...
  ){
		
		if(length(index) == 0) {
			return(FALSE);
		}

		.checkWriteProtection(this);
	 	if(!exists(x="PSIM_FAST")){

		if(missing(index)) {
			 throw("No index vector specified!\n");
		}


		if(length(index) == 0) {
			return(FALSE);
		}
		
		}
			index<-.checkIndexSanity(this, index);

			# Avoid deletion on dirty sequence as
			# that will cause havoc.
			if(this$.cumulative.rate.flag){
			 .recalculateCumulativeRates(this);	
			}
			# Flagging cumulative rates:	
			this$.cumulative.rate.flag<-TRUE;
			min.index<-min(index);
			# Deleting site objects:	
			this$.sites[index]<-NULL;
			# Updating rate vectors:
			this$.total.rates<-this$.total.rates[-index];
			this$.cumulative.rates<-this$.cumulative.rates[-index];
			
			# Flag the site before the deletion to
			# to force cumulative rate recalculation:
			if (min.index > 2 ) {
				this$.flagged.sites<-c(this$.flagged.sites,(min.index - 1));
			}

		 if(!exists(x="PSIM_FAST")){
			if( length(this$.sites) != (this$.length - length(index) ) ) {
				throw("Inconsistency after deleting sites!\n");
			} 
		 }
	
			this$.length<-length(this$.sites);
			.recalculateCumulativeRates(this);	
				return(invisible(TRUE));
		

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: copySubSequence
##
###########################################################################/**
#
# @RdocMethod copySubSequence
# 
# @title "Copy a collection of Site objects aggregated by a Sequence object into a new Sequence object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Sequence object.} 
#	\item{index}{An index vector specifying a collection of sites to be copied. It is set to 1:seq$length if omitted.}
# 	\item{process}{The Process object performing the copy (optional).} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A new Sequence object.
# } 
# 
# \examples{
#	# create a nucleotide sequence
#	s<-NucleotideSequence(string="ATATATATATATATATA")
#	# copy sites in the range 3:8 in a new object
#	s2<-copySubSequence(s,3:8)
#	s2
#	# copy sites 1,3 and 5 from s2
#	s3<-copySubSequence(s2,c(1,3,5))
#	s3
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "copySubSequence",
  class="Sequence",
  function(
    		this,
		index,
		process=NA,
    		...
  ){

		if(missing(index)) {
				index<-seq(along.with=this$.sites);
		}
		else {
			index<-.checkIndexSanity(this, index);
		}

	 if(!exists(x="PSIM_FAST")){
		if(!is.na(process) & !is.Process(process)) {
			throw("Process object invalid!\n");		
		} 
	}

			# Avoid copying from dirty sequence:
			if(this$.cumulative.rate.flag){
			 .recalculateCumulativeRates(this);	
			}

			length<-length(index);

			# Create an empty sequence object:
			copy<-Sequence();

			# Flag copy cumulative rates:
			copy$.cumulative.rate.flag<-TRUE;

			if(is.na(process)){
				# Getting the root insertion process:
				process<-Sequence$.root.ins;
			}
			# Setting the ancestral to sequence:
			copy$.ancestral.obj<-process;
			
			# Setting copy name:
			copy$name<-paste("Copied from",this$name);

			# Setting length:
			copy$.length<-length;

			# Clone the sites:
			copy$.sites<-lapply(this$.sites[index],
				function(site){
					site.copy<-clone(site);
					site.copy$.ancestral<-process;
					return(site.copy);
				}
			);

			# Copy total rates:	
			copy$.total.rates<-this$.total.rates[index];

			# Create cumulative rates vector:
			copy$.cumulative.rates<-cumsum(copy$.total.rates);

			copy$.cumulative.rate.flag<-FALSE;

		 if(!exists(x="PSIM_FAST")){
			if(length(copy$.sites) != length){
				throw("Sites list length mismatch!\n")
			}
			else if(length(copy$.total.rates) != length){
				throw("Total rates vector length mismatch!\n")
			}
			else if(length(copy$.cumulative.rates) != length){
				throw("Cumulative rates vector length mismatch!\n")
			}
		}

			return(copy);
		

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);
##	
## Copyright 2009 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
# @RdocClass Site
# 
# @title "The Site class"
# 
# \description{ 
#
#	This is the class representing a site. Site objects can have one associated Alphabet object and one or 
#	more Process objects that act on their states.
#	The associated Process and Site objects must have associated Alphabet objects with the same symbols set, or
#	at least one of the Alphabet objects should inherit from the class AnyAlphabet.
#
#	Site objects store the site-process-specific parameters of the attached Process objects. 
#	A site-process-specific parameter is a list containing: the identifier, the name, the value and type of the parameter.
#	For example the ubiquitous rate multiplier site-process-specific parameter looks like 
#	\code{list(id="rate.multiplier",name="Rate multiplier",value=1,type="numeric")}.
#
#	Templates for site-process-specific parameters and their default values are stored in the Process objects and 
#	copied into the Site object when the process is attached.
#
#	Site objects have fields for associated ancestral Site objects and Sequence objects.
#
#  	@classhierarchy
# 
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{state}{A symbol belonging to the specified alphabet.}
# 	\item{alphabet}{An alphabet object.}
# 	\item{ancestral}{The ancestral Site object.}
# 	\item{processes}{A list of Process objects.}
# 	\item{sequence}{The Sequence object to which the Site object belongs.}
#	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
#               @allmethods
# }
# 
# \examples{ 
#		# create a site object
#		site<-Site();
#		# print the character representation (state)
#		print(site);
#		# get a summary
#		summary(site);
#		# create a site with a nucleotide alphabet
#		site<-Site(state="A",alphabet=NucleotideAlphabet());
#		# set site state
#		site$state<-"G"
#		# manipulate the associated Sequence object
#		site$sequence<-Sequence()
#		site$sequence
#		# attach a substitution process
#		site$processes<-list(JC69())
#		# add one more substitution process
#		attachProcess(site,K80())
#		# get a list of active Event objects
#		site$events
#		# get a summary of the Site object
#		summary(site);
# }
# 
# @author
#
#
# \seealso{ 
#		Alphabet, Process, Event
# }
# 
#*/###########################################################################
setConstructorS3(
	"Site",
	function(
		state=NA,	#
		alphabet=NA,
		ancestral=NA,
		processes=NA,
		sequence=NA,
		...
	){
	

		# Extend the PSRoot Class:
		this<-extend(
			PSRoot(),
			"Site",
			.state=NA,
			.ancestral=NA,
			.alphabet=NA,
			.processes=list(),
			.total.rate=NA,
			.sequence=NA,
			.is.site=TRUE
		);
		
		# The instance is static by default:
		STATIC<-TRUE;

		# Set alphabet if present:	
		if(!missing(alphabet)){
			this$alphabet<-alphabet;
			STATIC<-FALSE;
		}

		# Alphabet is mandatory if 
		# ancestral is present:

		if (!missing(ancestral) & missing(alphabet) & !is.Process(ancestral)) {
				throw("Ancestral object sepcified, but no alphabet is given!\n");
		}

		# Set ancestral pointer if present:	
		if(!missing(ancestral)){
			# The ancestral is a site or a process:
			if( !is.Process(ancestral) & !is.Site(ancestral)) {
					throw("The ancestral object must be a site or a process!\n");	
			} else {
				this$.ancestral<-ancestral;
				STATIC<-FALSE;
			}
		}

		# Set state if present,
		# complain if no alphabet is specified:
		if (!missing(state)) {
				STATIC<-FALSE;
				if(!missing(alphabet)){
					this$state<-state;
				} else { throw("The state is specified, but no alphabet is given!\n"); }
		}
	
		# Set the processes:		
		if(!missing(processes)){	
			this$processes<-processes;
		}
		

		# Set the parent sequence if present:		
		if(!missing(sequence)){	
			this$sequence<-sequence;
		}

		# Calculate total rate given the state
		# and the processes:
		if(!STATIC){ 
			if(!is.na(this$.state)) {
				.recalculateTotalRate(this);
			}
			.checkConsistency(this);
		}

		# Return the Site object:
		return(this);
	},
	enforceRCC=TRUE
);

##	
## Method: is.Site
##	
###########################################################################/**
#
# @RdocDefault is.Site
# 
# @title "Check if an object is an instance of the Site class" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{An object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	
#	# create an object
#	s<-Site();
#	# check whether is a Site object
#	is.Site(s)
#	# the same with an Event object
#	is.Site(Event());
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"is.Site", 
	class="default", 
	function(
		this,
		...
	){

    if(!is.PSRoot(this)) {return(FALSE)}
		if(!is.null(this$.is.site)){return(TRUE)}
    if ( inherits(this, "Site")) {
			this$.is.site<-TRUE;
			return(TRUE);
		} else {
			return(FALSE)
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .checkConsistency
##	
setMethodS3(
	".checkConsistency", 
	class="Site", 
	function(
		this,
		...
	){
			message<-"Site state is inconsistent! ";		

			# If the ancestral object is a site:	
			if (is.Site(this$.ancestral)) {
				
					#Check if the alphabets match:		
					# Warning: using the '!='.Alphabet here!
					if( this$alphabet != this$ancestral$alphabet ) {
						throw(message, "The ancestral alphabet and the site alphabet is different!\n");
					}
			} else if (is.Process(this$.ancestral)) { 
					# Hook for checking the process object;
					# print(this$.ancestral)			
			} else if (!is.na(this$.ancestral)){
					throw("Ancestral object is invalid!\n");
			}
			
			# Check if the total rate is numeric or NA:
			if(is.null(this$.total.rate)) {
				throw("The total rate is NULL!\n");
			}
			if (!is.numeric(this$.total.rate) && !is.na(this$.total.rate)) {throw(message,"The total rate is not numeric!\n")}
				
			return(invisible(TRUE));
				

	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## 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="Site", 
	function(
		this,
		...
	){

			#cat("Checking site consistency ...\n");
			# Reassigning the values by virtual fields.
			# The methods should complain if something is wrong.
			# Slow but maybe elegant.

			if(is.null(this$.alphabet)) {
				throw("Site alphabet is NULL!\n");
			}
			else if(!is.na(this$.alphabet)) {
				this$.alphabet<-this$.alphabet;
			}

			
			if(is.null(this$.ancestral)) {
				throw("Ancestral object is NULL!\n");
			}
			
			if(is.null(this$.processes)) {
				throw("Process list is NULL!\n");
			}
			else {
				this$processes<-this$processes;
			}
			
			.checkConsistency(this);
			
			lapply(
				this$.processes,
				function(p) {
						# Even more paranoid check is possible here!
						.checkSiteSpecificParamList(p$object,plist=p$site.params);
				}
			);
			return(invisible(TRUE));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);



##	
## Method: getState
##	
###########################################################################/**
#
# @RdocMethod getState
# 
# @title "Get the current state of a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one contaning the state (a symbol belonging to the attached Alphabet object).
# } 
# 
# \examples{
#	
#	# create a Site object with an Alphabet object attached
#	s<-Site(alphabet=Alphabet(symbols=c(0,1)), state=1);
#	# get current state
#	getState(s)
#	# get state via virtual field
#	s$state
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getState", 
	class="Site", 
	function(
		this,
		...
	){
	
		this$.state;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setState
##	
###########################################################################/**
#
# @RdocMethod setState
# 
# @title "Set the state of a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{new.state}{A character vector of length one, containing a symbol belonging to the attached Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Returns the new state (invisible).	
# } 
# 
# \examples{
#
#       # create a Site object with an Alphabet object attached
#       s<-Site(alphabet=Alphabet(symbols=c(0,1)), state=1);
#       # set a new state 
#       setState(s,"0")
#       # get state via virtual field
#       s$state
#       # set a new state via virtual field
#       s$state<-1
#	s$state
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setState", 
	class="Site", 
	function(
		this,
		new.state,
		...
	){
		
		new.state<-as.character(new.state);	

		 if(!exists(x="PSIM_FAST")){

		# Check if new.state is scalar:
		if (length(new.state) != 1 ){throw("The state must be a vector of length 1!\n")}
		# Check if the site has an alphabet attached:
		else if(is.na(this$alphabet)) {throw("Cannot set state because the site has no alphabet attached!\n")}
		# Check if symbol is in the site alphabet:	
		else if( !hasSymbols(this$.alphabet,new.state)) {throw("Symbol not in site alphabet!\n")}

		}

		this$.total.rate<-NA;
		
		if(!is.na(this$.sequence)){
		this$.sequence$.cumulative.rate.flag<-TRUE;
		}
		this$.state<-new.state;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAlphabet
##	
###########################################################################/**
#
# @RdocMethod getAlphabet
# 
# @title "Get the Alphabet object attached to a Site object" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An Alphabet object.
# } 
# 
# \examples{
#	
#	# create a site object
#	s<-Site()
#	# create an Alphabet object
#	a<-Alphabet(c("A","T","G"))
#	# attach alphabet to site object
#	setAlphabet(s,a)
#	# get attached alphabet
#	getAlphabet(s)
#	# get attached alphabet via virtual field
#	s$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAlphabet", 
	class="Site", 
	function(
		this,
		...
	){
	
		this$.alphabet;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAlphabet
##	
###########################################################################/**
#
# @RdocMethod setAlphabet
# 
# @title "Attach an Alphabet object to a Site object" 
# 
# \description{ 
#	@get "title".
#	If the ancestral site is not NA, then the symbol set of the ancestral Alphabet object and the new Alphabet 
#	object must be the same. The current state must be in the symbol set of the new Alphabet object, unless it is NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{new.alphabet}{A valid Alphabet object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Returns the new Alphabet object (invisible).
# } 
# 
# \examples{
#	
#	# create a site object
#	s<-Site()
#	# create an Alphabet object
#	a<-Alphabet(c("A","T","G"))
#	# attach alphabet to site object
#	setAlphabet(s,a)
#	# set site state
#	s$state<-"A"
#	# clone the alphabet object
#	b<-clone(a)
#	# modify symbol set in b
#	b$symbols<-c(b$symbols,"C")
#	# attach b to s via virtual field
#	s$alphabet<-b
#	s$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAlphabet", 
	class="Site", 
	function(
		this,
		new.alphabet,
		...
	){
	
	 if(!exists(x="PSIM_FAST")){	

		if(!is.Alphabet(new.alphabet)){
				throw("The supplied alphabet object is not valid!\n");
		} else if (is.Site(this$.ancestral)) {
				if (this$.ancestral$alphabet != new.alphabet) {
							throw("The alphabet is not equivalent with the ancestral alphabet!\n");
					}
		} 
		else if(!is.na(this$.state) & !hasSymbols(new.alphabet, this$.state)){
			throw("The current state is not part of the new alphabet!\n");
		}

		}
		
		this$.total.rate<-NA;
		if(!is.na(this$.sequence)){
		this$.sequence$.cumulative.rate.flag<-TRUE;
		}
		this$.alphabet<-new.alphabet;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .setAlphabetSloppy
##	
setMethodS3(
	".setAlphabetSloppy", 
	class="Site", 
	function(
		this,
		new.alphabet,
		...
	){
	
		this$.alphabet<-new.alphabet;
		return(invisible(new.alphabet));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAncestral
##	
###########################################################################/**
#
# @RdocMethod getAncestral
# 
# @title "Get the ancestral object of a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Site object, a Process object or NA.
# } 
# 
# \examples{
#	a<-Alphabet();
#	# create some site object
#	s1<-Site(alphabet=a)
#	s2<-Site(ancestral=s1, alphabet=a)
#	# get ancestral objects
#	getAncestral(s1)
#	s2$ancestral
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAncestral", 
	class="Site", 
	function(
		this,
		...
	){
		
		this$.ancestral;
		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAncestral
##	
###########################################################################/**
#
# @RdocMethod setAncestral
#
# @title "Forbidden action: setting the ancestral object for a Site object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{A Site object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setAncestral", 
	class="Site", 
	function(
		this,
		value,
		...
	){
		
		throw("You should never try to modify directly the ancestral attribute!\n");		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .recalculateTotalRate
##	
setMethodS3(
	".recalculateTotalRate", 
	class="Site", 
	function(
		this,
		...
	){

if(!is.na(this$.state)){
  total.rate<-0;	
  proc<-this$.processes;
  for (p in lapply(names(proc),function(id){proc[[id]][["object"]]})) {
                                for(e in getEventsAtSite(p, this)){
					total.rate<- total.rate + e$.rate;
                                }
  }
			
  this$.total.rate<-total.rate	

}
	},
	private=TRUE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getTotalRate
##	
###########################################################################/**
#
# @RdocMethod getTotalRate
# 
# @title "Get the total active event rate" 
# 
# \description{ 
#	@get "title".
#	The total rate is the sum of the rates of all active events given the current state of the Site object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A numeric vector of length one.
# } 
# 
# \examples{
#
#	# create a nucleotide site with a JC69 substitution process attached
#       s<-Site(state="A",alphabet=NucleotideAlphabet(),processes=list(JC69()))
#       # get the total rate
#	getTotalRate(s)
#       # add a new process
#       attachProcess(s,K80(rate.params=list("Alpha"=1,"Beta"=0.5)))
#       # get the total rate via virtual field
#       s$totalRate
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getTotalRate", 
	class="Site", 
	function(
		this,
		...
	){

		tr<-this$.total.rate;		
		if(is.na(tr)) {
			.recalculateTotalRate(this);
			return(this$.total.rate);
		} else {
			return(tr);
		}

		
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setTotalRate
##	
###########################################################################/**
#
# @RdocMethod setTotalRate
#
# @title "Forbidden action: setting the total active event rate for a Site object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setTotalRate", 
	class="Site", 
	function(
		this,
	  	value,	
		...
	){
		
		throw("You should never try to set the totalRate directly!\n");	

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: flagTotalRate
##	
###########################################################################/**
#
# @RdocMethod flagTotalRate
# 
# @title "Flag the total event rate" 
# 
# \description{ 
#	@get "title".
#	This method sets the cached total active event rate to NA, which will trigger its
#	recalculation when next accessed via getTotalRate.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible NA.
# } 
# 
# \examples{
#	# create a site object:
#	p<-K80(rate.params=list("Alpha"=2,"Beta"=0.5))
#	s<-Site(alphabet=NucleotideAlphabet(), state="G", processes=list(p))
#	# get site rate
#	s$totalRate
#	# modifying site object in a dangerous way (do not do this under any circumstances!)
#	s$.processes = list()	# site object is now inconsistent!
#	# get cached rate
#	s$totalRate		# incorrect value 
#	# flag total rate
#	flagTotalRate(s)
#	# get site rate
#	s$totalRate		# correct value
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"flagTotalRate", 
	class="Site", 
	function(
		this,
		...
	){
		
		# Setting .total.rate to NA,
		# this will force recalculation
		# when next accessed.	
		this$.total.rate<-NA;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEvents
##	
###########################################################################/**
#
# @RdocMethod getEvents
# 
# @title "Get the list of active event objects given the current state of the Site object" 
# 
# \description{ 
#	@get "title".
#	The list of active event object might change according to the state of the Site object.	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of event objects.
# } 
# 
# \examples{
#	# create a site object with a JC69 substitution process attached
#	s<-Site(alphabet=NucleotideAlphabet(), state="A",processes=list(JC69()))
#	# get the list of active event objects
#	getEvents(s)
#	# modify site state
#	s$state<-"T"
#	# get the list of active event objects via virtual field
#	s$events
#	
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEvents", 
	class="Site", 
	function(
		this,
		...
	){

		procs<-lapply(names(this$.processes),function(id){this$.processes[[id]][["object"]]});

		tmp<-list();
		for (p in procs) {
				tmp<-c(tmp,getEventsAtSite(p, this));
		}
		return(tmp);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

setMethodS3(
	".getEventRates", 
	class="Site", 
	function(
		this,
		...
	){

	tmp<-double();
	for (p in lapply(names(this$.processes),function(id){this$.processes[[id]][["object"]]})) {
				for(e in getEventsAtSite(p, this)){
					tmp<-c(tmp,e$.rate);
				}
	}
	return(tmp);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setEvents
##	
###########################################################################/**
#
# @RdocMethod setEvents
#
# @title "Forbidden action: setting the list of active events for a Site object"
#
# \description{
#       @get "title".
# }
#
# @synopsis
#
# \arguments{
#       \item{this}{An object.}
#       \item{value}{Not used.}
#       \item{...}{Not used.}
# }
#
# \value{
#	Throws an error.
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"setEvents", 
	class="Site", 
	function(
		this,
		value,
		...
	){
			virtualAssignmentForbidden(this);
	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getSequence
##	
###########################################################################/**
#
# @RdocMethod getSequence
# 
# @title "Get the Sequence object associated with a given Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Sequence object or NA.
# } 
# 
# \examples{
#	# create a site object
#	s<-Site(sequence=Sequence())
#	# get the associated Sequence object
#	getSequence(s)
#	# get the associated Sequence object via virtual field	
#	s$sequence
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getSequence", 
	class="Site", 
	function(
		this,
		...
	){

		this$.sequence;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setSequence
##	
###########################################################################/**
#
# @RdocMethod setSequence
# 
# @title "Assotiate a Sequence object with a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{new.seq}{A valid Sequence object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Sequence object (invisible).
# } 
# 
# \examples{
#	# create a site object
#	s<-Site()
#	# get associated Sequence object
#	s$sequence
#	# set associated Sequence object
#	setSequence(s,Sequence())
#	s$sequence
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setSequence", 
	class="Site", 
	function(
		this,
		new.seq,
		...
	){

	 if(!exists(x="PSIM_FAST")){
		if(!is.Sequence(new.seq)) {
			throw("Sequence object invalid!\n");
		} 
	}
		
		this$.sequence<-new.seq;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
##	
## Method: as.character
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Get the character representation of a Site object" 
# 
# \description{ 
#	@get "title".
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one containing the current state.
# } 
# 
# \examples{
#	# create site object
#	s<-Site(alphabet=NucleotideAlphabet(),state="A")
#	# get character represenation
#	x<-as.character(s)
#	x
#
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character", 
	class="Site", 
	function(
		x,
		...
	){

		x$.state;		

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: summary.Site
##	
###########################################################################/**
#
# @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
#       o<-Site()
#       # get a summary
#       summary(o)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="Site", 
	function(
		object,
		...
	){
			this<-object;
			this$.summary$"State"=this$state;
			if(!is.na(this$alphabet)) {
			alphabet_symbols = paste(this$alphabet$symbols,collapse=" ");
			this$.summary$"Alphabet"=paste("\n","  Type: ",this$alphabet$type,"\n","  Symbols: ", alphabet_symbols,sep="");
			} else {
				this$.summary$"Alphabet"=NA
			}
			
			attached_processes<-this$processes;
			header<-paste("Attached processes (",length(attached_processes),")",sep="");
			tmp<-character(0);

			for (p in attached_processes) {
				tmp<-paste(tmp,"\n ",p$id)
			}		

			this$.total.rate<-NA;
			if(!is.na(this$.sequence)){
		 	this$.sequence$.cumulative.rate.flag<-TRUE;
			}

			this$.summary[[header]]<-tmp;
			
			tmp<-character(0);
			for (e in this$events) {
				tmp<-paste(tmp,"\n ");
				tmp<-paste(tmp,"Name:",e$name);
				tmp<-paste(tmp," Rate:",e$rate);
				tmp<-paste(tmp," Process:",e$process$id);
			}
			this$.summary$"Active events"<-tmp;

			this$.summary$"Total rate"<-getTotalRate(this);
	
			if(!is.na(this$sequence)){
				this$.summary$"Part of sequence"<-this$sequence$id;
			}

			if(is.Process(this$ancestral)) {
					this$.summary$"Directly inserted by"<-this$ancestral$id;
			} else if (is.Site(this$ancestral)) {
					this$.summary$"Ancestral state"<-this$ancestral$state;
			} else if (!is.na(this$ancestral)){
					throw("summary.Site detected inconsistent state!\n");

			}

			NextMethod();

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
	);

##
## Method: isAttached
##
###########################################################################/**
#
# @RdocMethod isAttached
# 
# @title "Check whether a Process object is attached to a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{process}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a Site object
#	s<-Site(alphabet=NucleotideAlphabet())
#	# create a Process object
#	p<-JC69()
#	# check if p is attached to s
#	isAttached(s,p)
#	# attach p to s
#	s$processes<-list(p)
#	isAttached(s,p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	Site Process attachProcess detachProcess getProcesses setProcesses
# } 
# 
#*/###########################################################################
setMethodS3(
  "isAttached",
  class="Site",
  function(
    this,
    process,
    ...
  ){
			

	 if(!exists(x="PSIM_FAST")){
		if (!is.Process(process)) {throw("Process object invalid!\n")}	
	 }
		attached_processes<-getProcesses(this);
		if (length(attached_processes) == 0 ){ return(FALSE)}
			
		tmp<-lapply(
			attached_processes,
			function(proc) { equals(proc, process)}
		);	
			tmp<-unique(tmp);
			
			if(length(tmp) == 1 ) {
					# If we have only one process attached,
					# than simply return the result of the equals() function.
					return(tmp[[1]]);
			} else {
					
					# Additional check to make sure that the .process entry is here.	
					#	if (length (intersect(class(this$.processes[[getId(process)]]),"list")) == 0) {
					#		throw("Something evil is happening! The process is attached, but the .process entry is invalid!\n");
					#	}

					# If length(tmp) > 1, than one of its elements must be TRUE,
					# so returning TRUE.
					return(TRUE);
			}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );

##
## Method: attachProcess
##
###########################################################################/**
#
# @RdocMethod attachProcess
# 
# @title "Attach a Process object to a Site object" 
# 
# \description{ 
#	@get "title".
#
#	The Alphabet objects associated with the Site and Process objects must have the same symbol set, or at least one
#	of them should inherit from the class AnyAlphabet. 
#
#	During the attachment, the site-process specific parameter templates are copied from the Process object and 
#	stored in the Site object.
#	The Process objects are marked as write protected if the attachment was succesful. 
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{process}{A Process object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
#	The Site object (invisible).
# } 
# 
# \examples{
#	# create a Site object and the associated NucleotideAlphabet object
#	s<-Site(alphabet=NucleotideAlphabet())
#	# create a K80 substitution process
#	p<-K80()
#	# attach p to s
#	attachProcess(s,p)
#	# get the list of attached processes
#	s$processes
#	# check write protection for p
#	p$writeProtected
# } 
# 
# @author 
# 
# \seealso{ 
# 	Site Process detachProcess setProcesses getProcesses isAttached
# } 
# 
#*/###########################################################################
setMethodS3(
  "attachProcess",
  class="Site",
  function(
    this,
    process,
    ...
  ){

		if(isAttached(this,process)) {
				warning("Process already attached, doing nothing!\n");
				return(invisible(this)); 
		}
	 if(!exists(x="PSIM_FAST")){
	
		if(!is.Process(process)) {
			throw("Process object is not valid!\n"); }
		else if( is.na(process$alphabet) ){
				throw("The process has no alphabet attached!\n"); }
		else if( is.na(this$alphabet) ){
				throw("The site has no alphabet attached!\n"); }
		else if (this$alphabet != process$alphabet) {
				throw("The site and process alphabets are incompatible!\n"); 
		}
		else if( hasUndefinedRate(process) ){
				warning("The process",process$id," has undefined rates!\n");
		}

		}
		
		this$.processes[[process$id]]<-list (
				object	= process,
				# We copy the default site-process specific parameters
				# from the process object.
				site.params = process$siteSpecificParamList	
			);
		this$.total.rate<-NA;
		
		if(!is.na(this$.sequence)){
		this$.sequence$.cumulative.rate.flag<-TRUE;
		}
		
		# The user should not modify the process
		# after is attached to a site!
		process$writeProtected<-TRUE;	
		invisible(this);
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );

##
## Method: .attachProcessSloppy
##
setMethodS3(
  ".attachProcessSloppy",
  class="Site",
  function(
    this,
    process,
    ...
  ){
	
		if(isAttached(this,process)) {
				warning("Process already attached, doing nothing!\n");
				return(invisible(this)); }
		else {
			this$.processes[[process$id]]<-list (
				object 				= 	process,
				# We copy the default site-process specific parameters
				# from the process object.
				site.params		=		process$siteSpecificParamList	
			);
		}
		this$.total.rate<-NA;
		if(!is.na(this$.sequence)){
		this$.sequence$.cumulative.rate.flag<-TRUE;
		}
		
		# The user should not modify the process
		# after is attached to a site!
		process$writeProtected<-TRUE;	
		invisible(this);

  },
  private=TRUE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );

##
## Method: detachProcess
##
###########################################################################/**
#
# @RdocMethod detachProcess
# 
# @title "Site" 
# 
# \description{ 
#	@get "title".
#	The site-process specific parameters stored in the Site object and belonging to the detached Process objects will be destroyed.
#	
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object} 
# 	\item{process}{A Process object} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Site object (invisible).
# } 
# 
# \examples{
#	# create a Site objects and attach some processes
#	s<-Site()
#	s$alphabet<-NucleotideAlphabet()
#	p1<-JC69(); p2<-K80()
#	attachProcess(s,p1)
#	attachProcess(s,p2)
#	# get the list of attached processes
#	s$processes
#	# detach p1
#	detachProcess(s,p1)
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "detachProcess",
  class="Site",
  function(
    this,
    process,
    ...
  ){
			
	 if(!exists(x="PSIM_FAST")){
		if(!is.Process(process)) {
			throw("Process object is not valid!\n");
		}
	}
		else if (!isAttached(this,process)) {
				warning("Process is not attached, doing nothing!\n");
		}
		
		# Setting the list entry to NULL,
		# so it will wanish from the list.
		this$.processes[[process$id]]<-NULL;
	
		this$.total.rate<-NA;
		if(!is.na(this$.sequence)){
		this$.sequence$.cumulative.rate.flag<-TRUE;
		}
		invisible(this);
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );

##
## Method: setProcesses
##
###########################################################################/**
#
# @RdocMethod getProcesses
# 
# @title "Get the list of Process objects attached to a Site object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of Process objects.
# } 
# 
# \examples{
#	# create a Site object with some processes attached
#	s<-Site(alphabet=NucleotideAlphabet(),processes=list(K80(),JC69()))
#	# get list of attached Process objects
#	getProcesses(s)
#	# get list of attached Process objects via virtual field
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getProcesses",
  class="Site",
  function(
    this,
    ...
  ){
  
		lapply(names(this$.processes),function(id){this$.processes[[id]][["object"]]});
		
	},
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );

##
## Method: setProcesses
##
###########################################################################/**
#
# @RdocMethod setProcesses
# 
# @title "Specify the list of Process objects attached to a Site object" 
# 
# \description{ 
#	@get "title".
#	The Process objects in the "value" list correspond to the set of processes to be attached to the Site object.
#       Process objects already attached to a given Site are skipped. Attached processes which are not memebers of the list
#       are detached, so specifying an empty list will detach all processes.
#
#	This method is an alternative to \code{attachProcess.Site} and \code{detachProcess.Site}, working with 
#	more than one process object.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A Site object.} 
#	\item{value}{A list of valid Process objects.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Site object (invisible).
# } 
# 
# \examples{
#	# create a Site object
#	s<-Site(alphabet=NucleotideAlphabet())
#	# create some processes
#	p1<-JC69(); p2<-K80(); p3<-DiscreteInsertor(rate=1);	
#	# attach the processes
#	setProcesses(s,list(p1,p2,p3))
#	# attach one more process via virtual field
#	s$processes<-c(s$processes,list(GTR()))
#	# get the list of attached processes
#	s$processes
#	# detach all processes via virtual field
#	s$processes<-list()
#	s$processes
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setProcesses",
  class="Site",
  function(
    this,
    value,
    ...
  ){

		if(missing(value)) {throw("No new value given!\n")}
		value<-as.list(value);
	
		# All the top-level elements must be Process instances!	
		for(i in value) {
			if(!is.Process(i)){
					throw("The accepted argument is a list of processes!\nVectors and lists are not euivalent, take care!\n");
			}
		}
		attached<-getProcesses(this);
		
		# Sadly we cannot use set operations directly here
		# beacuse we lose the object references.
		
		to.attach<-list();
		to.detach<-list();
		the.rest<-list();
		
		for (i in value) {
				if (!isAttached(this,i)) {
					to.attach<-c(to.attach,list(i));
				} else {
					the.rest<-c(the.rest,list(i));
				}
		}		
		
		for (i in attached) {
				in.the.rest<-FALSE;
				for (j in the.rest) {
					if (i == j)	{
						in.the.rest<-TRUE;
						break;
					}
				} # /for j
				if(!in.the.rest) {
					to.detach<-c(to.detach,list(i));	
				}
		} # /for i				
	
	
		lapply(to.detach, function(process) {detachProcess(this,process)});
		lapply(to.attach, function(process) {attachProcess(this,process)});
	
		invisible(this);
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );

##
## Method: .setProcessesSloppy
##
setMethodS3(
  ".setProcessesSloppy",
  class="Site",
  function(
    this,
		value,
    ...
  ){

		value<-as.list(value);
	
		# All the top-level elements must be Process instances!	
		attached<-getProcesses(this);
		
		# Sadly we cannot use set operations directly here
		# beacuse we lose the object references.
		to.attach<-list();
		to.detach<-list();
		the.rest<-list();
		
		for (i in value) {
				if (!isAttached(this,i)) {
					to.attach<-c(to.attach,list(i));
				} else {
					the.rest<-c(the.rest,list(i));
				}
		}		
		
		for (i in attached) {
				in.the.rest<-FALSE;
				for (j in the.rest) {
					if (i == j)	{
						in.the.rest<-TRUE;
						break;
					}
				} # /for j
				if(!in.the.rest) {
					to.detach<-c(to.detach,list(i));	
				}
		} # /for i				
	
	
		lapply(to.detach, function(process) {detachProcess(this,process)});
		lapply(to.attach, function(process) {.attachProcessSloppy(this,process)});
	
		invisible(this);
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
  );
##	
## Copyright 2014 Botond Sipos	
## See the package description for licensing information.	
##	
##########################################################################/** 
#
# @RdocClass ToleranceSubstitution
# 
# @title "The ToleranceSubstitution class"
# 
# \description{ 
#	This a class representing a continuous-time Markov process acting
#	on the state space defined by the symbols stored in the Alphabet object
#	passed to the object constructor. 
#
#   In contrast to GeneralSubstitution, the ToleranceSubstitution class has a site-specific 
#   substitution tolerance parameter ("substitution.tolerance") which determines the probability of
#   accepting the proposed events. As a consequence, the branch lengths inferred from
#   the simulated data will no longer correspond to the neutral expectations unless 
#   all tolerance values are equal to 1. 
#
#	@classhierarchy
# }
#	
# @synopsis
#	
# \arguments{
# 	\item{name}{The name of the object.}
#	\item{alphabet}{The alphabet on which the process acts (Alphabet object).}
#	\item{rate.list}{A list with the substitution rates. It will be passed to \code{setRateList} method.}
#	\item{equ.dist}{The equilibrium distribution (see \code{setEquDist.ToleranceSubstitution}).}
# 	\item{...}{Not used.}
#	}
# 
# \section{Fields and Methods}{ 
# 	@allmethods
# }
# 
# \examples{ 
# # construct a GTR process object, we will use this to fill in the rates
# # for the ToleranceSubstitution process.
# gtr         <- GTR(
#       name="MyGTR",
#           rate.params=list(
#               "a"=1, "b"=2, "c"=3,
#                   "d"=1, "e"=2, "f"=3
#           ),
#           base.freqs=c(2,2,1,1)/6
#   )
# rate.list.gtr   <- gtr$rateList
# 
# # Construct the ToleranceSubstitution process.
# p   <- ToleranceSubstitution(
#     name        = "MyTolSubst",
#     alphabet    = NucleotideAlphabet(),
#     rate.list   = rate.list.gtr,
# )
# 
# plot(p)
# 
# # construct root sequence object
# s<-NucleotideSequence(length=20)
# 
# # attach process 
# attachProcess(s,p)
# 
# # sample states from the equilibrium
# # distribution of the attached processes
# sampleStates(s)
# 
# ## Set the substitution tolerance parameters for some sites:
# setParameterAtSites(s, p, "substitution.tolerance",c(0,0.05,0.1),1:3)
# 
# ## Plot the substitution tolerance parameters across sites:
# plotParametersAtSites(s,p,"substitution.tolerance")
# 
# # Construct simulation object:
# sim <-PhyloSim(root.seq=s, phylo=rtree(3))
# 
# # Run simulation:
# Simulate(sim)
# 
# # Plot alignment:
# plot(sim)
#
# }
# 
# @author
#
# \seealso{ 
# 	Process QMatrix Event Site GeneralIndel GTR WAG
# }
# 
#*/###########################################################################
setConstructorS3(
  "ToleranceSubstitution",
  function( 
		name="Anonymous", 
		alphabet=NA,
		rate.list=NA,	
		equ.dist=NA,
		... 
		)	{

	
		# Set an empty alphabet by default
		# to satisfy the static instance:
		if(missing(alphabet)){
			alphabet<-Alphabet(name="Undefined");
		}

		this<-Process(
			name=name,
			alphabet=alphabet
		);
    		this<-extend(
            this,
            "ToleranceSubstitution",
			.q.matrix=NA,
			.equ.dist=NA,
			.handler.template=NA,
			.is.general.substitution=TRUE
    		);

        # Adding insertion tolerance parameter.
        .addSiteSpecificParameter(
          this,
          id="substitution.tolerance",
          name="Substitution tolerance parameter",
          value=as.double(1), # Accept all by default
          type="numeric"
        ); 

        # Accept/reject substitution events based on the site specific tolerance parameter:
        this$.accept.by <- function(process=NA, site=NA){

            accept.prob<-getParameterAtSite(process, site, "substitution.tolerance")$value;
            # Accept/reject:
            return( sample(c(TRUE,FALSE),replace=FALSE,prob=c(accept.prob,(1-accept.prob)),size=1) );
        }
        ### 


		# Initialize with NA-s equDist:
		if (missing(equ.dist)){
			.initEquDist(this);
		} else {
			# or set if we have one:
			this$equDist<-equ.dist;
		}

		# Create the QMatrix object:
		qm<-QMatrix(name=name, alphabet=alphabet);
	
		# Set the rates:	
		if(!missing(rate.list)){
			qm$rateList<-rate.list;
		}
		
		# Attach the QMatrix to the process:
		this$.q.matrix<-qm;
		this$.q.matrix$process<-this;

		# Try to guess the equlibrium distribution:
		if (missing(equ.dist) & !missing(rate.list)){
			if(.setEquDistFromGuess(this)){
				# and perfrom rescaling if suceeded:
				rescaleQMatrix(this);
			}
		}

		# Using virtual field to clear Id cache:
		this$name<-name;

		# Set the template for handling substitution events:
		this$.handler.template<-function(event=NA){
                accepted <- FALSE
                if(this$.accept.by(event$.process, event$.site)){
                    # Just set the new state base on the event name.
                    # The name *should* be valid and correct, so no more checking is needed.
                    setState(event$.site, strsplit(event$.name,split="->",fixed=TRUE)[[1]][[2]]);
                    # Mark the event as accepted:
                    accepted <- TRUE
                }

				# Return details:
				return(
					list(
						type        =   "substitution",
                        accepted    =   accepted
					)
				);	
		}	

        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="ToleranceSubstitution", 
	function(
		this,
		...
	){

      wp<-this$writeProtected;
      if (wp) {
        this$writeProtected<-FALSE;
      }

      may.fail<-function(this) {
			
			# The process must have a valid alphabet object:	
			if(!is.Alphabet(this$.alphabet)){
				throw("Alphabet object is invalid!\n");
			}
		
			# Name:
			if(!is.na(this$name)){
				this$name<-this$name;
			}
		
			# EquDist:
			if(!any(is.na(this$.equ.dist))){
				this$equDist<-this$equDist;
			}
			# Negative rates are impossible:
			if(all(!is.na(this$rateList)) & any(as.numeric(this$rateList) < 0 )){
				throw("The rate matrix has negative off-diagonal elements!\n");	
			}
			
			# QMatrix should never be NA!
			this$QMatrix<-this$QMatrix;
		
			# Further checks if survived the one above:
			checkConsistency(this$.q.matrix,check.process=FALSE);

			if(is.Process(this$.q.matrix$.process)){
              		# Check for alphabet compatibility:
              		if(this$.alphabet != this$.q.matrix$.process$alphabet){
                		throw("Process/QMatrix alphabet mismatch!\n");
              		}
              		# Check if the parent process QMatrix is this object:
              		if(!equals(this$.q.matrix$.process, this) ){
                		throw("QMatrix process is not identical with self!\n");
              		}
			} else if(!is.na(this$.q.matrix$.process)){
					throw("QMatrix process entry is invalid!\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: getEventsAtSite
##	
###########################################################################/**
#
# @RdocMethod	getEventsAtSite
# 
# @title "Generate the list of active Event objects for a given attached Site object" 
# 
# \description{ 
#	@get "title".
#	
#	This is the single most important method in the \code{ToleranceSubstitution} class. It generates a list of the active
#	Event objects given the transition rate matrix (Q matrix) and the "rate.multiplier" Site-Process specific parameter.
#	It returns an empty list if the state of the site is "NA".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{target.site}{A Site object. The ToleranceSubstitution object must be attached to the Site object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of the active Event objects.
# } 
# 
# \examples{
#	# create an Alphabet object
#	a<-BinaryAlphabet()
#	# create a Site object
#	s<-Site(alphabet=a);
#	# create a ToleranceSubstitution object
#	p<-ToleranceSubstitution(alphabet=a,rate.list=list("0->1"=1,"1->0"=1))
#	# attach process p to site object s
#	attachProcess(s,p)	
#	# get the rate of active events
#	getEventsAtSite(p,s)	# empty list
#	# set the state of s
#	s$state<-1;
#	# get the rate of active events
#	getEventsAtSite(p,s)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventsAtSite", 
	class="ToleranceSubstitution", 
	function(
		this,
		target.site,
		...
	){

	# The main method of this class,
	# generating a list of event objects given the 
	# state of the target site.
	if(!exists(x="PSIM_FAST")){
	
	if(missing(target.site)) {
      		throw("No target site provided!\n");
    	} 
	
	}
	
	# The following code is commented out to
	# increase speed
		
	#else if (!sloppy) {
	# Additional checks. They can be
	# disabled by sloppy=TRUE			

      	#if(!is.Site(target.site)) {
      	#  throw("Target site invalid!\n");
      	#}
	#else if(!is.QMatrix(this$.q.matrix)){
	#	throw("Cannot provide event objects because the rate matrix is not set!\n");	
	#}
	#else if(!is.numeric(this$.equ.dist)){
	#	throw("Cannot provide event objects because the equilibrium frequencies are not defined!\n");	
	#} 
	#} 

	state<-as.character(target.site$.state);
	# Just return an empty list if the state is NA:
	if(is.na(state)){
		return(list());
	}
	
	# The rate of the event is the product of the general rate and the
     	# site specific rate multiplier:
     	rate.multiplier<-target.site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value;
		
	# Return empty list if the rate multiplier is zero.
     	if(rate.multiplier == 0 ) {
      		return(list());
     	}	
	
	# Get rate matrix:
	rate.matrix<-this$.q.matrix$.rate.matrix;

	symbols<-this$.alphabet$.symbols;
	rest<-symbols[ which(symbols != state) ];

	# Create the event objects:
	events<-list();
	for(new.state in rest){
		
		name<-paste(state,new.state,sep="->");
	 	# Clone the event template object:
     		event<-clone(this$.event.template);
     		# Set event name:
     		event$.name<-name;
     		# Set the generator process:
     		event$.process<-this;
     		# Set the target position passed in a temporary field,
		# Event objects are not aware of their posiitions in general!
     		event$.position<-target.site$.position;
     		# Set the target site:
     		event$.site<-target.site;
			
		# Set the event rate:	
		event$.rate<-(rate.multiplier * (rate.matrix[state,new.state]));
		# Set the handler for the substitution event:
     		event$.handler<-this$.handler.template;
		
		# Add to events list:	
		events<-c(events, list(event));

	}

	return(events);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: setEquDist
##
###########################################################################/**
#
# @RdocMethod setEquDist
#
# @title "Set the equilibrium distribution for a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	In the case the equlibrium distribution cannot be guessed from the rate matrix one should provide
#	a valid equilibrium distribution. The equilibrium distribution must be compatible with the rate matrix.
#	The provided numeric vector will be resacled in the case the sum of the elemnts is not one.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{value}{A numeric vector containing the equlibrium symbol frequencies. The order of the frequencies must be the same as in the symbol vector of the attached Alphabet object.}
#	\item{force}{Do not check compatibility with thr rate matrix.}
#	\item{silent}{Do not print out warnings.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new equlibrium distribution (invisible).
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(
#                           alphabet=BinaryAlphabet(),
#                           rate.list=list("1->0"=1,"0->1"=1)
#                           )
#	# get equlibrium distribution 
#	getEquDist(p)
#	# get equilibrium distribution via virtual field
#	p$equDist
#	# re-set the equilibrium distribution
#	dist<-p$equDist * 3
#	dist
#	setEquDist(p,dist)
#	p$equDist
#	# re-set equilibrium distribution via virtual field
#	p$equDist<-p$equDist * 2
#	p$equDist
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "setEquDist",
  class="ToleranceSubstitution",
  function(
    this,
    value,
    force=FALSE,
    silent=FALSE,
    ...
  ){

    .checkWriteProtection(this);
if(!exists(x="PSIM_FAST")){

    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");
    }
}
    if(length(value) != this$alphabet$size){
      throw("The new value must be a vector of length ",this$alphabet$size,"!\n");
    }
    if(!PSRoot$my.all.equal(sum(value), 1.0)) {
				value<-(value/sum(value));
				if (silent == FALSE){
					warning("The provided probabilities have been rescaled in order to sum to one!\n");
				}
    }

if(!exists(x="PSIM_FAST")){
	# Check if the provided equlibrium distribution is
	# compatible with the rate matrix:
	if( !.checkEquMatCompat(this, rbind(value)) & force==FALSE){
				throw("The provided equlibrium distribution: ",paste(value,collapse=" ")," is not compatible with the rate matrix! Use force=TRUE to set it anyway!\n");
	}
}
	# Set the value:
      this$.equ.dist<-rbind(value);
			# Set dimnames:
      colnames(this$.equ.dist)<-(this$alphabet$symbols);
      rownames(this$.equ.dist)<-c("Prob:");
 	return(invisible(this$.equ.dist));


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);


##
## Method: .setEquDistFromGuess
##
setMethodS3(
  ".setEquDistFromGuess",
  class="ToleranceSubstitution",
  function(
    this,
    ...
  ){
			
	# Try to guess equlibrium distribution:
	tmp<-.guessEquDist(this);
	# Take care with the condition here!
	# We can get in trouble with any()
	# if the first value is zero!
	if( length(tmp) == 1 & all(tmp == FALSE) ){
		warning("The equlibrium distribution of the substitution process could not be determined based on the rate matrix!\n You have to set yourself the proper distribution in order to use the process!");
		return(FALSE);
	}
	else {
		this$equDist<-tmp;
		return(TRUE);
	}

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: .checkEquMatCompat
##
setMethodS3(
  ".checkEquMatCompat",
  class="ToleranceSubstitution",
  function(
    this,
    value,
    ...
  ){

    if(missing(value)) {
      throw("No equlibrium distribution provided!\n")
		}
		else if ( length(value) != dim(this$.q.matrix$.orig.matrix)[[2]] ){
				throw("Value vector length should be",dim(this$.q.matrix$.orig.matrix)[[2]],"!\n");	
		}
		else {
			# The following matrix product of the equlibrium distribution
			# and the rate matrix should give the zero vector:
			tmp<-(rbind(value) %*% as.matrix(this$.q.matrix$.orig.matrix));
			if(PSRoot$my.all.equal(tmp, rep(0.0, times=length(tmp))) ){
				return(invisible(TRUE));
			} else {
				return(FALSE);
			}
		}


  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: .guessEquDist
##	
setMethodS3(
	".guessEquDist", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){

		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot guess equilibrium distribution because the Q matrix is not set!\n");
		}
		
		# Refuse to guess if the rate matrix has zero entries:
		if(length(which(this$.q.matrix$.orig.matrix == 0)) != 0 ){
			warning("Cannot guess equilibrium distribution because the rate matrix has zero entries!\n");
			return(FALSE);
		}

		# Get the left eigenvalues and eigenvectors of the rate matrix:
		eigen<-eigen(t(this$.q.matrix$.orig.matrix));
		dist<-numeric(0);

		if( length(intersect(is.complex(eigen$values),TRUE)) == 0 ) {
			# if all  eigenvalues are real:
			# Choose the largest eigenvalue (which should be zero):
			index<-which( eigen$values == max(eigen$values));
			# Choose the correspondign eigenvector:
			dist<-rbind(eigen$vectors[ ,index]);
		}
		else {
			# If we have complex eigenvalues:
			# Choose the eigenvalue (l) with maximum |e^(l)|  
			tmp<-abs(exp(eigen$values));
			index<-which(tmp == max(tmp));
			# ... and the corresponding eigenvector:
			dist<-as.double(eigen$vectors[,index]);
		}	

		# Normalize the eigenvector:
		return(dist/sum(dist));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
				

##	
## Method: .initEquDist
##	
setMethodS3(
	".initEquDist", 
	class="ToleranceSubstitution", 
	function(
		this,
		dummy=NA, # to satisfy method classification
		...
	){

		if(!isEmpty(this$.alphabet)){
			# Fill in with NA-s
			this$.equ.dist<-rbind(rep(NA,times=this$.alphabet$size));
			# Set the dimnames:
			colnames(this$.equ.dist)<-this$.alphabet$symbols;
			rownames(this$.equ.dist)<-c("Prob:");
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getEquDist
##	
###########################################################################/**
#
# @RdocMethod getEquDist
# 
# @title "Get the equilibrium distribution from a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{dummy}{Not used.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The new equlibrium distribution (invisible).
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(
#                           alphabet=BinaryAlphabet(),
#                           rate.list=list("1->0"=1,"0->1"=1)
#                         )
#	# get equlibrium distribution 
#	getEquDist(p)
#	# get equilibrium distribution via virtual field
#	p$equDist
#	# re-set the equilibrium distribution
#	dist<-p$equDist * 3
#	dist
#	setEquDist(p,dist)
#	p$equDist
#	# re-set equilibrium distribution via virtual field
#	p$equDist<-p$equDist * 2
#	p$equDist
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEquDist", 
	class="ToleranceSubstitution", 
	function(
		this,
		dummy=NA, # to satisfy method classification
		...
	){

		this$.equ.dist;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: sampleState
##	
###########################################################################/**
#
# @RdocMethod	sampleState
# 
# @title "Sample a state from the equlibrium distribution of a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get equlibrium distribution 
#	getEquDist(p)
#	# get equilibrium distribution via virtual field
#	p$equDist
#	# sample from equilibrium distribution
#	sampleState(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"sampleState", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){

	if(!exists(x="PSIM_FAST")){
		if(any(is.na(this$.equ.dist))){
			throw("Cannot sample state because the equlibrium distribution is not defined!\n");
		}
		else if (!is.Alphabet(this$.alphabet)){
			throw("Cannot sample state because the alphabet is not valid! That is strange as equlibrium distribution is defined!\n");	
		}
	}
	
	if(this$.alphabet$size == 0){
		throw("The process alphabet is empty, nothing to sample here!\n");
	}
	if(this$.alphabet$size == 1){
	# Special case: single letter in the alphabet:
		return(this$.alphabet$symbols[[1]]);
	}
	else {
	# Sample from the equlibrium distribution:
		sample(x=this$.alphabet$.symbols, size=1, replace=FALSE, prob=this$.equ.dist);
	}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getQMatrix
##	
###########################################################################/**
#
# @RdocMethod getQMatrix
# 
# @title "Get the QMatrix object aggregated by a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method is mostly used internally.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A QMatrix object.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the QMatrix object
#	getQMatrix(p)
#	# get the QMatrix object via virtual field
#	q<-p$qMatrix
#	# tweak with the QMatrix
#	setRate(q,"0->1",2)
#	# set a new QMatrix for p
#	setQMatrix(p,q)
#	summary(p)
#	# set new QMatrix via virtual field
#	setRate(q,"1->0",2)
#	p$qMatrix<-q
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getQMatrix", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){

		this$.q.matrix;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setQMatrix
##	
###########################################################################/**
#
# @RdocMethod setQMatrix
# 
# @title "Set the QMatrix object aggregated by a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method is mostly used internally.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{value}{A QMatrix object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The QMatrix object.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the QMatrix object
#	getQMatrix(p)
#	# get the QMatrix object via virtual field
#	q<-p$qMatrix
#	# tweak with the QMatrix
#	setRate(q,"0->1",2)
#	# set a new QMatrix for p
#	setQMatrix(p,q)
#	summary(p)
#	# set new QMatrix via virtual field
#	setRate(q,"1->0",2)
#	p$qMatrix<-q
#	summary(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setQMatrix", 
	class="ToleranceSubstitution", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)){
			throw("No new value provided!\n");
		}
		else if(!is.QMatrix(value)){
			throw("The provided object is not a QMatrix!\n");
		}
		else if (!is.Alphabet(getAlphabet(this))){
			throw("Cannot set QMatrix because process alphabet is not defined!\n");
		}
		else if(!is.Alphabet(value$alphabet)){
			throw("Cannot set QMatrix because the alphabet of the provided QMatrix object is not set!\n");	
		}
		else if(getAlphabet(this) != value$alphabet){
			throw("Alphabet mismatch! Cannot set QMatrix!\n");	
		}
	}
		this$.q.matrix<-value;
		return(this$.q.matrix)

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setAlphabet
##	
###########################################################################/**
#
# @RdocMethod	setAlphabet
# 
# @title "Set the Alphabet object aggregated by a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method also sets the alphabet for the associated QMatrix object, which will set all rates to NA.
#	This method will also re-initialize the equlibrium distribution by setting all frequencies to NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{value}{An Alphabet object.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The Alphabet object.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object with an attached BinaryAlphabet object
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet())
#	# get object summary
#	summary(p)
#	# get alphabet
#	getAlphabet(p)
#	# get alphabet via virtual field
#	p$alphabet
#	# set a new alphabet
#	setAlphabet(p,NucleotideAlphabet())
#	summary(p)
#	# set alphabet via virtual field
#	p$alphabet<-BinaryAlphabet()
#	p$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setAlphabet", 
	class="ToleranceSubstitution", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){
		if(missing(value)){
			throw("No new value provided!\n");
		}
		else if (!is.Alphabet(value)){
			throw("Alphabet object is invalid!\n");
		}
	}
		this$.alphabet<-value;
		# Set the QMatrix alphabet
		if(is.QMatrix(this$.q.matrix)){
			setAlphabet(this$.q.matrix, value);
		}
		.initEquDist(this);
		return(this$.alphabet);

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getAlphabet
##	
###########################################################################/**
#
# @RdocMethod	getAlphabet
# 
# @title "Get the Alphabet object aggregated by a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method also sets the alphabet for the associated QMatrix object, which will set all rates to NA.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	An Alphabet object.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object with an attached BinaryAlphabet object
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet())
#	# get object summary
#	summary(p)
#	# get alphabet
#	getAlphabet(p)
#	# get alphabet via virtual field
#	p$alphabet
#	# set a new alphabet
#	setAlphabet(p,NucleotideAlphabet())
#	summary(p)
#	# set alphabet via virtual field
#	p$alphabet<-BinaryAlphabet()
#	p$alphabet
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getAlphabet", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){
		
		# Just to satisfy method classification:
		this$.alphabet;

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: hasUndefinedRate
##	
###########################################################################/**
#
# @RdocMethod hasUndefinedRate
# 
# @title "Check if a ToleranceSubstitution object has undefined rates" 
# 
# \description{ 
#	@get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	TRUE or FALSE.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet())
#	# check if it has undefined rates
#	hasUndefinedRate(p)	# TRUE
#	# set the missing rates
#	p$rateList<-list("0->1"=1,"1->0"=2)
#	# check for undefined rates again
#	hasUndefinedRate(p)	# FALSE
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"hasUndefinedRate", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){
		
		if( any(is.na(this$.q.matrix$.orig.matrix)) | any(is.na(this$.q.matrix$.rate.matrix))){
			return(TRUE);
		}
		else {
			return(FALSE);
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: getEventRate
##	
###########################################################################/**
#
# @RdocMethod getEventRate
# 
# @title "Get the scaled rate of an event from a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method return the element from the scaled rate matrix stored in the associated QMatrix object corresponding to
#	a given event. The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	This method doesn't take into account the site specific rate multipliers in any way.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the scaled rate of "0->1" by name
#	getEventRate(p,"0->1")	
#	# get the scaled rate of "0->1" by states
#	getEventRate(p,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getEventRate", 
	class="ToleranceSubstitution", 
	function(
		this,
		name=NA,
		from=NA,
		to=NA,
		...
	){

		# For getting the scaled event rate:
	if(!exists(x="PSIM_FAST")){
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate as the rate matrix is undefined!\n");
		}
	}
		else if(!missing(name) & missing(from) & missing(to)){
			return(getEventRate(this$.q.matrix, name=name));
		}
		else if (missing(name) & !missing(from) & !missing(to)){
			return(getEventRate(this$.q.matrix, from=from, to=to));
		}

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);
		
##
## Method: getEventRateAtSite
##
###########################################################################/**
#
# @RdocMethod getEventRateAtSite
# 
# @title "Get the site spcific rate of an event from a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method return the element from the associated QMatrix object corresponding to
#	a given event multiplied by the "rate.multiplier" site-process specific parameter stored in the specified site object.
#	The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object. It must be attached to the provided Site object.} 
# 	\item{site}{A Site object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# create a Site object
#	s<-Site(alphabet=BinaryAlphabet())
#	# attach process p to site s
#	s$processes<-list(p)
#	# set the rate multiplier for s and p
#       setParameterAtSite(p,s,id="rate.multiplier",value=2)
#	# get the site specific rate of "0->1" by name
#	getEventRateAtSite(p,s,"0->1")	
#	# get the site specific rate of "0->1" by states
#	getEventRateAtSite(p,s,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "getEventRateAtSite",
  class="ToleranceSubstitution",
  function(
    this,
    site,
    name=NA,
    from=NA,
    to=NA,
    ...
  ){

if(!exists(x="PSIM_FAST")){

      if(missing(site)){
        throw("No site provided");
      }
      else if (!isAttached(site, process=this)){
        throw("The process is not attached to the specified site!\n");
      }
}

      global.rate<-numeric();
			
			# Event specified by name:
      if(!missing(name) & missing(from) & missing(to)){
          global.rate<-getEventRate(this$.q.matrix, name=name);
      }
			# Event specified by from= and to=
      else if(missing(name) & !missing(from) & !missing(to)){
          global.rate<-getEventRate(this$.q.matrix, from=from, to=to);
      }
      else {
        throw("The substitution should be specified by name or by the \"from\" and \"to\" arguments!\n");
      }

      return(global.rate * site$.processes[[this$.id]]$site.params[["rate.multiplier"]]$value );

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);
	
##	
## Method: getRate
##	
###########################################################################/**
#
# @RdocMethod getRate
# 
# @title "Get an unscaled rate of an event from a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method gets the element corresponding to a given event form the unscaled Q matrix.
#	a given event. The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	The rescaled rates (used during simulations) are returned by the \code{getEventRate} method.
#
#	This method doesn't take into account the site specific rate multipliers in any way.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# get the unscaled rate of "0->1" by name
#	getRate(p,"0->1")	
#	# get the unscaled rate of "0->1" by states
#	getRate(p,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRate", 
	class="ToleranceSubstitution", 
	function(
		this,
		name=NA,
		from=NA,
		to=NA,
		...
	){

	if(!exists(x="PSIM_FAST")){
	
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate as the rate matrix is undefined!\n");
		}
	}
		if(!missing(name) & missing(from) & missing(to)){
			return(getRate(this$.q.matrix, name=name));
		}
		else if (missing(name) & !missing(from) & !missing(to)){
			return(getRate(this$.q.matrix, from=from, to=to));
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: setRate
##	
###########################################################################/**
#
# @RdocMethod setRate
#
# @title "Set an unscaled rate for an event from a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method sets the element corresponding to a given event in the unscaled Q matrix.
#	The event can be specified by the inital and target states ("from" and "to" arguments), or by the
#	event name ("from->to"). The event name takes precedence over the "from" and "to" arguments. 
#
#	Modifying any rate in the unscaled Q matrix will trigger the re-scaling of the whole matrix.
#	The rescaled rates (used during simulations) are returned by the \code{getEventRate} method.
#
#	This method doesn't modify the site specific rate multipliers.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{name}{The name of the event.}
#	\item{from}{The initial state.}
#	\item{value}{The new value of the rate.}
#	\item{to}{Target state.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A Numeric vector of length one.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=1))
#	# set the unscaled rate by event name
#	setRate(p,"0->1",2)
#	# get the unscaled rate of "0->1" by name
#	getRate(p,"0->1")	
#	# set the unscaled rate by states
#	setRate(p,"0->1",0.5)
#	# get the unscaled rate of "0->1" by states
#	getRate(p,from="0",to="1")
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRate", 
	class="ToleranceSubstitution", 
	function(
		this,
		name=NA,
		value,
		from=NA,
		to=NA,
		...
	){
		
		.checkWriteProtection(this);
		# Setting unscaled rate:
	if(!exists(x="PSIM_FAST")){
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot set rate as the rate matrix is undefined!\n");
		}
	}
		if(!missing(name) & missing(from) & missing(to)){
			return(setRate(this$.q.matrix, name=name, value=value));
		}
		else if (missing(name) & !missing(from) & !missing(to)){
			return(setRate(this$.q.matrix, from=from, to=to, value=value));
		}


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: getRateList
##	
###########################################################################/**
#
# @RdocMethod	getRateList
# 
# @title "Get a list of events and their unscaled rates from a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method returns the list of event rates from the \emph{unscaled} Q matrix (as returbed bvy the \code{getEventRate} method). 
#	The returned list contains the rates associated with the corresponding event names.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A list of event rates.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the event rates from the unscaled Q matrix
#	getRateList(p)
#	# get rates from the unscaled rate matrix via virtual field
#	p$rateList
#	# set rates in the unscaled rate matrix
#	setRateList(p, list("0->1"=1,"1->0"=1))
#	p$rateList
#	# set rates in the unscaled rate matrix via virtual field
#	p$rateList<-list("0->1"=3,"1->0"=1);
#	# check the contenst of the associated QMatrix object
#	summary(p$QMatrix)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"getRateList", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){

	if(!exists(x="PSIM_FAST")){
		
		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate list as the rate matrix is undefined!\n");
		} 
	}
		return(getRateList(this$.q.matrix));


	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: setRateList
##	
###########################################################################/**
#
# @RdocMethod	setRateList
# 
# @title "Setting the rates for a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	
#	This method set the rates in the \emph{unscaled} Q  matrix based on the provided list containing even names
#	and the associated rates. The rate must be specified for every event!
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
#	\item{value}{A list with the events names and the associated rates.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The ToleranceSubstitution object (invisible).
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# get the event rates from the unscaled Q matrix
#	getRateList(p)
#	# get rates from the unscaled rate matrix via virtual field
#	p$rateList
#	# set rates in the unscaled rate matrix
#	setRateList(p, list("0->1"=1,"1->0"=1))
#	p$rateList
#	# set rates in the unscaled rate matrix via virtual field
#	p$rateList<-list("0->1"=3,"1->0"=1);
#	# check the contenst of the associated QMatrix object
#	summary(p$QMatrix)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"setRateList", 
	class="ToleranceSubstitution", 
	function(
		this,
		value,
		...
	){

		.checkWriteProtection(this);
	if(!exists(x="PSIM_FAST")){

		if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot get rate list as the rate matrix is undefined!\n");
		} 
		else if(missing(value)){
			throw("No new rate list specified!\n");
		}
	}
		return(setRateList(this$.q.matrix, value) );

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: rescaleQMatrix
##	
###########################################################################/**
#
# @RdocMethod rescaleQMatrix
# 
# @title "Rescale the scaled rate matrix of a QMatrix object aggregated by a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	The QMatrix objects aggregated by the ToleranceSubstitution objects store two rate matrices: one containes
#	the rates provided by the user (unscaled rate matrix), the other matrix (scaled rate matrix) is rescaled to have the 
#	expected number of subsitutions per unit time equal to one when the process is at equlibrium.
#	This method performes the re-scaling of the scaled rate matrix in the associated QMatrix object based on 
#	the equlibrium distribution and the unscaled rate matrix.
#
#	This method is mainly used internally as the scaled matrix is rescaled every time the unscaled matrix 
#	is modifed.
#
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	Invisible TRUE.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	# provide an Alphabet object and the rates
#	p<-ToleranceSubstitution(alphabet=BinaryAlphabet(), rate.list=list("1->0"=1,"0->1"=3))
#	# rescale rate matrix
#	rescaleQMatrix(p)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"rescaleQMatrix", 
	class="ToleranceSubstitution", 
	function(
		this,
		...
	){

	if(!exists(x="PSIM_FAST")){

		if(is.na(this$.q.matrix)){
			return(invisible(FALSE));
		}
		else if(!is.QMatrix(this$.q.matrix)){
			throw("Cannot rescale rate matrix because it is invalid!\n");
		}
		else if (any(is.na(this$.q.matrix))){
			throw("Cannot rescale rate matrix because not all rates are specified!\n");
		}
		else if(any(is.na(this$.equ.dist))){
			throw("Cannot rescale rate matrix because the equlibrium distribution is not defined properly!\n");
		}
		# Check for alphabet mismatch:
		if(this$alphabet != this$.q.matrix$.alphabet){
			throw("The process alphabet and the QMatrix alphabet is not the same! Refusing to rescale!\n");
		}
	}
		# Set rescaling constant to zero:
		K <- 0; 
		# get the symbols:
		symbols<-this$alphabet$symbols;
		orig.matrix<-this$.q.matrix$.orig.matrix;
			
		# For every symbol:
		for (i in symbols) {
		# Get the equlibrium probability:
		i.equ<-this$.equ.dist[[ which(colnames(this$.equ.dist) == i) ]];
		for(j in symbols){
			if(i == j){next}
			# For every other symbol - update the constant:
			K <- K + (i.equ * orig.matrix[i,j] );
			}
		}
	
    		Scale(this$.q.matrix,constant=(1/K));
		# After rescaling the expected rate of substitutions per site
		# at equlibrium is 1.
		return(invisible(TRUE));

	},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);


##	
## Method: is.ToleranceSubstitution
##	
###########################################################################/**
#
# @RdocDefault is.ToleranceSubstitution
# 
# @title "Check if an object is an instance of the ToleranceSubstitution class" 
# 
# \description{ 
#       @get "title".
# } 
# 
# @synopsis 
# 
# \arguments{ 
#       \item{this}{An object.} 
#       \item{...}{Not used.} 
# } 
# 
# \value{ 
#       TRUE or FALSE.
# } 
# 
# \examples{
#	# create some objects
#	p<-ToleranceSubstitution()
#	pp<-Process()
#	# chek if they inherit from ToleranceSubstitution
#	is.ToleranceSubstitution(p)
#	is.ToleranceSubstitution(pp)
# } 
# 
# @author 
# 
# \seealso{ 
#       @seeclass
# } 
# 
#*/###########################################################################
setMethodS3(
	"is.ToleranceSubstitution", 
	class="default", 
	function(
		this,
		...
	){

	if(!is.PSRoot(this)) {return(FALSE)}
	if(!is.null(this$.is.general.substitution)){return(TRUE)}
	if ( inherits(this, "ToleranceSubstitution")) {
		this$.is.general.substitution<-TRUE;
      		return(TRUE);
	} else {
      	return(FALSE)
    	}

},
	private=FALSE,
	protected=FALSE,
	overwrite=FALSE,
	conflict="warning",
	validators=getOption("R.methodsS3:validators:setMethodS3")
);

##	
## Method: as.character
##	
###########################################################################/**
#
# @RdocMethod as.character
# 
# @title "Return the character representation of a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#	The character representation is the object id as returned by the 
#	\code{getId.Process} method defined in the parent class.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A character vector of length one.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	p<-ToleranceSubstitution(name="MySubst")
#	# get character representation
#	as.character(p)
#	# the same implicitly
#	p
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
	"as.character",
	class="ToleranceSubstitution", 
	function(
		x,
		...
	){

		x$.id;

	},
	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<-ToleranceSubstitution(alphabet=BinaryAlphabet(),rate.list=list("0->1"=1,"1->0"=2))
#       # get a summary
#       summary(a)
# }
#
# @author
#
# \seealso{
#       @seeclass
# }
#
#*/###########################################################################
setMethodS3(
	"summary", 
	class="ToleranceSubstitution", 
	function(
		object,
		...
	){

		this<-object;	
		.addSummaryNameId(this);
		.addSummaryAlphabet(this);
		
		if(is.null(this$.summary$"Unscaled rate matrix")){
			this$.summary$"Unscaled rate matrix"<-paste( "\n\t",paste(capture.output(print(this$.q.matrix)),collapse="\n\t"),"\n",sep="");
		}
		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: clone
##
###########################################################################/**
#
# @RdocMethod clone
# 
# @title "Clone a ToleranceSubstitution object" 
# 
# \description{ 
#	@get "title".
#
#	This method also clones the aggregated QMatrix object, but not the aggregated Alphabet
#	object, as that is a good target for recycling.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{this}{A ToleranceSubstitution object.} 
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	A ToleranceSubstitution object.
# } 
# 
# \examples{
#	# create a ToleranceSubstitution object
#	p<-ToleranceSubstitution(
#                           alphabet=BinaryAlphabet(),
#                           rate.list=list("0->1"=1,"1->0"=2),
#                           name="MyBinary"
#                           )
#	# clone p
#	pp<-clone(p)
#	# do some checks
#	p;pp
#	p == p
#	p == pp
#	equals(p$qMatrix, pp$qMatrix)
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "clone",
  class="ToleranceSubstitution",
  function(
    this,
    ...
  ){

	# Clone the process object:
	that<-clone.Object(this);
	# Disable write protection:
      	if(that$writeProtected){
        	that$writeProtected<-FALSE;
      	}

	# Clone Q matrix object:
	that$.q.matrix<-clone(this$.q.matrix);
	that$.q.matrix$.process<-that;

	# Reassingning name to force Id update:
	that$name<-that$name;
	return(that);

  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

##
## Method: plot
##
###########################################################################/**
#
# @RdocMethod plot
# 
# @title "Create a bubble plot of the substitution process" 
# 
# \description{ 
#	@get "title".
#
#	Bubble plots visualize the characteristics of the 
#	substitution process. The area of the circles is proportional to the rates/probabilities.
#	The plot is not produced if the rate matrix or the equlibrium 
#	distribution has undefined elements.
# } 
# 
# @synopsis 
# 
# \arguments{ 
# 	\item{x}{An object inheriting from ToleranceSubstitution.} 
#	\item{scale}{A scale factor affecting the area of the circles.}
# 	\item{...}{Not used.} 
# } 
# 
# \value{ 
# 	The process object (invisible).
# } 
# 
# \examples{
#	plot(BinarySubst(rate.list=list("0->1"=1,"1->0"=1.5)))
#	plot(JC69())
#	# get smaller circles
#	plot(JC69(),scale=0.5)
#	plot(F84(base.freqs=c(3/6,1/6,1/6,1/6)))
#	plot(WAG())
# } 
# 
# @author 
# 
# \seealso{ 
# 	@seeclass 
# } 
# 
#*/###########################################################################
setMethodS3(
  "plot",
  class="ToleranceSubstitution",
  function(
    x,
    scale=1,
    ...
  ){

	if(!is.numeric(scale)){
		throw("Scale parameter must be numeric!");
	}
	
	if(scale <= 0){
		throw("Scale parameter must be positive!");
	}

	if(hasUndefinedRate(x))	{
		throw("Cannot plot process: the rate matrix has undefined elements!");
	}

	if(any(is.na(x$equDist)))	{
		throw("Cannot plot process: the equilibrium distribution has undefined elements!");
	}

	qmat<-x$.q.matrix$scaledMatrix;
	# setting up viewports
	point_scale<-40.0;
	
	grid.newpage();

	size<-dim(qmat)[1];
	dsize<-(max(c(1/size,( (0.23 * size - 0.65)/size ) )));

	layout<-grid.layout(nrow=2,ncol=1,heights=c((1 - dsize), dsize),respect=TRUE);

	vp1<-viewport(layout=layout,layout.pos.row=1,layout.pos.col=1);
	vp2<-viewport(layout=layout,layout.pos.row=2,layout.pos.col=1);
	
	pushViewport(vp1);
	# tabulate rates	
	xx<-c();
	yy<-c();
	zz<-c();	

	for(cl in (colnames(qmat))){
		for(rw in (rownames(qmat))){
			if(rw != cl){
				xx<-c(xx,cl)
				yy<-c(yy,rw)
				zz<-c(zz,qmat[as.character(rw), as.character(cl)]);
			}
		}
	}


	# visual aspect tuned by "magic" formulas :)
	my.plot<-(qplot(x=xx,y=yy,size=zz,xlab="To:",ylab="From:",main="Rate matrix") + geom_point(colour="blue") +
	scale_size_area(limits=c(0,max(zz)), name="Size:")
	) + xlim(colnames(qmat)) + ylim(rev(rownames(qmat)));
	print(my.plot, vp=vp1);
	popViewport(1);

	# equlibrium distribution	
	dist<-x$equDist;
	xx<-c();
	yy<-c();
	zz<-c();
	
	for(cl in colnames(dist)){
		xx<-c(xx, cl);
		yy<-c(yy, 1);
		zz<-c(zz,dist[1,as.character(cl)]);
	}

	pushViewport(vp2);
	fr<-max(zz) - min(zz);	
	# visual aspect tuned by "magic" formulas :)
	my.plot<-(qplot(x=xx,y=yy,size=zz,xlab="Symbol",ylab="Prob:",main="Equlibrium distribution") + geom_point(colour="green") + 
	scale_size_area(limits=c(0,max(zz)), name="Size:",breaks=c(min(zz),min(zz) + fr*(1/3),min(zz) + fr*(2/3),max(zz))) + xlim(xx)
	);
	print(my.plot,vp=vp2);
	popViewport(1);

	return(invisible(x));
  },
  private=FALSE,
  protected=FALSE,
  overwrite=FALSE,
  conflict="warning",
  validators=getOption("R.methodsS3:validators:setMethodS3")
);

Try the phylosim package in your browser

Any scripts or data that you put into this service are public.

phylosim documentation built on Nov. 22, 2019, 1:07 a.m.