[Rd] how to determine if a function's result is invisible
Philippe Grosjean
phgrosjean at sciviews.org
Sun Oct 29 10:47:20 CET 2006
Duncan Murdoch wrote:
> On 10/28/2006 6:03 PM, Philippe Grosjean wrote:
>> Duncan Murdoch wrote:
>> [...]
>>> I've just added this function to R-devel (to become 2.5.0 next spring):
>>>
>>> withVisible <- function(x) {
>>> x <- substitute(x)
>>> v <- .Internal(eval.with.vis(x, parent.frame(), baseenv()))
>>> v
>>> }
>>>
>>> Luke Tierney suggested simplifying the interface (no need to
>>> duplicate the 3 parameter eval interface, you can just wrap this in
>>> evalq() if you need that flexibility); the name "with.vis" was
>>> suggested, but it looks like an S3 method for the with() generic, so
>>> I renamed it.
>>>
>>> Duncan Murdoch
>>
>> Excellent, many thanks... but I am afraid I cannot use this function
>> because you force evaluation on parent.frame(), where I need to
>> evaluate it in .GlobalEnv (which is NOT equal to parent.frame() in my
>> context). Would it be possible to change it to:
>>
>> withVisible <- function(x, env = parent.frame()) {
>> x <- substitute(x)
>> v <- .Internal(eval.with.vis(x, env, baseenv()))
>> v
>> }
>>
>> ...so that we got additional flexibility?
>
> As I said, that's not needed. Use evalq(withVisible(x), envir=.GlobalEnv).
Fine, that's not needed. But, what's better: to use two embedded
functions, like you propose, or to add an argument with default value in
one function? I guess you know the answer, both in term of simplicity
and in term of efficiency.
>> This is one good example of problems we encounter if we want to make R
>> GUIs that emulate the very, very complex mechanism used by R to
>> evaluate a command send at the prompt.
>
> No, it's not.
Yes, it is, because it is not that easy for everybody to determine if a
function returns its result visibly or not... or this thread would never
been started. Also, I don't think it is that easy to find the answer to
a problem, if that solution is hidden in an undocumented function only.
Hopefully, the problem is solved now, thanks to your initiative.
Otherwise, command line process in R (S) IS very complex. Just a couple
of reasons why it is:
- There is no explicit indicator that a code line is continued to the
next line. It is the parser that determines that, according to the
context. This problem has already been discussed on R-Help, and Peter
Dalgaard proposed a solution... Again, there is no isLineComplete()
function or so, that does this automatically. So, here is one, after
Peter Dalgaard's idea:
isLineComplete <- function(x) {
# x is a character string vector with R code
# The function determines if the parser is satisfied with it
# or it needs more input (code is continued at the next line)
# First parse code
con <- textConnection(x)
expr <- try(parse(con), silent = TRUE)
close(con)
# Determine if this code is correctly parsed
if (inherits(expr, "try-error")) {
results <- expr
# Determine if it is an incomplete line
if (length(grep("\n2:", results)) == 1) return(FALSE)
}
# Note: here, we return TRUE also if the code is wrong
# but one could enhance the function to return something
# else in case of wrong R code
return(TRUE)
}
> isLineComplete("ls()")
[1] TRUE
> isLineComplete("ls(")
[1] FALSE
> isLineComplete("ls())")
[1] TRUE
- For functions like: xxx.yyy(), it is impossible to know if they are
xxx methods for yyy S3 objects, or simply a function called xxx.yyy()
without parsing the code, or interrogating R another way.
- The mechanism that manages warnings is very complex. First you have
options(warn=X). Then, depending on its value, warnings are issued as
errors, as warnings immediately, or their output is differed at the end
of all the output (and in this case, warnings are only printed if there
are few of them. Otherwise a message is issued and only the 50 first
warnings are saved in last.warning). So, OK, fine. Convenience and
flexibility is obviously what motivated this design. But now, is it a
function that emulates this behavior to capture code evaluation in a
variable, including possible warnings and errors? I did look for it, and
I didn't found it. Functions like capture.output() do not capture errors
or warnings:
> res <- capture.output(1+1, 2+2)
> res
[1] "[1] 2" "[1] 4"
> res <- capture.output({1+1; 2+AAA})
Erreur dans eval.with.vis(expr, pf, baseenv()) :
objet "AAA" non trouvé
> res <- capture.output(1:3+1:2)
Warning message:
la longueur de l'objet le plus long
n'est pas un multiple de la longueur de l'objet le plus court
in: 1:3 + 1:2
Thus, I am left with little tools in R to emulate this. I have to get
hands durty and write my own capture.all() function, which starts like this:
capture.all <- function(expr) {
file <- textConnection("rval", "w", local = TRUE)
sink(file, type = "output")
sink(file, type = "message")
on.exit({
sink(type = "output")
sink(type = "message")
close(file)
})
[....]
}
Fortunately, I can use the convenient withCallingHandler(),
simpleCondition(), simpleError(), simpleWarning(), signalCondition(),
etc. to get full control on how my code is evaluated in R, including
handling of errors and warnings.
However, I notice that emulating the complex R mechanism of handling
warnings is not that an easy thing to program with the
withCallingHandlers() function. The result is the very long and awful
function printed at the very end of this message.
May be, am I not using the right function here, and may be I did not
spot the undocumented function that deals nicely with warnings like I
want. But whatever the answer, this is definitely not an easy task to
spot or program the function to do this.
As an example, John Fox did an excellent job to put the results of code
evaluation right in the R Commander window... but R code evaluation is
not handled perfectly there: no split of R code on two or more lines is
permitted, and warnings are not handled by his code. As a result,
warnings still print on the original R console window that may be hidden
with the large R Commander window... and that could lead to weird
situations where people do not understand why R/R Commander is not
giving the expected results, as they don't see the warnings. I am sure
that John tries to solve these problems, but apparently, he was not
successful.
Otherwise, I appreciate your efforts to make things simpler and neater.
One example is your withVisible() function. Another example is your
better reimplementation of custom menus in RGui. Thanks.
Philippe Grosjean
> Duncan Murdoch
>
>>
>> Since we are on this topic, here is a copy of the function I am
>> working on. It emulates most of the mechanism (Is the code line
>> complete or not? Do we issue one or several warnings? When? Correct
>> error message in case of a stop condition or other errors? Return of
>> results with visibility? Etc.). As you can see, it is incredibly
>> complex. So, do I make a mistake somewhere, or are we really forced to
>> make all these computations to emulate the way R works at the command
>> line (to put in a context, this is part of a R socket server to be
>> used, for instance, in Tinn-R to fork output of R in the Tinn-R
>> console, without blocking the original R console, or R terminal).
>
> I
>>
>> Best,
>>
>> Philippe Grosjean
>>
>>
>> processSocket <- function(msg) {
>> # This is the default R function that processes a command send
>> # by a socket client
>> # 'msg' is assumed to be R code contained in a string
>>
>> # First parse code
>> msgcon <- textConnection(msg)
>> expr <- try(parse(msgcon), silent = TRUE)
>> close(msgcon)
>>
>> # Determine if this code is correctly parsed
>> if (inherits(expr, "try-error")) {
>> results <- expr
>> # Determine if it is incorrect code, or incomplete line!
>> if (length(grep("\n2:", results)) == 1) {
>> ### TODO: use the continue prompt from options!
>> results <- "\n+ " # Send just the continue prompt
>> # The client must manage the rest!
>> } else {
>> # Rework error message
>> toReplace <- "^([^ ]* )[^:]*(:.*)$"
>> Replace <- "\\1\\2"
>> results <- sub(toReplace, Replace, results)
>> # Add the prompt at the end to show that R is ready
>> # to process new commands
>> results <- paste(results, "> ", sep = "\n")
>> }
>> } else { # Code is correctly parsed,
>> # evaluate generated expression(s)
>>
>> # capture.all() is inspired from capture.output(),
>> # but it captures both the output and the message streams
>> capture.all <- function(expr) {
>> file <- textConnection("rval", "w", local = TRUE)
>> sink(file, type = "output")
>> sink(file, type = "message")
>> on.exit({
>> sink(type = "output")
>> sink(type = "message")
>> close(file)
>> })
>> ### TODO: do not erase 'last.warning',
>> # otherwise warnings(), etc. do not work!
>> evalVis <- function(Expr) {
>> if (getOption("warn") == 0) {
>> # We need to install our own warning handling
>> # and also, we use a customized interrupt handler
>> owarn <- getOption("warning.expression")
>> # Inactivate current warning handler
>> options(warning.expression = expression())
>> # ... and make sure it is restored at the end
>> on.exit({
>> # Check that the warning.expression
>> # was not changed
>> nwarn <- getOption("warning.expression")
>> if (!is.null(nwarn) &&
>> length(as.character(nwarn)) == 0)
>> options(warning.expression = owarn)
>> # If the evaluation did not generated warnings,
>> # restore old "last.warning"
>> if (!exists("last.warning",
>> envir = .GlobalEnv) &&
>> !is.null(save.last.warning))
>> last.warning <<- save.last.warning
>> })
>> # Save the current content of "last.warning"
>> # From .GlobalEnv
>> if (exists("last.warning", envir = .GlobalEnv)) {
>> save.last.warning <- get("last.warning",
>> envir = .GlobalEnv)
>> # ... and delete it
>> rm(last.warning, envir = .GlobalEnv)
>> } else {
>> save.last.warning <- NULL
>> }
>> myEvalEnv.. <- .GlobalEnv
>> res <- try(withCallingHandlers(.Internal(
>> eval.with.vis(Expr, myEvalEnv.., baseenv())),
>> # Our custom warning handler
>> ### TODO: how to deal with immediate warnings!
>> # (currently, all warnings are differed!)
>> warning = function(w) {
>> if (exists("last.warning", envir =.GlobalEnv)) {
>> lwarn <- get("last.warning",
>> envir = .GlobalEnv)
>> } else lwarn <- list()
>> # Do not add more than 50 warnings
>> if (length(lwarn) >= 50) return()
>> # Add the warning to this list
>> nwarn <- length(lwarn)
>> names.warn <- names(lwarn)
>> Call <- conditionCall(w)
>> # If warning generated in eval environment,
>> # put it as character(0)
>> if (Call == "eval.with.vis(Expr, myEvalEnv..,
>> baseenv())")
>> Call <- character(0) # I don't use NULL,
>> # because it doesn't add to a list!
>> lwarn[[nwarn + 1]] <- Call
>> names(lwarn) <- c(names.warn,
>> conditionMessage(w))
>> # Save the modified version in .GlobalEnv
>> last.warning <<- lwarn
>> return()
>> },
>> interrupt = function(i) cat("<INTERRUPTED!>\n")),
>> silent = TRUE)
>> # Possibly add 'last.warning' as attribute to res
>> if (exists("last.warning", envir = .GlobalEnv))
>> attr(res, "last.warning") <- get("last.warning",
>> envir = .GlobalEnv)
>> } else { # We have a simpler warning handler
>> owarn <- getOption("warning.expression")
>> # Inactivate current warning handler
>> options(warning.expression = expression())
>> # ... and make sure it is restored at the end
>> on.exit({
>> # Check that the warning.expression was
>> #not changed
>> nwarn <- getOption("warning.expression")
>> if (!is.null(nwarn) &&
>> length(as.character(nwarn)) == 0)
>> options(warning.expression = owarn)
>> })
>> myEvalEnv.. <- .GlobalEnv
>> res <- try(withCallingHandlers(.Internal(
>> eval.with.vis(Expr, myEvalEnv.., baseenv())),
>> warning = function(w) {
>> Mes <- conditionMessage(w)
>> Call <- conditionCall(w)
>> # Result depends upon 'warn'
>> Warn <- getOption("warn")
>> if (Warn < 0) { # Do nothing!
>> return()
>> } else if (Warn > 1) { # Generate an error!
>> Mes <- paste("(converted from warning)", Mes)
>> stop(simpleError(Mes, call = Call))
>> } else { # Print the warning message
>> # Format the warning message
>> ### TODO: translate this!
>> # If warning generated in eval
>> # environment, do not print call
>> if (Call == "eval.with.vis(Expr,
>> myEvalEnv.., baseenv())") {
>> cat("Warning message:\n", Mes,
>> "\n", sep = "")
>> } else {
>> cat("Warning message:\n", Mes,
>> " in: ", as.character(Call),
>> "\n", sep = "")
>> }
>> }
>> },
>> interrupt = function(i)
>> cat("<INTERRUPTED!>\n")), silent = TRUE)
>> }
>> return(res)
>> }
>> tmp <- list()
>> for (i in 1:length(expr)) {
>> tmp[[i]] <- evalVis(expr[[i]])
>> if (inherits(tmp[[i]], "try-error")) break
>> }
>> #tmp <- lapply(expr, evalVis) # This one does not stop
>> #on error!?
>> # This is my function to display delayed warnings
>> WarningMessage <- function(last.warning) {
>> n.warn <- length(last.warning)
>> if (n.warn < 11) { # If less than 11 warnings,
>> # print them
>> if (exists("last.warning", envir = .GlobalEnv)) {
>> owarn <- get("last.warning", envir = .GlobalEnv)
>> } else owarn <- NULL
>> last.warning <<- last.warning
>> invisible(warnings())
>> if (is.null(owarn)) {
>> rm("last.warning", envir = .GlobalEnv)
>> } else last.warning <<- owarn
>> } else {
>> # Generate a message similar to the one we got
>> # at the command line
>> ### TODO: translation of this message!
>> if (n.warn >= 50) {
>> cat("There were 50 or more warnings (use warnings() to see
>> the first 50)\n")
>> } else {
>> cat("There were", n.warn, "warnings (use warnings() to
>> see them)\n", sep = " ")
>> }
>> }
>> return(invisible(n.warn))
>> }
>> # Process all generated items
>> for (item in tmp) {
>> if (inherits(item, "try-error")) {
>> # Rework the error message if it occurs in the
>> # calling environment
>> toReplace <- "^([^ ]*) .*eval\.with\.vis[(]Expr,
>> myEvalEnv\.\., baseenv[(][)][)].*:.*\n\t(.*)$"
>> Replace <- "\\1 : \\2"
>> cat(sub(toReplace, Replace, unclass(item)))
>> # Do we have to print 'last.warning'?
>> last.warning <- attr(item, "last.warning")
>> if (!is.null(last.warning)) {
>> # Add "In addition: " before warning, like at
>> # the command line
>> cat("In addition: ")
>> WarningMessage(last.warning)
>> }
>> } else { # No error
>> if (item$visible) {
>> print(item$value)
>> }
>> # Do we have to print 'last.warning'?
>> last.warning <- attr(item, "last.warning")
>> if (!is.null(last.warning))
>> WarningMessage(last.warning)
>> }
>> }
>> return(rval)
>> }
>> results <- capture.all(expr)
>> if (inherits(results, "list"))
>> results <- paste(results, collapse = "\n")
>> # Add the prompt at the end to show that R is ready to process
>> # new commands
>> results <- paste(paste(results, collapse = "\n"), "> ",
>> sep = "\n")
>> # Note: we don't use options()$prompt here... we always use a
>> # fixed string! It is the client that must manage
>> # possible change
>> }
>> return(results)
>> }
>>
>
>
>
More information about the R-devel
mailing list