Nothing
CheckentropartArguments <-
function() {
# Verify that the package is attached
if (! "entropart" %in% .packages()) {
warning("Function arguments cannot be checked because the entropart package is not attached. Add CheckArguments=FALSE to suppress this warning or run library('entropart')")
return (TRUE)
}
# Get the list of arguments of the parent function
ParentFunction <- sys.call(-1)[[1]]
# If apply() or similar was used, the function name is not in ParentFunction: sys.call(-1)[[1]] returns "FUN"
if (ParentFunction == "FUN") {
warning("Function arguments cannot be checked, probably because you used apply(). Add CheckArguments=FALSE to suppress this warning.")
return (TRUE)
}
# Find the arguments. match.fun does not work with entropart::function
# as.character creates a vector. The name of the function is the last item
ParentFunction_split <- as.character(ParentFunction)
ParentFunctionNoNS <- ParentFunction_split[length(ParentFunction_split)]
Args <- formals(match.fun(ParentFunctionNoNS))
ErrorFunction <- paste("Error in ", ParentFunctionNoNS, ":")
ErrorMessage <- function(Message, Argument) {
cat(deparse(substitute(Argument)), "cannot be:\n")
print(utils::head(Argument))
cat(paste(ErrorFunction, Message, "\n"))
stop("Check the function arguments.", call. = FALSE)
}
# Correction
if (!is.na(names(Args["Correction"]))) {
Correction <- eval(expression(Correction), parent.frame())
if (!is.character(Correction))
ErrorMessage("Correction must be a string.", Correction)
}
# PCorrection
if (!is.na(names(Args["PCorrection"]))) {
PCorrection <- eval(expression(PCorrection), parent.frame())
if (!is.character(PCorrection))
ErrorMessage("PCorrection must be a string.", PCorrection)
}
# RCorrection
if (!is.na(names(Args["RCorrection"]))) {
RCorrection <- eval(expression(RCorrection), parent.frame())
if (!is.character(RCorrection))
ErrorMessage("RCorrection must be a string.", RCorrection)
}
# MC
if (!is.na(names(Args["MC"]))) {
MC <- eval(expression(MC), parent.frame())
if (!is.MetaCommunity(MC))
ErrorMessage("MC must be a MetaCommunity object.", MC)
}
# MClist
if (!is.na(names(Args["MClist"]))) {
MClist <- eval(expression(MClist), parent.frame())
if (!is.list(MClist))
ErrorMessage("MClist must be a list.", MClist)
if (any(!unlist(lapply(MClist, function(x) is.MetaCommunity(x)))))
ErrorMessage("All elements of MClist must be of class MetaCommunity.", MClist)
}
# q
if (!is.na(names(Args["q"]))) {
q <- eval(expression(q), parent.frame())
if (!is.numeric(q) | length(q)!=1)
ErrorMessage("q must be a number.", q)
}
# q.seq
if (!is.na(names(Args["q.seq"]))) {
q.seq <- eval(expression(q.seq), parent.frame())
if (!is.vector(q.seq))
ErrorMessage("q.seq must be a numeric vector.", q.seq)
if (length(q.seq) < 2)
ErrorMessage("q.seq must contain at least 2 values.", q.seq)
}
# alpha
if (!is.na(names(Args["alpha"]))) {
alpha <- eval(expression(alpha), parent.frame())
if (!is.numeric(alpha) | length(alpha)!=1)
ErrorMessage("alpha must be a number.", alpha)
if (any(alpha < 0))
ErrorMessage("alpha must be positive.", alpha)
}
# Alpha
if (!is.na(names(Args["Alpha"]))) {
Alpha <- eval(expression(Alpha), parent.frame())
if (!is.numeric(Alpha))
ErrorMessage("Alpha must be a number.", Alpha)
if (Alpha <= 0 | Alpha >= 1)
ErrorMessage("Alpha must be strictly between 0 and 1.", Alpha)
}
# BootstrapMethod
if (!is.na(names(Args["BootstrapMethod"]))) {
BootstrapMethod <- eval(expression(BootstrapMethod), parent.frame())
if (!is.character(BootstrapMethod))
ErrorMessage("BootstrapMethod must be a string.", BootstrapMethod)
}
# Estimator
if (!is.na(names(Args["Estimator"]))) {
Estimator <- eval(expression(Estimator), parent.frame())
if (!is.character(Estimator))
ErrorMessage("Estimator must be a string.", Estimator)
}
# CEstimator
if (!is.na(names(Args["CEstimator"]))) {
CEstimator <- eval(expression(CEstimator), parent.frame())
if (!is.character(CEstimator))
ErrorMessage("CEstimator must be a string.", CEstimator)
}
# JackMax
if (!is.na(names(Args["JackMax"]))) {
JackMax <- eval(expression(JackMax), parent.frame())
if (!is.numeric(JackMax) | length(JackMax)!=1)
ErrorMessage("JackMax must be a number.", JackMax)
if (JackMax < 1)
ErrorMessage("JackMaxmust be at least 1.", JackMax)
if (JackMax > 10)
ErrorMessage("JackMaxmust be at most 10.", JackMax)
if (as.integer(JackMax) != JackMax)
ErrorMessage("JackMax must be an integer.", JackMax)
}
# JackOver
if (!is.na(names(Args["JackOver"]))) {
JackOver <- eval(expression(JackOver), parent.frame())
if (!is.logical(JackOver))
ErrorMessage("JackOver must be TRUE or FALSE.", JackOver)
}
# Level
if (!is.na(names(Args["Level"]))) {
Level <- eval(expression(Level), parent.frame())
if (!is.null(Level)) {
if (!is.numeric(Level) | length(Level)!=1)
ErrorMessage("Level must be a number.", Level)
if (Level <=0)
ErrorMessage("Level must be positive", Level)
if (Level > 1)
# Level is an abundance
if (as.integer(Level) != Level)
ErrorMessage("Level must be an integer.", Level)
}
}
# k
if (!is.na(names(Args["k"]))) {
k <- eval(expression(k), parent.frame())
if (!is.numeric(k) | length(k)!=1)
ErrorMessage("k must be a number.", k)
if (k < 1)
ErrorMessage("k must be at least 1.", k)
if (as.integer(k) != k)
ErrorMessage("k must be an integer.", k)
}
# mean
if (!is.na(names(Args["mean"]))) {
mean <- eval(expression(mean), parent.frame())
if (!is.numeric(mean) | length(mean)!=1)
ErrorMessage("mean must be a number.", mean)
}
# n
if (!is.na(names(Args["n"]))) {
n <- eval(expression(n), parent.frame())
if (!is.null(n)) {
if (!is.numeric(n) | length(n)!=1)
ErrorMessage("n must be a number.", n)
if (any(n < 1))
ErrorMessage("n must be at least 1.", n)
if (as.integer(n) != n)
ErrorMessage("n must be an integer.", n)
}
}
# Normalize
if (!is.na(names(Args["Normalize"]))) {
Normalize <- eval(expression(Normalize), parent.frame())
if (!is.logical(Normalize))
ErrorMessage("Normalize must be TRUE or FALSE.", Normalize)
}
# nPoints
if (!is.na(names(Args["nPoints"]))) {
nPoints <- eval(expression(nPoints), parent.frame())
if (!is.numeric(nPoints) | length(nPoints)!=1)
ErrorMessage("nPoints must be a number.", nPoints)
if (any(nPoints < 1))
ErrorMessage("nPoints must be at least 1.", nPoints)
if (as.integer(nPoints) != nPoints)
ErrorMessage("nPoints must be an integer.", nPoints)
}
# Ns
if (!is.na(names(Args["Ns"]))) {
Ns <- eval(expression(Ns), parent.frame())
if (!is.null(Ns)) {
if (!is.numeric(Ns))
ErrorMessage("Ns must be numeric.", Ns)
if (any(Ns < 0))
ErrorMessage("All abundance values must be positive.", Ns)
}
}
# Nexp
if (!is.na(names(Args["Nexp"]))) {
Nexp <- eval(expression(Nexp), parent.frame())
if (!is.null(Nexp)) {
if (!is.numeric(Nexp))
ErrorMessage("Nexp must be numeric.", Nexp)
if (any(Nexp < 0))
ErrorMessage("All abundance values must be positive.", Nexp)
}
}
# NumberOfSimulations
if (!is.na(names(Args["NumberOfSimulations"]))) {
NumberOfSimulations <- eval(expression(NumberOfSimulations), parent.frame())
if (!is.numeric(NumberOfSimulations))
ErrorMessage("NumberOfSimulations must be a number.", NumberOfSimulations)
if (NumberOfSimulations < 0)
ErrorMessage("NumberOfSimulations must be positive.", NumberOfSimulations)
}
# Ps
if (!is.na(names(Args["Ps"]))) {
Ps <- eval(expression(Ps), parent.frame())
if (!is.null(Ps)) {
if (!is.numeric(Ps))
ErrorMessage("Ps must be numeric.", Ps)
# Probabilities must sum to 1
if (!isTRUE(all.equal(sum(Ps), 1)))
ErrorMessage("Probabilities must sum to 1.", Ps)
if (any(Ps < 0))
ErrorMessage("All probabilities must be positive.", Ps)
}
}
# Pexp
if (!is.na(names(Args["Pexp"]))) {
Pexp <- eval(expression(Pexp), parent.frame())
if (!is.null(Pexp)) {
if (!is.numeric(Pexp))
ErrorMessage("Pexp must be numeric.", Pexp)
# Probabilities must sum to 1
if (!isTRUE(all.equal(sum(Pexp), 1)))
ErrorMessage("Probabilities must sum to 1.", Pexp)
if (any(Pexp < 0))
ErrorMessage("All probabilities must be positive.", Pexp)
}
}
# NorP
if (!is.na(names(Args["NorP"]))) {
NorP <- eval(expression(NorP), parent.frame())
if (!is.numeric(NorP))
ErrorMessage("NorP must be numeric.", NorP)
if (any(NorP < 0))
ErrorMessage("All NorP values must be positive.", NorP)
if (!is.vector(NorP) & !is.SpeciesDistribution(NorP)) {
# NorP may be a true vector or a SpeciesDistribution. Then dim(NorP) is NULL, and nothing more has to be checked
# or a "named vector" whose attributes are not "names". Then dim() returns the vector's length.
if (length(dim(NorP)) != 1) {
# or a 2D numeric object
if (length(dim(NorP)) == 2) {
if (dim(NorP)[2] > 2) {
# then it must have 1 or 2 columns
ErrorMessage("NorP may be a vector or a two-column matrix.", NorP)
}
} else {
ErrorMessage("NorP may be a vector or a two-column matrix.", NorP)
}
}
}
}
# NorPexp
if (!is.na(names(Args["NorPexp"]))) {
NorPexp <- eval(expression(NorPexp), parent.frame())
if (!is.numeric(NorPexp))
ErrorMessage("NorPexp must be numeric.", NorPexp)
if (any(NorPexp < 0))
ErrorMessage("All NorPexp values must be positive.", NorPexp)
if (!is.vector(NorPexp) & !is.SpeciesDistribution(NorPexp)) {
# NorPexp may be a true vector or a SpeciesDistribution. Then dim(NorPexp) is NULL, and nothing more has to be checked
# or a "named vector" whose attributes are not "names". Then dim() returns the vector's length.
if (length(dim(NorPexp)) != 1) {
# or a 2D numeric object
if (length(dim(NorPexp)) == 2) {
if (dim(NorPexp)[2] > 2) {
# then it must have 1 or 2 columns
ErrorMessage("NorPexp may be a vector or a two-column matrix.", NorPexp)
}
} else {
ErrorMessage("NorPexp may be a vector or a two-column matrix.", NorPexp)
}
}
}
}
# PhyloDetails
if (!is.na(names(Args["PhyloDetails"]))) {
PhyloDetails <- eval(expression(PhyloDetails), parent.frame())
if (!is.logical(PhyloDetails))
ErrorMessage("PhyloDetails must be TRUE or FALSE.", PhyloDetails)
}
# r
if (!is.na(names(Args["r"]))) {
r <- eval(expression(r), parent.frame())
if (!is.numeric(r) | length(r)!=1)
ErrorMessage("r must be a number.", r)
if (r < 1)
ErrorMessage("r must be at least 1.", r)
if (as.integer(r) != r)
ErrorMessage("r must be an integer.", r)
}
# sd
if (!is.na(names(Args["sd"]))) {
sd <- eval(expression(sd), parent.frame())
if (!is.numeric(sd) | length(sd)!=1)
ErrorMessage("sd must be a number.", sd)
if (any(sd < 0))
ErrorMessage("sd must be positive.", sd)
}
# Simulations
if (!is.na(names(Args["Simulations"]))) {
Simulations <- eval(expression(Simulations), parent.frame())
if (!is.numeric(Simulations))
ErrorMessage("Simulations must be numeric.", Simulations)
if (!is.vector(Simulations) | length(Simulations) > 1)
ErrorMessage("Simulations must be a single number.", Simulations)
if (any(Simulations < 1))
ErrorMessage("Simulations must be at least 1.", Simulations)
if (as.integer(Simulations) != Simulations)
ErrorMessage("Simulations must be an integer.", Simulations)
}
# Tree
if (!is.na(names(Args["Tree"]))) {
Tree <- eval(expression(Tree), parent.frame())
if (!is.null(Tree)) {
if (!inherits(Tree, "phylo") & !inherits(Tree, "phylog") & !inherits(Tree, "hclust") & !inherits(Tree, "PPtree"))
ErrorMessage("Tree may be NULL or an object of class hclust or phylo or phylog or PPtree.", Tree)
if (inherits(Tree, "phylog")) {
if (is.null(Tree$Wdist))
ErrorMessage("phylog Tree must contain a distance matrix (use add.tools=TRUE when creating it).", Tree)
}
}
}
# PhyloTree
if (!is.na(names(Args["PhyloTree"]))) {
PhyloTree <- eval(expression(PhyloTree), parent.frame())
if (!is.null(PhyloTree)) {
if (!inherits(PhyloTree, "phylo") & !inherits(PhyloTree, "phylog") & !inherits(PhyloTree, "hclust") & !inherits(PhyloTree, "PPtree"))
ErrorMessage("PhyloTree may be NULL or an object of class hclust or phylo or phylog or PPtree", PhyloTree)
if (inherits(PhyloTree, "phylog")) {
if (is.null(PhyloTree$Wdist))
ErrorMessage("phylog PhyloTree must contain a distance matrix (use add.tools=TRUE when creating it).", PhyloTree)
}
}
}
# prob
if (!is.na(names(Args["prob"]))) {
prob <- eval(expression(prob), parent.frame())
if (!is.numeric(prob) | length(prob)!=1)
ErrorMessage("prob must be a number.", prob)
if (any(prob < 0) | any(prob > 1))
ErrorMessage("prob must be between 0 and 1.", prob)
}
# RealValue
if (!is.na(names(Args["RealValue"]))) {
RealValue <- eval(expression(RealValue), parent.frame())
if (!is.numeric(RealValue) | length(RealValue)!=1)
ErrorMessage("RealValue must be a number.", RealValue)
}
# S
if (!is.na(names(Args["S"]))) {
S <- eval(expression(S), parent.frame())
if (!is.numeric(S) | length(S)!=1)
ErrorMessage("S must be a number.", S)
if (any(S < 1))
ErrorMessage("S must be at least 1.", S)
if (as.integer(S) != S)
ErrorMessage("S must be an integer.", S)
}
# SampleCoverage
if (!is.na(names(Args["SampleCoverage"]))) {
SampleCoverage <- eval(expression(SampleCoverage), parent.frame())
if (!is.null(SampleCoverage)) {
if (!is.numeric(SampleCoverage))
ErrorMessage("SampleCoverage must be a number.", SampleCoverage)
if (SampleCoverage <= 0 | SampleCoverage >= 1)
ErrorMessage("SampleCoverage must be strictly between 0 and 1.", SampleCoverage)
}
}
# ShowProgressBar
if (!is.na(names(Args["ShowProgressBar"]))) {
ShowProgressBar <- eval(expression(ShowProgressBar), parent.frame())
if (!is.logical(ShowProgressBar))
ErrorMessage("ShowProgressBar must be TRUE or FALSE.", ShowProgressBar)
}
# SimulatedValues
if (!is.na(names(Args["SimulatedValues"]))) {
SimulatedValues <- eval(expression(SimulatedValues), parent.frame())
if (!is.vector(SimulatedValues))
ErrorMessage("SimulatedValues must be a numeric vector.", SimulatedValues)
}
# size
if (!is.na(names(Args["size"]))) {
size <- eval(expression(size), parent.frame())
if (!is.numeric(size) | length(size)!=1)
ErrorMessage("size must be a number.", size)
if (any(size < 1))
ErrorMessage("size must be at least 1.", size)
if (as.integer(size) != size)
ErrorMessage("size must be an integer.", size)
}
# Unveiling
if (!is.na(names(Args["Unveiling"]))) {
Unveiling <- eval(expression(Unveiling), parent.frame())
if (!is.character(Unveiling))
ErrorMessage("Unveiling must be a string.", Unveiling)
}
# Weights
if (!is.na(names(Args["Weights"]))) {
Weights <- eval(expression(Weights), parent.frame())
if (!is.vector(Weights))
ErrorMessage("Weights must be a numeric vector.", Weights)
if (any(Weights < 0))
ErrorMessage("All weights must be positive.", Weights)
}
# xy
if (!is.na(names(Args["xy"]))) {
xy <- eval(expression(xy), parent.frame())
if (!is.numeric(xy) | length(xy)!=2)
ErrorMessage("xy must be a numeric vector of length 2.", xy)
}
# ylog
if (!is.na(names(Args["ylog"]))) {
ylog <- eval(expression(ylog), parent.frame())
if (!is.logical(ylog))
ErrorMessage("ylog must be TRUE or FALSE.", ylog)
}
# Z
if (!is.na(names(Args["Z"]))) {
Z <- eval(expression(Z), parent.frame())
if (!is.null(Z)) {
if (!is.matrix(Z)) {
ErrorMessage("Z must be a square matrix.", Z)
} else {
if (dim(Z)[1] != dim(Z)[2])
ErrorMessage("Z must be a square matrix.", Z)
if (!is.null(colnames(Z)) | !is.null(rownames(Z))) {
# If the matrix is named, rows and columns must have the same names
if (!identical(colnames(Z), rownames(Z)))
ErrorMessage("Z row and column names must be identical.", Z)
}
# Must be a relatedness matrix
if (any(Z<0))
ErrorMessage("All terms of the relatedness matrix Z must be positive.", Z)
if (any(diag(Z)<0))
ErrorMessage("All terms of the relatedness matrix Z diagonal must be strictly positive.", Z)
}
}
}
return (TRUE)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.