egsub.RdGlobal substitute of expression using regular expressions.
egsub(pattern, replacement, x, ..., value=TRUE, envir=parent.frame(), inherits=TRUE)A character string with the regular expression to be
matched, cf. gsub().
A character string of the replacement to use
when there is a match, cf. gsub().
The expression or a function to be modified.
Additional arguments passed to gsub()
If TRUE, the value of the replacement itself is used
to look up a variable with that name and then using that variables
value as the replacement. Otherwise the replacement value is used.
An environment from where to find the variable
and whether the search should also include enclosing frames, cf.
get(). Only use if value is TRUE.
Returns an expression.
# Original expression
expr <- substitute({
res <- foo.bar.yaa(2)
print(res)
R.utils::use("R.oo")
x <- .b.
})
# Some predefined objects
foo.bar.yaa <- function(x) str(x)
a <- 2
b <- a
# Substitute with variable name
expr2 <- egsub("^[.]([a-zA-Z0-9_.]+)[.]$", "\\1", expr, value=FALSE)
print(expr2)
#> {
#> res <- foo.bar.yaa(2)
#> print(res)
#> R.utils::use("R.oo")
#> x <- b
#> }
## {
## res <- foo.bar.yaa(2)
## print(res)
## R.utils::use("R.oo")
## x <- b
## }
# Substitute with variable value
expr3 <- egsub("^[.]([a-zA-Z0-9_.]+)[.]$", "\\1", expr, value=TRUE)
print(expr3)
#> {
#> res <- foo.bar.yaa(2)
#> print(res)
#> R.utils::use("R.oo")
#> x <- 2
#> }
## {
## res <- foo.bar.yaa(2)
## print(res)
## R.utils::use("R.oo")
## x <- 2
## }
# Substitute the body of a function
warnifnot <- egsub("stop", "warning", stopifnot, value=FALSE)
print(warnifnot)
#> function (..., exprs, exprObject, local = TRUE)
#> {
#> n <- ...length()
#> if ((has.e <- !missing(exprs)) || !missing(exprObject)) {
#> if (n || (has.e && !missing(exprObject)))
#> warning("Only one of 'exprs', 'exprObject' or expressions, not more")
#> envir <- if (isTRUE(local))
#> parent.frame()
#> else if (isFALSE(local))
#> .GlobalEnv
#> else if (is.environment(local))
#> local
#> else warning("'local' must be TRUE, FALSE or an environment")
#> E1 <- if (has.e && is.call(exprs <- substitute(exprs)))
#> exprs[[1]]
#> cl <- if (is.symbol(E1) && E1 == quote(`{`)) {
#> exprs[[1]] <- quote(warningifnot)
#> exprs
#> }
#> else as.call(c(quote(warningifnot), if (!has.e) exprObject else as.expression(exprs)))
#> names(cl) <- NULL
#> return(eval(cl, envir = envir))
#> }
#> Dparse <- function(call, cutoff = 60L) {
#> ch <- deparse(call, width.cutoff = cutoff)
#> if (length(ch) > 1L)
#> paste(ch[1L], "....")
#> else ch
#> }
#> head <- function(x, n = 6L) x[seq_len(if (n < 0L) max(length(x) +
#> n, 0L) else min(n, length(x)))]
#> abbrev <- function(ae, n = 3L) paste(c(head(ae, n), if (length(ae) >
#> n) "...."), collapse = "\n ")
#> for (i in seq_len(n)) {
#> r <- ...elt(i)
#> if (!(is.logical(r) && !anyNA(r) && all(r))) {
#> dots <- match.call()[-1L]
#> if (is.null(msg <- names(dots)) || !nzchar(msg <- msg[i])) {
#> cl.i <- dots[[i]]
#> msg <- if (is.call(cl.i) && identical(1L, pmatch(quote(all.equal),
#> cl.i[[1]])) && (is.null(ni <- names(cl.i)) ||
#> length(cl.i) == 3L || length(cl.i <- cl.i[!nzchar(ni)]) ==
#> 3L))
#> sprintf(gettext("%s and %s are not equal:\n %s"),
#> Dparse(cl.i[[2]]), Dparse(cl.i[[3]]), abbrev(r))
#> else sprintf(ngettext(length(r), "%s is not TRUE",
#> "%s are not all TRUE"), Dparse(cl.i))
#> }
#> warning(simpleError(msg, call = if (p <- sys.parent(1L))
#> sys.call(p)))
#> }
#> }
#> invisible()
#> }
#> <environment: namespace:base>
warnifnot(pi == 3.14)
#> Error in eval(expr, envir, enclos): pi == 3.14 is not TRUE