Evaluate call that contains another call (call within call)

后端 未结 5 1678
-上瘾入骨i
-上瘾入骨i 2021-02-19 06:41

I have encountered a snippet of code where call contains another call. For example:

a <- 1
b <- 2
# First call
foo <- quote(a + a)
# Second call (call c         


        
5条回答
  •  栀梦
    栀梦 (楼主)
    2021-02-19 07:36

    To answer this question it might be helpful to split it up in 3 sub problems

    1. Locate any call within a call
    2. For each call, evaluate the call (invisibly), or replace the call with the original call
    3. Return the initial call.

    For the answer to be complete, we need to locate any subsequently nested call within the call. In addition we would need to avoid the endless loop of bar <- quote(bar + 3).

    As any call might have nested called eg:

    a <- 3
    zz <- quote(a + 3)
    foo <- quote(zz^a)
    bar <- quote(foo^zz)
    

    we will have to make sure each stack is evaluated before evaluating the final call.

    Following this line of thought, the following function will evaluate even complicated calls.

    eval_throughout <- function(x, envir = NULL){
      if(!is.call(x))
        stop("X must be a call!")
    
      if(isNullEnvir <- is.null(envir))
        envir <- environment()
      #At the first call decide the environment to evaluate each expression in (standard, global environment)
      #Evaluate each part of the initial call, replace the call with its evaluated value
      # If we encounter a call within the call, evaluate this throughout.
      for(i in seq_along(x)){
        new_xi <- tryCatch(eval(x[[i]], envir = envir),
                           error = function(e)
                             tryCatch(get(x[[i]],envir = envir), 
                                      error = function(e)
                                        eval_throughout(x[[i]], envir)))
        #Test for endless call stacks. (Avoiding primitives, and none call errors)
        if(!is.primitive(new_xi) && is.call(new_xi) && any(grepl(deparse(x[[i]]), new_xi)))
          stop("The call or subpart of the call is nesting itself (eg: x = x + 3). ")
        #Overwrite the old value, either with the evaluated call, 
        if(!is.null(new_xi))
          x[[i]] <- 
            if(is.call(new_xi)){
              eval_throughout(new_xi, envir)
            }else
              new_xi
      }
      #Evaluate the final call
      eval(x)
    }
    

    Showcase

    So lets try a few examples. Initially I'll use the example in the question, with one additional slightly more complicated call.

    a <- 1
    b <- 2
    c <- 3
    foo <- quote(a + a)
    bar <- quote(foo ^ b)
    zz <- quote(bar + c) 
    

    Evaluating each of these gives the desired result:

    >eval_throughout(foo)
    2
    >eval_throughout(bar)
    4
    >eval_throughout(zz)
    7
    

    This is not restricted to simple calls however. Lets extend it to a more interesting call.

    massive_call <- quote({
      set.seed(1)
      a <- 2
      dat <- data.frame(MASS::mvrnorm(n = 200, mu = c(3,7), Sigma = matrix(c(2,4,4,8), ncol = 2), empirical = TRUE))
      names(dat) <- c("A","B")
      fit <- lm(A~B, data = dat)
      diff(coef(fit)) + 3 + foo^bar / (zz^bar)
    })
    

    Suprisingly enough this also works out just fine.

    >eval_throughout(massive_call)
    B
    4
    

    as when we try to evaluate only the segment that is actually necessary, we get the same result:

    >set.seed(1)
    >a <- 2
    >dat <- data.frame(MASS::mvrnorm(n = 200, mu = c(3,7), Sigma = matrix(c(2,4,4,8), ncol = 2), empirical = TRUE))
    >names(dat) <- c("A","B")
    >fit <- lm(A~B, data = dat)
    >diff(coef(fit)) + 3 + eval_throughout(quote(foo^bar / (zz^bar)))
    B
    4
    

    Note that this is likely not the most efficient evaluating scheme. Initially the envir variable should be NULL, unless calls like dat <- x should be evaluated and saved in a specific environment.


    Edit: Summary of currently provided answers and performance overview

    This question have been given quite some attention since the additional reward was given, and many different answers have been proposed. In this section I'll give a short overview of the answers, their limitations and some of their benefits as well. Note all the answers currently provided are good options, but solve the problem to a differing degree, with different upsides and downsides. This section is thus not meant as a negative review for any of the answers, but a trial to leave an overview of the different methods. The examples presented in above in my answer have been adopted by some of the other answers, while a few have been suggested in the comments of this answer which represented different aspects of the problem. I will use the examples in my answer as well as a few below, to try and illustrate the usefulness of the different methods suggested throughout this post. For completion the different examples are shown in code below. Thanks to @Moody_Mudskipper for the additional examples suggested in the comments below!

    #Example 1-4:
    a <- 1
    b <- 2
    c <- 3
    foo <- quote(a + a)
    bar <- quote(foo ^ b)
    zz <- quote(bar + c) 
    massive_call <- quote({
      set.seed(1)
      a <- 2
      dat <- data.frame(MASS::mvrnorm(n = 200, mu = c(3,7), Sigma = matrix(c(2,4,4,8), ncol = 2), empirical = TRUE))
      names(dat) <- c("A","B")
      fit <- lm(A~B, data = dat)
      diff(coef(fit)) + 3 + foo^bar / (zz^bar)
    })
    #Example 5
    baz <- 1
    quz <- quote(if(TRUE) baz else stop())
    #Example 6 (Endless recursion)
    ball <- quote(ball + 3)
    #Example 7 (x undefined)
    zaz <- quote(x > 3)
    

    Solution versatility

    The solutions provided in the answers to the question, solve the problem to various extends. One question might be to which extend these solve the various tasks of evaluating the quoted expressions. To test the versatility of the solutions, example 1 to 5 was evaluated using the raw function provided in each answer. Example 6 & 7 present different kind of problems, and will be treated seperately in a section below (Safety of Implementation). Note the oshka::expand returns an unevaluated expression, which was evaluated for after running the function call. In the table below I've visualized the results from the versatility test. Each row is a seperate function in an answer to the question while each column marks an example. For each test the succes is marked as sucess, ERROR and failed for a succesfuly, early interrupted and failed evaluation respectively. (Codes are availible at the end of the answer for reproducability.)

                function     bar     foo  massive_call     quz      zz
    1:   eval_throughout  succes  succes        succes   ERROR  succes
    2:       evalception  succes  succes         ERROR   ERROR  succes
    3:               fun  succes  succes         ERROR  succes  succes
    4:     oshka::expand  sucess  sucess        sucess  sucess  sucess
    5: replace_with_eval  sucess  sucess         ERROR   ERROR   ERROR
    

    Interestingly the simpler calls bar, foo and zz are mostly handled by all but one answer. Only oshka::expand succesfuly evaluates every method. Only two methods succeed the massive_call and quz examples, while only oshka::expand craetes a succesfuly evaluating expression for the particularly nasty conditional statement. One may however note that by design the any intermediate results are saved using the oshka::expand method, which should be kept in mind while used. This could however be simply fixed by evaluating the expression within function or child-environment to the global environment. Another important note is the 5'th example represents a special problem with most of the answers. As each expression is evaluated individually in 3 out of 5 answers, the call to the stop function, simply breaks the call. Thus any quoted expression containing a call to stop shows a simply and especially devious example.


    Efficiency comparison:

    An alternative performance meassure often of concern is pure efficiency or speed. Even if certain methods failed, being aware of the methods limitations, can yield situations where a simpler method is better, due to the speed performance. To compare the methods we need to assume that it is the case that we know the method is sufficient for our problems. For this reason and in order to compare the different methods a benchmarking test was performed using zz as the standard. This cuts out one method, for which no benchmarking has been performed. The results are shown below.

    Unit: microseconds
                expr      min        lq       mean    median        uq      max neval
     eval_throughout  128.378  141.5935  170.06306  152.9205  190.3010  403.635   100
         evalception   44.177   46.8200   55.83349   49.4635   57.5815  125.735   100
                 fun   75.894   88.5430  110.96032   98.7385  127.0565  260.909   100
        oshka_expand 1638.325 1671.5515 2033.30476 1835.8000 1964.5545 5982.017   100
    

    For the purposes of comparison, the median is a better estimate, as the garbage cleaner might taint certain results and thus the mean. From the output a clear pattern is visible. The more advanced functions takes longer to evaluate. Of the four functions oshka::expand is the slowest competitor, being a factor 12 slower than the closest competitor (1835.8 / 152.9 = 12), while evalception is the fastest being about twice as fast as fun (98.7 / 49.5 = 2) and three times faster than eval_throughout (damn!) As such if speed is required, it seems the simplest method that will evaluate succesfuly is the way to go.


    Safety of implementation An important aspect of good implementations is their ability identify and handle devious input. For this aspect example 6 & 7 represent different problems, that could break implementations. Example 6 represents an endless recursion, which might break the R session. Example 7 represents the missing value problem.

    Example 6 was run under the same condition. The results are shown below.

    eval_throughout(ball) #Stops successfully
    eval(oshka::expand(ball)) #Stops succesfully
    fun(ball) #Stops succesfully
    #Do not run below code! Endless recursion
    evalception(ball)
    

    Of the four answer, only evalception(bar) fails to detect the endless recursion, and crashes the R session, while the remaining succesfuly stops.

    Note: i do not suggest running the latter example.

    Example 7 was run under the same condition. The results are shown below.

    eval_throughout(zaz) #fails
    oshka::expand(zaz) #succesfully evaluates
    fun(zaz) #fails
    evalception(zaz) #fails
    

    An important note is that any evaluation of example 7 will fail. Only oshka::expand succeeds, as it is designed to impute any existing value into the expression using the underlying environment. This especially useful feature lets one create complex calls and imputing any quoted expression to expand the expression, while the remaining answers (including my own) fail by design, as they evaluate the expression.


    Final comments

    So there you go. I hope the summary of the answers proves useful, showing the positives and possible negatives of each implementation. Each have their possible scenarios where they would outperform the remaining, while only one could be successfully used in all of the represented circumstances. For versatility the oshka::expand is the clear winner, while if speed is preferred one would have to evaluate if the answers could be used for the situation at hand. Great speed improvements is achievable by going with the simpler answers, while they represent different risks possibly crashing the R session. Unlike my earlier summary, the reader is left to decide for themselves which implementation would work best for their specific problem.

    Code for reproducing the summary

    Note this code is not cleaned, simply put together for the summary. In addition it does not contain the examples or function, only their evaluations.

    require(data.table)
    require(oshka)
    evals <- function(fun, quotedstuff, output_val, epsilon = sqrt(.Machine$double.eps)){
      fun <- if(fun != "oshka::expand"){
        get(fun, env = globalenv())
      }else
        oshka::expand
      quotedstuff <- get(quotedstuff, env = globalenv())
      output <- tryCatch(ifelse(fun(quotedstuff) - output_val < epsilon, "succes", "failed"), 
                         error = function(e){
                           return("ERROR")
                         })
      output
    }
    call_table <- data.table(CJ(example = c("foo", 
                                            "bar", 
                                            "zz", 
                                            "massive_call",
                                            "quz"),
                                `function` = c("eval_throughout",
                                               "fun",
                                               "evalception",
                                               "replace_with_eval",
                                               "oshka::expand")))
    call_table[, incalls := paste0(`function`,"(",example,")")]
    call_table[, output_val := switch(example, "foo" = 2, "bar" = 4, "zz" = 7, "quz" = 1, "massive_call" = 4), 
               by = .(example, `function`)]
    call_table[, versatility := evals(`function`, example, output_val), 
               by = .(example, `function`)]
    #some calls failed that, try once more
    fun(foo)
    fun(bar) #suces
    fun(zz) #succes
    fun(massive_call) #error
    fun(quz)
    fun(zaz)
    eval(expand(foo)) #success
    eval(expand(bar)) #sucess
    eval(expand(zz)) #sucess
    eval(expand(massive_call)) #succes (but overwrites environment)
    eval(expand(quz))
    replace_with_eval(foo, a) #sucess
    replace_with_eval(bar, foo) #sucess
    replace_with_eval(zz, bar) #error
    evalception(zaz)
    #Overwrite incorrect values.
    call_table[`function` == "fun" & example %in% c("bar", "zz"), versatility := "succes"]
    call_table[`function` == "oshka::expand", versatility := "sucess"]
    call_table[`function` == "replace_with_eval" & example %in% c("bar","foo"), versatility := "sucess"]
    dcast(call_table, `function` ~ example, value.var = "versatility")
    require(microbenchmark)
    microbenchmark(eval_throughout = eval_throughout(zz),
                   evalception = evalception(zz),
                   fun = fun(zz),
                   oshka_expand = eval(oshka::expand(zz)))
    microbenchmark(eval_throughout = eval_throughout(massive_call),
                   oshka_expand = eval(oshka::expand(massive_call)))
    ball <- quote(ball + 3)
    eval_throughout(ball) #Stops successfully
    eval(oshka::expand(ball)) #Stops succesfully
    fun(ball) #Stops succesfully
    #Do not run below code! Endless recursion
    evalception(ball)
    baz <- 1
    quz <- quote(if(TRUE) baz else stop())
    zaz <- quote(x > 3)
    eval_throughout(zaz) #fails
    oshka::expand(zaz) #succesfully evaluates
    fun(zaz) #fails
    evalception(zaz) #fails
    

提交回复
热议问题