Apply/map R function formals into new function body from code as string

user_4650934 0
Viewed 113

I want to take a user's code and convert reactive() calls into functions like this.

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

and converts it to

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

This is part of my shinyobjects package. I have put together a solution but I do not know if it is the right approach. Any help/feedback/resources would be appreciated. I couldn't figure out if rlang or lobstr might help.

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
}

works individually

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()))

and with a loop

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

but can't get apply/map functions to work

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()))
r
1 Answers

This is inspired by data.table's way of replacing its .() 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())

This approach will recursively look through the expression calls until it finds reactive. Note, this means that if reactive is in multiple calls in a single expression, this solution would need modified.

user_113550660
Related