Let's assume I have the following code:
maybeBrowser <- function (msg) {
if (interactive()) {
cat(msg, "\n")
???
} else {
stop(msg)
}
}
foo <- function (cond, ...) {
if (cond) maybeBrowser("What a mess")
}
What would ??? have to look like in order to invoke browser() in the context of foo if cond evaluates to TRUE?
Perhaps not the most elegant, but this seems to do what I think you're asking for.
First, two notes:
I'm adding browser(); 1, knowing it doesn't work right away. The ;1 is because browser() will exit immediately if there is not some code after it. If there's something after the if/else block then you might not need it, but it's there for this. (This is only necessary with emacs/ESS: https://github.com/emacs-ess/ESS/issues/178)
I added a variable within the foo environment to demonstrate that we don't (then do) see it.
First, the failing attempt:
maybeBrowser <- function (msg) {
if (interactive()) {
cat(msg, "\n")
browser()
q
} else {
stop(msg)
}
}
foo <- function (cond, ...) {
cat(capture.output(environment()), "\n")
in_foo <- 1
if (cond) maybeBrowser("What a mess")
}
foo(TRUE)
# <environment: 0x000000001b2beba0>
# What a mess
# Called from: maybeBrowser("What a mess")
# Browse[1]>
debug at #5: q
# Browse[2]>
environment()
# <environment: 0x000000001b280030> <---- this is different
# Browse[2]>
ls()
# [1] "msg"
Now a tweak to the code, motivated by https://stackoverflow.com/a/23891089/3358272
maybeBrowser <- function (msg) {
if (interactive()) {
cat(msg, "\n")
return(evalq(browser(skipCalls=1), envir=parent.frame()))
} else {
stop(msg)
}
}
foo <- function (cond, ...) {
cat(capture.output(environment()), "\n")
in_foo <- 1
if (cond) maybeBrowser("What a mess")
}
foo(TRUE)
# <environment: 0x000000001b0b9d40>
# What a mess
# Called from: eval(quote({
# browser()
# 1
# ...
# Browse[1]>
debug at #4: [1] 1
# Browse[3]>
environment()
# <environment: 0x000000001b0b9d40> <---- this is now the same
# Browse[3]>
ls()
# [1] "cond" "in_foo"
However, this is not allowing you to continue, stepping through any following code in foo, so it is an incomplete answer. I think unfortunately that that may not be feasible ... but perhaps a more internals-cognizant R bubba will have more clarity on this.
Related
foo <- function() {
# how to know what environment_of_caller is
}
caller <- function() {
# environment_of_caller
foo()
}
A function that I'm writing needs to the know the environment of its caller. Can that be done without passing the environment in as an argument?
Assuming that you really need to do this, the function parent.frame() gives it.
foo <- function() {
parent.frame()$a
}
caller <- function() {
a <- 1
foo()
}
caller()
## [1] 1
however, normally one would write it like this (only foo is changed) as it gives the desired functionality but also the flexibility to change the environment used.
foo <- function(envir = parent.frame()) {
envir$a
}
caller <- function() {
a <- 1
foo()
}
caller()
## [1] 1
I would like to write a wrapper for the debug() function so that I can remove all debugging flag when needed.
For functions in the search path it is simple.
.debugged <- NULL
debug.wrapper <- function(fun){
f <- deparse(substitute(fun))
.debugged <<- unique(c(.debugged, f))
debug(f)
}
debug.wrapper.off <- function() {
z=sapply(.debugged, undebug)
.debugged <<- NULL
}
It works because I can use the character version of the function symbol.
f <- function() print("hello")
debug.wrapper(f)
isdebugged(f)
# [1] TRUE
debug.wrapper.off()
isdebugged(f)
# [1] FALSE
Anyway with namespaces it does not work:
debug.wrapper(tools:::psnice)
# Error in debug(f) could not find function "tools:::psnice"
Also:
debug(substitute(tools:::psnice))
# Error in debug(fun, text, condition) : argument must be a function
How can I store the function symbols for later reuse?
Note
It seems that concatenating function symbols creates a sort of "soft pointer" rather than a copy, that is:
x <- c(tools:::psnice, identity)
Taking the first function, we get:
x[[1]]
# function (pid = Sys.getpid(), value = NA_integer_)
# {
# res <- .Call(ps_priority, pid, value)
# if (is.na(value))
# res
# else invisible(res)
# }
# <bytecode: 0x00000000189f1f80>
# <environment: namespace:tools>
The bytecode and environment are the same as with tools:::psnice.
Therefore un/debug(x[[1]]) is like un/debug(tools:::psnice)
Solution
Given the note above, the solution is trivial. Debug wrappers are defined as:
.debugged <- NULL
debug.wrapper <- function(fun){
.debugged <<- unique(c(.debugged, fun))
debug(fun)
}
debug.wrapper.off <- function() {
z=sapply(.debugged, undebug)
.debugged <<- NULL
}
Using them brings:
f <- function() print("hello")
debug.wrapper(f)
debug.wrapper(tools:::psnice)
isdebugged(f)
# [1] TRUE
isdebugged(tools:::psnice)
# [1] TRUE
debug.wrapper.off()
isdebugged(f)
isdebugged(tools:::psnice)
.debugged
# NULL
Of course, one can add conditions to manage the case when passed fun is a string.
Thanks to #Rich Scriven, who gave useful insights.
I want to write a function in R which grabs the name of a variable from the context of its caller's caller. I think the problem I have is best understood by asking how to compose deparse and substitute. You can see that a naive composition does not work:
# a compose operator
> `%c%` = function(x,y)function(...)x(y(...))
# a naive attempt to combine deparse and substitute
> desub = deparse %c% substitute
> f=function(foo) { message(desub(foo)) }
> f(log)
foo
# this is how it is supposed to work
> g=function(foo) { message(deparse(substitute(foo))) }
> g(log)
log
I also tried a couple of variations involving eval.parent but with no luck. Any help is appreciated.
Clarification: I'm not looking for a synonym for deparse(substitute(...)), e.g. match.call()[[2]] - what I'm looking for is a way to define a function
desub = function(foo) {
...
# What goes here?
}
such that the definition of f above produces the same answer as g. It should look like this:
> f=function(foo) { message(desub(foo)) }
> f(log)
log
Perhaps match.call could be of use in the body of desub above, but I'd like to know how. Thanks!
As you surmised, this is an issue with environments. The reason why the function f does not give log when you call f(log), is that the environment in which substitute is called, namely the evaluation environment of desub, does not contain a binding to log.
The remedy is to evaluate the call to substitute in the proper environment, and modify desub accordingly:
desub <- function(x, env = parent.frame()) {
deparse(eval(substitute(substitute(x)), envir = env))
}
Now f does what it was intended to do:
f(log)
#> log
Thanks to #egnha and #akrun for the brave attempts. After playing around a bit I found a solution that works.
This fragment:
desub <- function(y) {
e1=substitute(y)
e2=do.call(substitute,list(e1), env=parent.frame())
deparse(e2)
}
gives:
> f <- function(x) message(desub(x))
> f(log)
log
Update:
With help from Mark Bravington on the R-devel list, I was able to generalize this to multiple frames. I thought I should post it here, because it's a bit more useful than the above, and because there was a tricky workaround involving (possibly buggy?) behavior in parent.frame().
# desub(v,0)=="v"
# desub(v,1)==deparse(substitute(v))
# desub(v,2)==name of v in grandparent's frame
# etc.
desub = function(y,n=1) {
env=environment();
for(i in 0:n) {
y = do.call(substitute, list(substitute(y)), env=env)
env = do.call(my_mvb_parent, list(), env=env)
}
deparse(y)
}
# helper:
#
# - using mvb.parent.frame fixes problems with capture.output and
# weird cycling behavior in the built-in parent.frame
#
# - this wrapper makes mvb.parent.frame not throw an error when we get
# to globalenv()
my_mvb_parent=function() {
library(mvbutils)
tryCatch(
mvb.parent.frame(2),
error=function(e) { globalenv()})
}
if(1) {
# example code
g2=function(t) {
for(i in 0:5) {
res=desub(t,i);
print(res);
res1=capture.output(desub(t,i))
stopifnot(capture.output(res)==res1)
}
}
g1=function(z) g2(z)
g=function(y) g1(y)
g(log)
# prints:
## [1] "t"
## [1] "z"
## [1] "y"
## [1] "log"
## [1] "log"
## [1] "log"
}
This is related to some other questions, but I can't seem to figure out how to apply the answer, so I'm asking a new question.
I'm trying to figure out an uninformative error from a piece of code that looks like this:
tryCatch(MainLoop(),
error=function(e) { fatal(lgr, paste('caught fatal error:', as.character(e)));
exit.status <<- 1 })
The problem is that the error appears to be related to something buried in a library function:
Error in nrow(x): (subscript) logical subscript too long
That nrow is not in my code, as the C-level error above only applies to a type of indexing that never happens in any of my nrow calls.
So I'd really like to get a stack trace from within that tryCatch. Here's an analogous problem:
x <- function() { y(); }
y <- function() { z(); }
z <- function() { stop("asdf") }
> x()
Error in z() : asdf
> tryCatch(x(), error=function(e) { print(conditionCall(e)) } )
z()
> tryCatch(x(), error=function(e) { dump.frames() } )
> last.dump
$`tryCatch(x(), error = function(e) {
dump.frames()
})`
<environment: 0x1038e43b8>
$`tryCatchList(expr, classes, parentenv, handlers)`
<environment: 0x1038e4c60>
$`tryCatchOne(expr, names, parentenv, handlers[[1]])`
<environment: 0x1038e4918>
$`value[[3]](cond)`
<environment: 0x1038ea578>
attr(,"error.message")
[1] "asdf"
attr(,"class")
[1] "dump.frames"
How do I get the stack trace that includes the call to y()? Do I have to stop using tryCatch? What's a better way?
For interactive use one might trace(stop, quote(print(sys.calls()))) to print the call stack at the time stop() is invoked.
From ?tryCatch,
The function 'tryCatch' evaluates its expression argument in a
context where the handlers provided in the '...' argument are
available.
whereas
Calling handlers are established by 'withCallingHandlers'...
the handler is called... in the context where the condition
was signaled...
so
> withCallingHandlers(x(), error=function(e) print(sys.calls()))
[[1]]
withCallingHandlers(x(), error = function(e) print(sys.calls()))
[[2]]
x()
[[3]]
y()
[[4]]
z()
[[5]]
stop("asdf")
[[6]]
.handleSimpleError(function (e)
print(sys.calls()), "asdf", quote(z()))
[[7]]
h(simpleError(msg, call))
Error in z() : asdf
This is thwarted if there is an inner tryCatch
withCallingHandlers({
tryCatch(x(), error=function(e) stop("oops"))
}, error=function(e) print(sys.calls()))
as we only have access to the call stack after the tryCatch has 'handled' the error.
Yes, it is possible. It is not too elegant in coding, but very helpful in output!
Any comments are welcome!
I put it in my misc package, use it from there if you want the documentation.
https://github.com/brry/berryFunctions/blob/master/R/tryStack.R
The next CRAN version is planned to be released soon, until then:
devtools::install_github("brry/berryFunctions")
# or use:
source("http://raw.githubusercontent.com/brry/berryFunctions/master/R/instGit.R")
instGit("brry/berryFunctions")
library(berryFunctions)
?tryStack
Here it is for fast reference:
tryStack <- function(
expr,
silent=FALSE
)
{
tryenv <- new.env()
out <- try(withCallingHandlers(expr, error=function(e)
{
stack <- sys.calls()
stack <- stack[-(2:7)]
stack <- head(stack, -2)
stack <- sapply(stack, deparse)
if(!silent && isTRUE(getOption("show.error.messages")))
cat("This is the error stack: ", stack, sep="\n")
assign("stackmsg", value=paste(stack,collapse="\n"), envir=tryenv)
}), silent=silent)
if(inherits(out, "try-error")) out[2] <- tryenv$stackmsg
out
}
lower <- function(a) a+10
upper <- function(b) {plot(b, main=b) ; lower(b) }
d <- tryStack(upper(4))
d <- tryStack(upper("4"))
cat(d[2])
d <- tryStack(upper("4"))
This is the error stack:
tryStack(upper("4"))
upper("4")
lower(b)
Error in a + 10 : non-numeric argument to binary operator
I am a fan of evaluate::try_capture_stack().
x <- function() {
y()
}
y <- function() {
z()
}
z <- function() {
stop("asdf")
}
env <- environment()
e <- evaluate::try_capture_stack(quote(x()), env)
names(e)
#> [1] "message" "call" "calls"
e$calls
#> [[1]]
#> x()
#>
#> [[2]]
#> y()
#>
#> [[3]]
#> z()
#>
#> [[4]]
#> stop("asdf")
I'm a bit late to the party, but I found the best way was to use an exit handler in the function you are trying.
main <- function()
{
on.exit({
msg <- capture.output(traceback())
if (msg != "No traceback available ")
{
print(msg)
}
}
)
# rest of code
}
withCallingHandlers(
expr =
{
main()
},
error = function(e)
{
print(e)
}
)
test is a function to check if an object exists in the global environment, is not empty, and belongs to a particular class.
test <- function(foo, response=TRUE) {
if (missing(foo)) {
response <- FALSE
}
if (response) {
if (!exists(as.character(substitute(foo)), envir = .GlobalEnv)) {
response <- FALSE
}
}
if (response) {
response <- ifelse(class(foo) != "numeric", FALSE, TRUE)
}
return(response)
}
Now in foobar and a dozen other functions, I want to make sure foo is the right kind of object I want before proceeding with anything else.
foobar <- function(foo)
{
if(test(foo)) {
cat ("Yes, I have foo! \n")
}
if(!test(foo)) {
cat("Sorry, not a valid foo")
}
}
>ls()
[1] "foobar" "test"
>test(a)
[1] FALSE
>a <- "foobar"
>test(a)
[1] FALSE
>a <- 1
>test(a)
[1] TRUE
>foobar(a)
Sorry, not a valid foo
>
# what the???
>ls()
[1] "a" "foobar" "test"
>foo <- 1
>foobar(foo)
Yes, I have foo!
>
Objects loose their original names when handed off more than once. The copies get assigned new localnames. You need to grab the name on the first pass and then test with ls()
foobar <- function(foo)
{ fooname <- deparse(substitute(foo)); print(fooname)
if(test(fooname) ) {
cat ("Yes, I have foo! \n")
}
if(!test(fooname) ) {
cat("Sorry, not a valid foo")
}
}
test <- function(foo, response=TRUE) {
if (missing(foo)) {
response <- FALSE
}
if (response) {
if ( foo %in% ls( envir = .GlobalEnv) ) {
response <- TRUE }else {response <- FALSE}
}
return(response)
}
foobar(after)
# [1] "after"
#Yes, I have foo!
To verify, the problem is in the fact that the substitute is nested.
When R looks at foobar(a), it runs test(foo) within the foobar function, and so the variable that the test function looks at is called foo.
I'll start with a toy example to make things easier to explain. The library function, like your test function, interprets its argument via the variable name. i.e. library(MASS) loads the 'MASS' library, not the string that is contained inside the variable 'MASS'.
Now I'll make a function f that just calls library - this mirrors your foobar function:
f <- function(x) {
library(x)
}
Now let's try:
> f(MASS)
Error in library(x) : there is no package called ‘x’
Oh no! It didn't work! How come? Because remember, within the library code, it substitutes the variable passed in. i.e. library <- function(lib,...) substitute(lib).
So f(MASS) goes to function(x) library(x), and hence it's like I typed library(x) straight into the command line -- library is only trying to load x, and not x's value, MASS.
OK, we can fix this: we just need to change library(x) to library(substitute(x)), since substitute(x) is MASS and we'll then end up with library(MASS), right?
f <- function(x) {
library(substitute(x))
}
Let's try:
> f(MASS)
Error in library(substitute(x)) : 'package' must be of length 1
Urgh, what happened? Within f, the substitute(x) is not being evaluated, because library purposefully doesn't evaluate the expression it gets fed, because then typing library(MASS) in the command line wouldn't work.
So we really want to save substitute(x) as a variable and then perform library on that variable.
The only problem is that even if we do y <- substitute(x); library(y) within f, we always run into this problem that the argument fed into library is never evaluated. So doing this will cause the same as the first error: 'there is no package called y'.
How can we fix this? We need to somehow indirectly call library with substitute(x) as the argument, where substitute(x) is evaluated.
Aha! We can use do.call! (note: I didn't come up with this on my own, I was guided by this post to the R mailing list on nested substitutes:
f <- function(x) {
do.call(library,list(substitute(x)))
}
This does exactly what we want - it calls library but passes substitute(x) in as the library. It evaluates substitute(x) first, since we haven't directly written library(substitute(x)). nifty right?
> f(MASS) # no error!
# see if MASS is loaded - check if function 'lda' is there:
> exists('lda',mode='function')
[1] TRUE # huzzah!
Solution for your case
So, applying this lesson to your question, try:
foobar <- function(foo)
{
if ( do.call(test,list(substitute(foo))) ) # see the do.call & substitute?
cat ("Yes, I have foo! \n")
else
cat("Sorry, not a valid foo")
}
Let's see:
> ls()
[1] "foobar" "test"
> test(a)
[1] FALSE
> a <- 'foobar'
> test(a)
[1] FALSE
> a <- 1
> test(a)
[1] TRUE
> foobar(a)
Yes, I have foo!
Huzzah! (by the way: thanks for asking this question, because the answer is something I've always wanted to know).