[Rd] how to determine if a function's result is invisible
Duncan Murdoch
murdoch at stats.uwo.ca
Sun Oct 29 11:44:03 CET 2006
On 10/29/2006 4:47 AM, Philippe Grosjean wrote:
> 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.
No, it's not, because the problem you claimed to exist doesn't exist.
> 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.
That's an example of a real problem.
> Hopefully, the problem is solved now, thanks to your initiative.
And also thanks to Gabor bringing it up: and that's really the solution
to this second problem. If you want to do something unusual and don't
see a way to do it, ask on R-devel. If the solution you get requires
undocumented functions calls or other kludges, suggest a clean solution
to it.
> 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:
The code below looks fragile to me: it depends on the format of the
error message report. I'm hoping to make syntax errors more informative
in the next release, and that will probably change the format of the
reports.
More information about an error is available at the C level, but I'm not
sure how much of that is published in the API.
Now would be a good time to suggest the ideal thing for parse() to
return, from your point of view. It may not be doable, but if it is,
and it would work in other situations, there's a chance it will make it
into 2.5.0.
>
> 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.
I think you shouldn't care. You should leave the evaluation of
expressions up to R. R should provide a way for a GUI to evaluate
something, and should tell the GUI as much as the GUI needs to know to
operate, but the GUI shouldn't try to be an R interpreter.
> - 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.
I think it's unlikely that I will be doing anything with the
error/warning mechanism, but there are other people who might. So I'd
suggest you propose a change that would meet your needs, and see if
anyone responds.
Duncan Murdoch
>
> 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