On 08/20/2013 11:41 AM, ivo welch wrote:
A second enhancement would be a "smart string", which knows that
everything inside {{...}} should be evaluated.
stopifnot( is.matrix(m), "m is not a matrix, but a {{class(m)}}" )
a variant with more traditional syntax might be
if (!is.matrix(m))
stopf("m is not a matrix, but a '%s'", class(m))
or
stopifnotf(is.matrix(m), "m is not a matrix, but a '%s'", class(m))
where stopf is analogous to sprintf but signalling the corresponding condition
(perhaps taking the opportunity to strwrap to getOption("width")). This would
work well with gettextf to allow for translation. An imperfect implementation
(call. is incorrect, for example) is
.msg <-
function(fmt, ..., domain=NULL, width=getOption("width"))
## Use this helper to format all error / warning / message text
{
txt <- strwrap(gettextf(fmt, ..., domain=domain), width=width,
exdent=2)
paste(txt, collapse="\n")
}
stopf <-
function(..., call.=FALSE)
{
stop(.msg(...), call.=call.)
}
stopifnotf <-
function(test, fmt, ...)
{
if (!test)
stopf(fmt, ...)
}
One might also wish to expose the condition class system, along the lines of
.textf <- ## a variant of .makeMessage
function(fmt, ..., width = getOption("width"), domain = NULL,
appendLF = FALSE)
{
txt <- gettextf(fmt, ..., domain = domain)
msg <- paste(strwrap(txt, width = width, indent = 2, exdent = 2),
collapse="\n")
if (appendLF)
paste0(msg, "\n")
else msg
}
.condition <-
function(fmt, ..., class, call = NULL)
{
msg <- .textf(fmt, ...)
if (is.null(call))
msg <- paste0("\n", msg)
class <- c(class, "condition")
structure(list(message=msg, call = call), class=class)
}
stopf <-
function(fmt, ..., class. = "simpleError", call. = TRUE, domain = NULL)
{
call. <- if (is.logical(call.) && 1L == length(call.) && call.)
sys.call(-1)
else NULL
cond <- .condition(fmt, ..., domain = domain,
class = c(class., "error"), call = call.)
stop(cond)
}
warnf <-
function(fmt, ..., class. = "simpleWarning", call. = TRUE, domain = NULL)
{
## does not support immediate., but options(warn=1) supported
call. <- if (is.logical(call.) && 1L == length(call.) && call.)
sys.call(-1)
else NULL
cond <- .condition(fmt, ..., domain = domain,
class = c(class., "warning" ), call = call.)
warning(cond)
}
messagef <-
function(fmt, ..., class. = "simpleMessage", domain = NULL,
appendLF = TRUE)
{
cond <- .condition(fmt, ..., domain = domain, appendLF = appendLF,
class = c(class., "message"))
message(cond)
}
--
Computational Biology / Fred Hutchinson Cancer Research Center
1100 Fairview Ave. N.
PO Box 19024 Seattle, WA 98109
Location: Arnold Building M1 B861
Phone: (206) 667-2793
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
