Nothing
CheckdbmssArguments <-
function() {
# Verify that the package is attached
if (! "dbmss" %in% .packages()) {
warning("Function arguments cannot be checked because the dbmss package is not attached. Add CheckArguments=FALSE to suppress this warning or run library('dbmss')")
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 dbmss::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)
}
# Get the point pattern or the Dtable
X <- eval(expression(X), parent.frame())
# X
if (!is.na(names(Args["X"]))) {
if (!(inherits(X, "wmppp") | (inherits(X, "Dtable"))))
ErrorMessage("X must be of class wmppp or Dtable", X)
}
# r
if (!is.na(names(Args["r"]))) {
r <- eval(expression(r), parent.frame())
if (!is.null(r)) {
if (!is.numeric(r) && !is.vector(r))
ErrorMessage("r must be a numeric vector", r)
if (length(r) < 2)
ErrorMessage(paste("r has length", length(r), "- must be at least 2"), r)
if (r[1] != 0)
ErrorMessage("First r value must be 0", r)
if (any(diff(r) <= 0))
ErrorMessage("successive values of r must be increasing", r)
}
}
# ReferenceType
if (!is.na(names(Args["ReferenceType"]))) {
ReferenceType <- eval(expression(ReferenceType), parent.frame())
if (ReferenceType!="" & !ReferenceType %in% X$marks$PointType)
ErrorMessage("ReferenceType must be a point type of the point pattern", ReferenceType)
}
# NeighborType
if (!is.na(names(Args["NeighborType"]))) {
NeighborType <- eval(expression(NeighborType), parent.frame())
if (NeighborType!="" & !NeighborType %in% X$marks$PointType)
ErrorMessage("NeighborType must be a point type of the point pattern", NeighborType)
}
# Cases
if (!is.na(names(Args["Cases"]))) {
Cases <- eval(expression(Cases), parent.frame())
if (!Cases %in% X$marks$PointType)
ErrorMessage("Cases must be a point type of the point pattern", Cases)
}
# Controls
if (!is.na(names(Args["Controls"]))) {
Controls <- eval(expression(Controls), parent.frame())
if (!is.null(Controls)) {
if (!(Controls %in% X$marks$PointType))
ErrorMessage("Controls must be a point type of the point pattern", Controls)
}
}
# CaseControl
if (!is.na(names(Args["CaseControl"]))) {
CaseControl <- eval(expression(CaseControl), parent.frame())
if (!is.logical(CaseControl))
ErrorMessage("CaseControl must be TRUE or FALSE", CaseControl)
}
# Intertype
if (!is.na(names(Args["Intertype"]))) {
Intertype <- eval(expression(Intertype), parent.frame())
if (!is.logical(Intertype))
ErrorMessage("Intertype must be TRUE or FALSE", Intertype)
}
# Weighted
if (!is.na(names(Args["Weighted"]))) {
Weighted <- eval(expression(Weighted), parent.frame())
if (!is.logical(Weighted))
ErrorMessage("Weighted must be TRUE or FALSE", Weighted)
}
# Original
if (!is.na(names(Args["Original"]))) {
Original <- eval(expression(Original), parent.frame())
if (!is.logical(Original))
ErrorMessage("Original must be TRUE or FALSE", Original)
}
# lambda
if (!is.na(names(Args["lambda"]))) {
lambda <- eval(expression(lambda), parent.frame())
if (!is.null(lambda)) {
if (!inherits(lambda, "im") & !is.numeric(lambda))
ErrorMessage("lambda must be an image of class im or a numeric vector", lambda)
}
}
# 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)
}
# 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)
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)
ErrorMessage("alpha must be positive", alpha)
if (alpha > 1)
ErrorMessage("alpha must be less than or equal to 1", alpha)
}
# Adjust
if (!is.na(names(Args["Adjust"]))) {
Adjust <- eval(expression(Adjust), parent.frame())
if (!is.numeric(Adjust))
ErrorMessage("Adjust must be a number", Adjust)
if (Adjust<=0)
ErrorMessage("Adjust must be strictly positive", Adjust)
}
# Approximate
if (!is.na(names(Args["Approximate"]))) {
Approximate <- eval(expression(Approximate), parent.frame())
if (!is.numeric(Approximate))
ErrorMessage("Approximate must be a number", Approximate)
if (Approximate < 0)
ErrorMessage("Approximate must be positive", Approximate)
}
# StartFromMinR
if (!is.na(names(Args["StartFromMinR"]))) {
StartFromMinR <- eval(expression(StartFromMinR), parent.frame())
if (!is.logical(StartFromMinR))
ErrorMessage("StartFromMinR must be TRUE or FALSE", StartFromMinR)
}
# Individual
if (!is.na(names(Args["Individual"]))) {
Individual <- eval(expression(Individual), parent.frame())
if (!is.logical(Individual))
ErrorMessage("Individual must be TRUE or FALSE", Individual)
}
# Precision
if (!is.na(names(Args["Precision"]))) {
Precision <- eval(expression(Precision), parent.frame())
if (!is.numeric(Precision))
ErrorMessage("Precision must be a number", Precision)
if (Precision < 0)
ErrorMessage("Precision must be positive", Precision)
}
# show.window
if (!is.na(names(Args["show.window"]))) {
show.window <- eval(expression(show.window), parent.frame())
if (!is.logical(show.window))
ErrorMessage("show.window must be TRUE or FALSE", show.window)
}
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.