curve3d can't find local function "fn"

Question

I'm trying to use the curve3d function in the emdbook-package to create a contour plot of a function defined locally inside another function as shown in the following minimal example:

library(emdbook)
testcurve3d <- function(a) {
  fn <- function(x,y) {
    x*y*a
  }
  curve3d(fn(x,y))
}

Unexpectedly, this generates the error

> testcurve3d(2)
 Error in fn(x, y) : could not find function "fn" 

whereas the same idea works fine with the more basic curve function of the base-package:

testcurve <- function(a) {
  fn <- function(x) {
    x*a
  }
  curve(a*x)
}
testcurve(2)

The question is how curve3d can be rewritten such that it behaves as expected.

Analcite

Oddly, it "works" if fn <- function(x,y) is replaced by fn <<- function(x,y), showing that the problem is the environment in which curve3d is evaluating the expression. – Lichee

Yes, thanks, this is my temporary and not so nice fix for the problem at the moment. – Analcite

I'm sure @BenBolker will have a better solution though – Analcite

I think I don't, actually, other than digging in to the evaluation environment and seeing if there's a better way to do this. Sorry ... I could write an answer explaining the problem, but at the moment I don't have an obvious solution. – Seamanlike

Answer 1

You can temporarily attach the function environment to the search path to get it to work:

testcurve3d <- function(a) {
  fn <- function(x,y) {
    x*y*a
  }
  e <- environment()
  attach(e)
  curve3d(fn(x,y))
  detach(e)
}

Analysis

The problem comes from this line in curve3d:

eval(expr, envir = env, enclos = parent.frame(2))

At this point, we appear to be 10 frames deep, and fn is defined in parent.frame(8). So you can edit the line in curve3d to use that, but I'm not sure how robust this is. Perhaps parent.frame(sys.nframe()-2) might be more robust, but as ?sys.parent warns there can be some strange things going on:

Strictly, sys.parent and parent.frame refer to the context of the parent interpreted function. So internal functions (which may or may not set contexts and so may or may not appear on the call stack) may not be counted, and S3 methods can also do surprising things.

Beware of the effect of lazy evaluation: these two functions look at the call stack at the time they are evaluated, not at the time they are called. Passing calls to them as function arguments is unlikely to be a good idea.

Forevermore

Answer 2

The eval - parse solution bypasses some worries about variable scope. This passes the value of both the variable and function directly as opposed to passing the variable or function names.

library(emdbook)

testcurve3d <- function(a) {
  fn <- eval(parse(text = paste0(
    "function(x, y) {",
    "x*y*", a,
    "}"
  )))

  eval(parse(text = paste0(
    "curve3d(", deparse(fn)[3], ")"
    )))
}

testcurve3d(2)

Jannelle

This works because you pass to curve3d the deparse and that it returns x*y*a. The parse of fn is not necessary, and if you use a more complex function it does not work. – Exuviae

@JuanAntonioRoldánDíaz - Can back up your claim that this would not work with a complex function by providing an example? – Jannelle

@BenBolker That's the eval-parse solution for ya! – Jannelle

Any function with more than one line of code, try this: fn <- eval(parse(text = paste0("function(x, y) {w <- ", a, "; x*w*y}"))) – Exuviae

Use escape characters with a newline. fn <- eval(parse(text = paste0("function(x, y) {\n w <- ", a, "\n x * w * y \n}"))) - SE did not display correctly – Jannelle

The * sign was not picked up the first time.. try it again. – Jannelle

Let us continue this discussion in chat. – Exuviae

Answer 3

I have found other solution that I do not like very much, but maybe it will help you.

You can create the function fn how a call object and eval this in curve3d:

fn <- quote((function(x, y) {x*y*a})(x, y))
eval(call("curve3d", fn))

Inside of the other function, the continuous problem exists, a must be in the global environment, but it is can fix with substitute.

Example:

testcurve3d <- function(a) {
  fn <- substitute((function(x, y) {
                      c <- cos(a*pi*x)
                      s <- sin(a*pi*y/3)
                      return(c + s)
                      })(x, y), list(a = a))
  eval(call("curve3d", fn, zlab = "fn"))
}

par(mfrow = c(1, 2))
testcurve3d(2)
testcurve3d(5)

Rah