Global substitute of expression using regular expressions.

egsub(pattern, replacement, x, ..., value=TRUE, envir=parent.frame(), inherits=TRUE)

Arguments

pattern

A character string with the regular expression to be matched, cf. gsub().

replacement

A character string of the replacement to use when there is a match, cf. gsub().

x

The expression or a function to be modified.

...

Additional arguments passed to gsub()

value

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.

envir, inherits

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.

Value

Returns an expression.

Author

Henrik Bengtsson

Examples

# 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