[Rd] all.equal applied to function closures
Bill Dunlap
w||||@mwdun|@p @end|ng |rom gm@||@com
Tue Dec 1 16:37:02 CET 2020
Probably all.equal.environment's do1() could be enhanced to do the
recursion (and look at the environments' attributes). I wrote a separate
function because it was easier to experiment that way (e.g., when to stop
recursing - it stops when one environment is a top-level environment or the
empty environment). I've been thinking about similar recursion options for
ls.str() - it would make it easier to debug refClass and R6 code where the
data is somewhere in a stack of environments.
> E1 <- list2env(list(X=1.1, Y=1.2), parent=list2env(list(p=1.3),
parent=baseenv()))
> E2 <- list2env(list(X=1.1, Y=1.2), parent=list2env(list(p=1.4),
parent=baseenv()))
> base::all.equal.environment(E1,E2)
[1] TRUE
> globalenv()$all.equal.environment(E1,E2)
[1] "<parent.env> Component “p”: Mean relative difference: 0.07692308"
>
> E3 <- list2env(list(X=1.1, Y=1.2), parent=list2env(list(p=1.5),
parent=new.env(parent=baseenv())))
> base::all.equal.environment(E1,E3)
[1] TRUE
> globalenv()$all.equal.environment(E1,E3)
[1] "<parent.env> Component “p”: Mean relative difference: 0.1538462"
[2] "<parent.env> <parent.env> target is <environment: base> and current is
<environment: 0x564e806705c8>"
On Tue, Dec 1, 2020 at 1:31 AM Martin Maechler <maechler using stat.math.ethz.ch>
wrote:
> >>>>> Bill Dunlap
> >>>>> on Mon, 30 Nov 2020 13:41:54 -0800 writes:
>
> > To make the comparison more complete, all.equal.environment could
> compare
> > the parents of the target and current environments. That would have
> to be
> > recursive but could stop at the first 'top level environment' (the
> global,
> > empty, or a package-related environment generally) and use identical
> > there. E.g.,
>
> > > f1 <- function(x) (function(){ expx <- exp(x) ; function(y) y +
> expx})()
> > > all.equal(f1(2), f1(3))
> > [1] "Environments: Component “expx”: Mean relative difference:
> 1.718282"
> >
> > [2] "Environments: <parent.env> Component “x”: Mean relative
> difference:
> > 0.5"
>
> > This is from the following, where I avoided putting the existing
> > non-recursive all.equal.environment into the body of this one.
>
> > all.equal.environment <-
> > function(target, current, ...)
> > {
> > .all.equal.environment <- base::all.equal.environment #
> temporary hack
> > stopifnot(is.environment(target), is.environment(current))
> > if (identical(target, current)) {
> > TRUE
> > } else {
> > msg <- NULL # TODO: check attributes
> > # deal with emptyenv now since parent.env(emptyenv()) gives
> error
> > # and topenv(emptyenv()) gives GlobalEnv
> > eTarget <- identical(target, emptyenv()) ||
> > identical(target,topenv(target))
> > eCurrent <- identical(current, emptyenv()) ||
> > identical(current,topenv(current))
> > if (eTarget || eCurrent) {
> > msg <- c(msg, paste("target is", format(target), "and
> current
> > is", format(current)))
> > } else {
> > thisComparison <- .all.equal.environment(target,
> current, ...)
> > if (!isTRUE(thisComparison)) {
> > msg <- c(msg, thisComparison)
> > }
> > parentComparison <- Recall(parent.env(target),
> > parent.env(current), ...)
> > if (!isTRUE(parentComparison)) {
> > msg <- c(msg, paste("<parent.env>",
> parentComparison))
> > }
> > }
> > if (is.null(msg) || isTRUE(msg)) TRUE else msg
> > }
> > }
>
> Thank you, Duncan and Bill (and Kevin for bringing up the
> topic).
>
> I agree all.equal() should work better with functions,
>
> and I think probably it would make sense to define all.equal.function()
> rather than put this into all.equal.default()
>
> However, it's not quite clear if it is always desirable to check the
> environments as well notably as that *is* done recursively.
>
> Bill, I'm sure you've noticed that we did write all.equal.environment()
> to work recursively... Actually, I had worked quite a bit at
> that, too long ago to remember details, but the relevant svn log
> entry is
> ------------------------------------------------------------------------
> r66640 | maechler | 2014-09-18 22:10:20 +0200 (Thu, 18 Sep 2014) | 1 line
>
> more sophisticated all.equal.environment(): no longer "simple" infinite
> recursions
> ------------------------------------------------------------------------
>
> Are you sure that code with the internal recursive do1()
> function should/could not be amended where needed?
>
> Martin
>
> > On Mon, Nov 30, 2020 at 10:42 AM Duncan Murdoch <
> murdoch.duncan using gmail.com>
> > wrote:
> >
> > > On 30/11/2020 1:05 p.m., Kevin Van Horn via R-devel wrote:
> > > > Consider the following code:
> > > >
> > > > f <- function(x)function(y){x+y}
> > > > all.equal(f(5), f(0))
> > > >
> > > > This returns TRUE, when it should return FALSE; I think it’s
> hard to
> > > make the case that f(5) and f(0) are “approximately equal” in any
> > > meaningful sense. Digging into the code for all.equal(), I see that
> > > all.equal(f(5), f(0)) results in a call to
> all.equal.language(f(5), f(0)),
> > > which only compares the function texts for equality.
> > > >
> > > > If it is decided to leave this behavior as-is, then at least it
> should
> > > be documented. Currently I cannot find any documentation for
> all.equal
> > > applied to functions.
> > >
> > > Clearly it should also compare the environments of the two
> functions,
> > > then it would see a difference:
> > >
> > > > all.equal(environment(f(5)), environment(f(0)))
> > > [1] "Component “x”: Mean relative difference: 1"
> > >
> > > Changing the first few lines from
> > >
> > > if (is.language(target) || is.function(target))
> > > return(all.equal.language(target, current, ...))
> > >
> > > to
> > >
> > > if (is.function(target)) {
> > > msg <- all.equal.language(target, current, ...)
> > > if (isTRUE(msg)) {
> > > msg <- all.equal.environment(environment(target),
> > > environment(current), ...)
> > > if (is.character(msg))
> > > msg <- paste("Environments:", msg)
> > > }
> > > return(msg)
> > > }
> > > if (is.language(target))
> > > return(all.equal.language(target, current, ...))
> > >
> > > would fix it.
> > >
> > > Duncan Murdoch
> > >
> > > ______________________________________________
> > > R-devel using r-project.org mailing list
> > > https://stat.ethz.ch/mailman/listinfo/r-devel
>
[[alternative HTML version deleted]]
More information about the R-devel
mailing list