将函数形式从代码作为字符串应用/映射到新函数体中

我想获取用户的代码并进行转换reactive()调用这样的函数。

a <- reactive({
  input$n * 100
})

并将其转换为

a <- function() {
  input$n *100
}

这是我的一部分闪亮的物体包裹。我已经整理了一个解决方案，但我不知道这是否是正确的方法。任何帮助/反馈/资源将不胜感激。我不知道是否rlang or lobstr可能有帮助。

code <- 
  "library(shiny)

  input <- list(cty = 15)
  
  df <- reactive({
    x <- input$cty
    mpg %>% filter(cty < x)
  })
  
  n_obs <- reactive(head(df()))"



all_expr <- parse(text = code)

reactive_to_function <- function(x) {
  if (grepl("reactive\\(", as.character(x))) {
    code_as_call <- as.call(x)[[1]] 
    get_symbol <- code_as_call[[2]] 
    get_formals <- code_as_call[[3]][[2]]
    new_exp <-
      as.expression(
        bquote(
          .(get_symbol) <- function() .(get_formals)
        )
      )
    
    final_code <- new_exp
  } else {
    final_code <- x
  }
  
  final_code
}

单独工作

reactive_to_function(all_expr[3])
#> expression(df <- function() {
#>     x <- input$cty
#>     mpg %>% filter(cty < x)
#> })

reactive_to_function(all_expr[4])
#> expression(n_obs <- function() nrow(df()))

并有一个循环

exp_list <- expression()

for (i in seq_along(all_expr)) {
  exp_list <- 
    append(
      exp_list, 
      as.list(convert_assignments(all_expr[i])),
      after = i - 1
    )
}

exp_list

但无法让 apply/map 功能正常工作

lapply(all_expr, reactive_to_function)
#> Warning in if (grepl("reactive\\(", as.character(x))) {: the condition has
#> length > 1 and only the first element will be used
#> [[1]]
#> library(shiny)
#> 
#> [[2]]
#> input <- list(cty = 15)
#> 
#> [[3]]
#> df <- reactive({
#>     x <- input$cty
#>     mpg %>% filter(cty < x)
#> })
#> 
#> [[4]]
#> n_obs <- reactive(nrow(df()))

这是受到启发的数据表的方式来替换它的.() alias.

code <- 
    "library(shiny)

  input <- list(cty = 15)
  
  df <- reactive({
    x <- input$cty
    mpg %>% filter(cty < x)
  })
  
  n_obs <- reactive(head(df()))"

all_expr <- parse(text = code)

f_recurse_look = function(e) {
    if (is.call(e)) {
        if (e[[1L]] == "reactive")
            e = as.function(as.list(e)[-1L])
        else
            for (i in seq_along(e)[-1L]) if (!is.null(e[[i]])) e[[i]] = f_recurse_look(e[[i]])    
    }
    e
}

lapply(all_expr, f_recurse_look)
#> [[1]]
#> library(shiny)
#> 
#> [[2]]
#> input <- list(cty = 15)
#> 
#> [[3]]
#> df <- function () 
#> {
#>     x <- input$cty
#>     mpg %>% filter(cty < x)
#> }
#> 
#> [[4]]
#> n_obs <- function () 
#> head(df())

这种方法将递归地查找表达式调用，直到找到reactive。请注意，这意味着如果reactive如果在单个表达式中进行多次调用，则需要修改此解决方案。