Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

(Pre)supply variables to function factory and within

Tags:

r

I'm reading through Hadley's Advanced R and trying some stuff out. I'm trying to create a lazy closure function that returns a function with the supplied data.frame in its environment as well as using with and being able to supply additional function arguments later.

lazy <- function(dataframe, x) {
    function(FUN, x, ...) {
        with(dataframe, FUN(x = x, ...))
    }
}

lz_factory <- lazy(mtcars, "mpg")

lz_factory(mean)
lz_factory(cor, y="hp")

So I was expecting that the dataframe is part of the function environment which it is (a browser look see confirms). However, the variable name x is not supply and I can't supply a new variable y when I use cor as the first FUN argument. This has to do with supplying character to a function (with) that uses non-standard evaluation (NSE). I want Uncle Hadley to be proud of me but my rummaging with eval, parse, substitute all returned errors. That means I don't fully get how R is handling things. I know why it doesn't work (NSE) but not how to make it work. Here's the errors:

> lz_factory(mean)
Error in FUN(x = x, ...) : argument "x" is missing, with no default

> lz_factory(cor, y="hp")
Error in is.data.frame(x) : argument "x" is missing, with no default

I thought I could tackle it using substitute as Hadley shows HERE with xyplot but that was a flop too as seen here:

lazy <- function(dataframe, default) {
    function(FUN, x, ...) {
        if (missing(x)) x <- default
        eval(substitute(with(dataframe, FUN(x, ...))))
    }
}

lz_factory <- lazy(mtcars, "mpg")

lz_factory(mean)
lz_factory(cor, y="hp")


> lz_factory(mean)
[1] NA
Warning message:
In mean.default("mpg") : argument is not numeric or logical: returning NA

> lz_factory(cor, y="hp")
Error in cor("mpg", y = "hp") : 'x' must be numeric

So how can I make this lazy function work so it:

  1. Produces its own function with the dataframe enclosed in the environment
  2. Allows me to supply x if I want and if not uses the default originally supplied
  3. Allows me to pass unknown variables to function created by lz_factory

Optimally I'd like to make this function work with with. If that's not possible it's be nice to know why. And lastly if not possible to use with how can I make the function operational?

like image 955
Tyler Rinker Avatar asked Dec 26 '22 07:12

Tyler Rinker


2 Answers

How about this function

lazy <- function(dataframe, ...) {
    pdots <- substitute(list(...))
    if(is.null(names(pdots)) || names(pdots)[1]=="") {
        names(pdots)[2]<-"x"
    }
    function(FUN, ...) {
        dots <- substitute(list(...))[-1]
        if (is.null(dots$x)) {
            dots$x <- pdots$x
        }
        with(dataframe, do.call(FUN, as.list(dots)))
    }
}

This allows you to use the names of the variables in mtcars without quotes. For example

lz_factory <- lazy(mtcars, mpg)
lz_factory(mean)
# [1] 20.09062
lz_factory(mean, x=hp)
# [1] 146.6875
lz_factory(cor, y=hp)
# [1] -0.7761684

Here we use an extra bit of substituting to make sure we get lazy evaluation and to allow you to use the variable names without quotes. The with will take care of evaluating the expressions. I'm guessing there may be a way to simplify this, but at least it seems to work.

like image 178
MrFlick Avatar answered Jan 12 '23 09:01

MrFlick


Here's a slightly simplified version of @MrFlick's function:

lazy <- function(df, x_var = NULL) {
  x <- substitute(x_var)

  function(FUN, ...) {
    call <- substitute(FUN(...))
    if (is.null(call$x) && !is.null(x)) {
      call$x <- x
    }
    eval(call, df, parent.frame())
  }
}

The key is taking greater advantage of the capabilities of substitute(), and avoiding with() by using eval directly.

like image 34
hadley Avatar answered Jan 12 '23 09:01

hadley