33 messages · Marc Schwartz, Deepayan Sarkar, Bill Dunlap +6 more
Messages 1–25 of 33
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
Gabor,
There may be a better way of doing this and/or this will spark some
thoughts.
Let's create two simple functions:
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
So we now have:
f.inv(1) f(1)
[1] 1
any(grep("invisible", (deparse(f))))
[1] FALSE
any(grep("invisible", (deparse(f.inv))))
[1] TRUE This is not extensively tested of course, but another function that comes to mind that does return a result 'invisibly' is:
any(grep("invisible", (deparse(barplot.default))))
[1] TRUE So there seems to be some foundation for working, as long as the target function can be deparsed, which may limit things with respect to C/FORTRAN based functions. HTH, Marc Schwartz
On Wed, 2006-10-25 at 20:14 -0400, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
Gabor,
There may be a better way of doing this and/or this will spark some
thoughts.
Let's create two simple functions:
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
So we now have:
f.inv(1) f(1)
[1] 1
any(grep("invisible", (deparse(f))))
[1] FALSE
any(grep("invisible", (deparse(f.inv))))
[1] TRUE
That's not going to work, since invisibility can also be a side effect
of assignment, e.g.
g <- function(x) { x <- x }
-Deepayan
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it. I think you'll just have to do require the user of your F to tell you that they want the result to be invisible. Duncan Murdoch
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it. I think you'll just have to do require the user of your F to tell you that they want the result to be invisible. Duncan Murdoch
Perhaps R_Visible be made available at the R level in the future. It would be helpful in situations where you are transforming a function but want to keep aspects of it such as whether the return result is invisible.
On Wed, 2006-10-25 at 20:14 -0400, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
Gabor,
There may be a better way of doing this and/or this will spark some
thoughts.
Let's create two simple functions:
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
So we now have:
f.inv(1) f(1)
[1] 1
any(grep("invisible", (deparse(f))))
[1] FALSE
any(grep("invisible", (deparse(f.inv))))
[1] TRUE This is not extensively tested of course, but another function that comes to mind that does return a result 'invisibly' is:
any(grep("invisible", (deparse(barplot.default))))
[1] TRUE So there seems to be some foundation for working, as long as the target function can be deparsed, which may limit things with respect to C/FORTRAN based functions. HTH, Marc Schwartz
Clever idea. As others have mentioned there are some limitations plus generics would not work since the code is in the methods but its an interesting suggestion that would work part of the time.
On 10/25/06, Marc Schwartz <MSchwartz at mn.rr.com> wrote:
On Wed, 2006-10-25 at 20:14 -0400, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
Gabor,
There may be a better way of doing this and/or this will spark some
thoughts.
Let's create two simple functions:
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
So we now have:
f.inv(1) f(1)
[1] 1
any(grep("invisible", (deparse(f))))
[1] FALSE
any(grep("invisible", (deparse(f.inv))))
[1] TRUE
That's not going to work, since invisibility can also be a side effect
of assignment, e.g.
g <- function(x) { x <- x }
Good point. Can we tweak it a bit to try to cover additional
situations, such as this? For example:
is.invisible <- function(x)
{
dep.x <- deparse(x)
ifelse(any(grep("invisible", dep.x)) |
any(grep("<-", dep.x[length(dep.x) - 1])),
TRUE, FALSE)
}
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
g <- function(x) { x <- x }
is.invisible(f.inv)
[1] TRUE
is.invisible(f)
[1] FALSE
is.invisible(g)
[1] TRUE
In this case to (possibly) cover the assignment situation, I am looking
for an assignment operator ("<-") in the last code line of the function
body. Note that if there are blank lines in the function body after the
assignment line and before the closing brace, the assignment line is
still the final line of code found in the deparse().
Given Duncan's comment, it sounds like this might not be doable for 100%
of the situations, but we may be able to cover the 80% of the common
ones.
Gabor, to your follow up comment about generics, perhaps the code can be
yet further extended to check the class of the relevant argument(s) to
the function(s) in question to similarly search/deparse the methods that
would presumably be dispatched. It would certainly become more
convoluted however.
Thoughts?
Marc
On Wed, 2006-10-25 at 19:16 -0700, Deepayan Sarkar wrote:
On 10/25/06, Marc Schwartz <MSchwartz at mn.rr.com> wrote:
On Wed, 2006-10-25 at 20:14 -0400, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
Gabor,
There may be a better way of doing this and/or this will spark some
thoughts.
Let's create two simple functions:
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
So we now have:
f.inv(1) f(1)
[1] 1
any(grep("invisible", (deparse(f))))
[1] FALSE
any(grep("invisible", (deparse(f.inv))))
[1] TRUE
That's not going to work, since invisibility can also be a side effect
of assignment, e.g.
g <- function(x) { x <- x }
Good point. Can we tweak it a bit to try to cover additional
situations, such as this? For example:
is.invisible <- function(x)
{
dep.x <- deparse(x)
ifelse(any(grep("invisible", dep.x)) |
any(grep("<-", dep.x[length(dep.x) - 1])),
TRUE, FALSE)
}
f.inv <- function(x) {invisible(x)}
f <- function(x) {x}
g <- function(x) { x <- x }
is.invisible(f.inv)
[1] TRUE
is.invisible(f)
[1] FALSE
is.invisible(g)
[1] TRUE
In this case to (possibly) cover the assignment situation, I am looking
for an assignment operator ("<-") in the last code line of the function
body. Note that if there are blank lines in the function body after the
assignment line and before the closing brace, the assignment line is
still the final line of code found in the deparse().
Given Duncan's comment, it sounds like this might not be doable for 100%
of the situations, but we may be able to cover the 80% of the common
ones.
Gabor, to your follow up comment about generics, perhaps the code can be
yet further extended to check the class of the relevant argument(s) to
the function(s) in question to similarly search/deparse the methods that
would presumably be dispatched. It would certainly become more
convoluted however.
In the case of S3 one could search for a UseMethod and, if found, just search all available methods for invisible without trying to figure out which one(s) get dispatched on the theory that its likely that they will all return or all not return invisibly since methods are supposed to maintain a certain sense of semantic consistency. In the case of internal R functions there may not be that many that return invisibly so one could just make a list of them and check against that list. Is there some way to grep these out?
On 10/25/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it. I think you'll just have to do require the user of your F to tell you that they want the result to be invisible. Duncan Murdoch
Perhaps R_Visible be made available at the R level in the future. It would be helpful in situations where you are transforming a function but want to keep aspects of it such as whether the return result is invisible.
Actually, there is a way, but it's undocumented (i.e., use at your own
risk). It's the eval.with.vis function. This is an internal function
that is used within source() and capture.output(); you'll have to guess
from the usage there what the args are. But here's an F that does
something close to what you want:
> fix(F)
> f <- function() 1
> g <- function() invisible(1)
>
> F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value
[1] 1
$visible
[1] TRUE
> F(g())
$value
[1] 1
$visible
[1] FALSE
On 10/25/2006 11:02 PM, Gabor Grothendieck wrote:
On 10/25/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it. I think you'll just have to do require the user of your F to tell you that they want the result to be invisible. Duncan Murdoch
Perhaps R_Visible be made available at the R level in the future. It would be helpful in situations where you are transforming a function but want to keep aspects of it such as whether the return result is invisible.
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
Perfect. Thanks!!!!
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
[...]
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function
Yes... and there are three problems here: 1) To spot the undocumented function one is looking for, 2) To figure out how to use it, 3) To rewrite your code regularly if you maintain packages that use several of such undocumented functions. This is the case of many R GUI projects... and one reason why staying up-to-date with the new versions of R (every 6 months) is a nightmare for these GUIs! For instance, I use eval.with.vis() in the latest version of svSockets package in the SciViews bundle, but I am afraid to release it on CRAN because I know of the nightware I will face if this function (silently) changes its behavior in subsequent versions of R. I guess there is no solution to this problem, since there is certainly a good reason for keeping portions of R code undocumented (and thus flagged as :" use-it-at-your-own-risk!"), but it does not eases our life! Best, Philippe Grosjean
that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
[...]
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function
Yes... and there are three problems here: 1) To spot the undocumented function one is looking for, 2) To figure out how to use it, 3) To rewrite your code regularly if you maintain packages that use several of such undocumented functions. This is the case of many R GUI projects... and one reason why staying up-to-date with the new versions of R (every 6 months) is a nightmare for these GUIs! For instance, I use eval.with.vis() in the latest version of svSockets package in the SciViews bundle, but I am afraid to release it on CRAN because I know of the nightware I will face if this function (silently) changes its behavior in subsequent versions of R. I guess there is no solution to this problem, since there is certainly a good reason for keeping portions of R code undocumented (and thus flagged as :" use-it-at-your-own-risk!"), but it does not eases our life! Best, Philippe Grosjean
that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
I will be using it in the next version of the gsubfn package and am also considering it for an application in the dyn package too so that makes two or three packages already. I think it would be a good idea to make it or equivalent generally available in R.
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
[...]
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function
Yes... and there are three problems here: 1) To spot the undocumented function one is looking for, 2) To figure out how to use it, 3) To rewrite your code regularly if you maintain packages that use several of such undocumented functions. This is the case of many R GUI projects... and one reason why staying up-to-date with the new versions of R (every 6 months) is a nightmare for these GUIs!
Those are definitely real problems. At the last useR meeting, Thomas Baier made an excellent suggestion: someone should put together an API specifically for R GUIs. I think eval.with.vis would have to be part of such an API; there are dozens of other currently undocumented or unavailable functions as well. This is a difficult project, because it would have to get agreement on what should be part of the API, and that will constrain future changes: so there would be a lot of resistance to making it too constraining. It will need to be flexible, so that R isn't required to supply services that don't make sense in all contexts. Duncan Murdoch
For instance, I use eval.with.vis() in the latest version of svSockets package in the SciViews bundle, but I am afraid to release it on CRAN because I know of the nightware I will face if this function (silently) changes its behavior in subsequent versions of R. I guess there is no solution to this problem, since there is certainly a good reason for keeping portions of R code undocumented (and thus flagged as :" use-it-at-your-own-risk!"), but it does not eases our life! Best, Philippe Grosjean
that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
Perhaps there could be a set of functions that are made available without the promise of future compatibility but with the promise that they will change less frequently than if they were not documented and if they are changed the changes will be highlighted to make it easier for the users of the API to know about such changes. That might overcome resistance stemming from the fear of prematurely setting design decisions in stone.
On 10/26/2006 6:28 AM, Philippe Grosjean wrote:
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
[...]
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function
Yes... and there are three problems here: 1) To spot the undocumented function one is looking for, 2) To figure out how to use it, 3) To rewrite your code regularly if you maintain packages that use several of such undocumented functions. This is the case of many R GUI projects... and one reason why staying up-to-date with the new versions of R (every 6 months) is a nightmare for these GUIs!
Those are definitely real problems. At the last useR meeting, Thomas Baier made an excellent suggestion: someone should put together an API specifically for R GUIs. I think eval.with.vis would have to be part of such an API; there are dozens of other currently undocumented or unavailable functions as well. This is a difficult project, because it would have to get agreement on what should be part of the API, and that will constrain future changes: so there would be a lot of resistance to making it too constraining. It will need to be flexible, so that R isn't required to supply services that don't make sense in all contexts. Duncan Murdoch
For instance, I use eval.with.vis() in the latest version of svSockets package in the SciViews bundle, but I am afraid to release it on CRAN because I know of the nightware I will face if this function (silently) changes its behavior in subsequent versions of R. I guess there is no solution to this problem, since there is certainly a good reason for keeping portions of R code undocumented (and thus flagged as :" use-it-at-your-own-risk!"), but it does not eases our life! Best, Philippe Grosjean
that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
[...]
At the last useR meeting, Thomas Baier made an excellent suggestion: someone should put together an API specifically for R GUIs. I think eval.with.vis would have to be part of such an API; there are dozens of other currently undocumented or unavailable functions as well.
Ah, ha! I am very happy to discover that Thomas Baier had this excellent idea at the last useR meeting. It is almost four years that I claims for a R GUI API. If you look at the manual that comes with the SciViews bundle (available on CRAN), you will notice that there is a manual called 'SciViews-R, A GUI API and a suite of application for R' (see http://www.sciviews.org/SciViews-R/Manual.pdf) with about 50 pages that discuss several aspects related to R GUI APIs. There are also threads in the R Wiki that discusses a similar topic (although more related to graphical widgets): http://wiki.r-project.org/rwiki/doku.php?id=developers:iwidgets&s=api, http://wiki.r-project.org/rwiki/doku.php?id=developers:gwidgets_api. This is mainly the work of John Versani, after a discussion between Him, Simon Urbanek (iWidgets), Michael Lawrence (RGtk2), and myself (SciViews). That said, I did several attempt to put all people at R-SIG-GUI around a table to define a common R GUI API,... and I got no significant echo. So, I personally give up with this topic and look at what others, perhaps stronger than me in R programming or in communication with other developers, will do. But, please, do not give credit for "first idea" to someone else on such a topic... It is long enough that I fight for better R GUIs (for instance, http://www.r-project.org/GUI), that this looks offending to me! Best, Philippe Grosjean
This is a difficult project, because it would have to get agreement on what should be part of the API, and that will constrain future changes: so there would be a lot of resistance to making it too constraining. It will need to be flexible, so that R isn't required to supply services that don't make sense in all contexts. Duncan Murdoch
For instance, I use eval.with.vis() in the latest version of svSockets package in the SciViews bundle, but I am afraid to release it on CRAN because I know of the nightware I will face if this function (silently) changes its behavior in subsequent versions of R. I guess there is no solution to this problem, since there is certainly a good reason for keeping portions of R code undocumented (and thus flagged as :" use-it-at-your-own-risk!"), but it does not eases our life! Best, Philippe Grosjean
that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does.
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it.
source(print.eval=TRUE) appears to do this by using an eval.with.vis()
function that calls a .Internal():
eval.with.vis <- function(expr, envir = parent.frame(),
enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv())
.Internal(eval.with.vis(expr, envir, enclos))
Perhaps that could be adapted for more general use.
----------------------------------------------------------------------------
Bill Dunlap
Insightful Corporation
bill at insightful dot com
360-428-8146
"All statements in this message represent the opinions of the author and do
not necessarily reflect Insightful Corporation policy or position."
But, please, do not give credit for "first idea" to someone else on such a topic... It is long enough that I fight for better R GUIs (for instance, http://www.r-project.org/GUI), that this looks offending to me!
Sorry, I didn't mean to claim that he's the first one to think of this, just that he did bring it up recently, and that it's an excellent idea. I think the fact that we don't have a GUI API is support for my statement that it's a difficult project. Not all the difficulties are technical. Duncan Murdoch
Perhaps there could be a set of functions that are made available without the promise of future compatibility but with the promise that they will change less frequently than if they were not documented and if they are changed the changes will be highlighted to make it easier for the users of the API to know about such changes. That might overcome resistance stemming from the fear of prematurely setting design decisions in stone.
Actually, I think that's about as much of a guarantee as things that are set in stone get. R is built of soft stone :-). Duncan Murdoch
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/26/2006 6:28 AM, Philippe Grosjean wrote:
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
[...]
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function
Yes... and there are three problems here: 1) To spot the undocumented function one is looking for, 2) To figure out how to use it, 3) To rewrite your code regularly if you maintain packages that use several of such undocumented functions. This is the case of many R GUI projects... and one reason why staying up-to-date with the new versions of R (every 6 months) is a nightmare for these GUIs!
Those are definitely real problems. At the last useR meeting, Thomas Baier made an excellent suggestion: someone should put together an API specifically for R GUIs. I think eval.with.vis would have to be part of such an API; there are dozens of other currently undocumented or unavailable functions as well. This is a difficult project, because it would have to get agreement on what should be part of the API, and that will constrain future changes: so there would be a lot of resistance to making it too constraining. It will need to be flexible, so that R isn't required to supply services that don't make sense in all contexts. Duncan Murdoch
For instance, I use eval.with.vis() in the latest version of svSockets package in the SciViews bundle, but I am afraid to release it on CRAN because I know of the nightware I will face if this function (silently) changes its behavior in subsequent versions of R. I guess there is no solution to this problem, since there is certainly a good reason for keeping portions of R code undocumented (and thus flagged as :" use-it-at-your-own-risk!"), but it does not eases our life! Best, Philippe Grosjean
that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 11:02 PM, Gabor Grothendieck wrote:
On 10/25/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it. I think you'll just have to do require the user of your F to tell you that they want the result to be invisible. Duncan Murdoch
Perhaps R_Visible be made available at the R level in the future. It would be helpful in situations where you are transforming a function but want to keep aspects of it such as whether the return result is invisible.
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
Perfect. Thanks!!!!
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
Thanks!
On 10/26/2006 5:26 AM, Gabor Grothendieck wrote:
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 11:02 PM, Gabor Grothendieck wrote:
On 10/25/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that unlike F returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the value won't print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not available in the API for you to write C code to look at it. I think you'll just have to do require the user of your F to tell you that they want the result to be invisible. Duncan Murdoch
Perhaps R_Visible be made available at the R level in the future. It would be helpful in situations where you are transforming a function but want to keep aspects of it such as whether the return result is invisible.
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function that is used within source() and capture.output(); you'll have to guess from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
Perfect. Thanks!!!!
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
Dear Duncan, Thanks for this -- it'll enable me to get rid of a list of functions returning invisible output that the Rcmdr maintains. Regards, John -------------------------------- John Fox Department of Sociology McMaster University Hamilton, Ontario Canada L8S 4M4 905-525-9140x23604 http://socserv.mcmaster.ca/jfox --------------------------------
-----Original Message----- From: r-devel-bounces at r-project.org [mailto:r-devel-bounces at r-project.org] On Behalf Of Duncan Murdoch Sent: Saturday, October 28, 2006 12:13 PM To: Gabor Grothendieck Cc: Luke Tierney; Martin Maechler; R Development Mailing List Subject: Re: [Rd] how to determine if a function's result is invisible On 10/26/2006 5:26 AM, Gabor Grothendieck wrote:
On 10/26/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 11:02 PM, Gabor Grothendieck wrote:
On 10/25/06, Duncan Murdoch <murdoch at stats.uwo.ca> wrote:
On 10/25/2006 8:14 PM, Gabor Grothendieck wrote:
Suppose we have a function such as the following F <- function(f, x) f(x)+1 which runs function f and then transforms it. I would like the corresponding function which works the same except that
unlike F
returns an invisible result if and only if f does. Is there some way of determining whether f returns an invisible result or not? Thus we want this: f <- function(x) x g <- function(x) invisible(x)
F(f, 1)
2
F(g, 1)
I don't think there's a way to do that. Internally there's a global flag called R_Visible; if it is set to zero, the
value won't
print. But it gets reset to 1 very easily (e.g. by adding 1 to the result of an invisible function), and it's not
available in the
API for you to write C code to look at it. I think you'll just have to do require the user of your
F to tell
you that they want the result to be invisible. Duncan Murdoch
Perhaps R_Visible be made available at the R level in the future. It would be helpful in situations where you are transforming a function but want to keep aspects of it such as whether
the return
result is invisible.
Actually, there is a way, but it's undocumented (i.e., use at your own risk). It's the eval.with.vis function. This is an internal function that is used within source() and
capture.output(); you'll have to guess
from the usage there what the args are. But here's an F that does something close to what you want:
> fix(F) > f <- function() 1 > g <- function() invisible(1) > > F <- function (expr)
+ {
+ expr <- substitute(expr)
+ pf <- parent.frame()
+ tmp <- .Internal(eval.with.vis(expr, pf,
+ baseenv()))
+ tmp
+ }
> F(f())
$value [1] 1 $visible [1] TRUE
> F(g())
$value [1] 1 $visible [1] FALSE
Perfect. Thanks!!!!
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
______________________________________________ R-devel at r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel
[...]
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?
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.
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).
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)
}
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).
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. 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)
}
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)
}
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)
}