I want to safely allow my app users to be able to manipulate the dataset in my shiny app - by passing code to a data %>% mutate (input$textInput1), and then updating a reactive value containing the manipulated data, v$data.
There are answers for how to use a single, pre-named input and parse it, but I can't extrapolate to how to define this for several text inputs. e.g. 'input$textinput1','input$textinput2'..
Pressing the recode button with an activated input field causes the error:
Warning: Error in : Problem with `mutate()` input `..1`. x <text>:1:1: unexpected '[[' 1: [[ ^ ℹ Input `..1` is `eval.secure(parse(text = paste0("[[input$recode_call", >i, "]]")))`. 94: <Anonymous>
library(ggplot2)
library(shiny)
library(DT)
library(dplyr)
library(plotly)
library(colourpicker)
library(RAppArmor)
server <- shinyServer(function(input, output, session){
#Tracks user changes to input
v <- reactiveValues(data=NULL, print_execute_complete=NULL)
#For development, mtcars
myData <- reactive({
return(mtcars)
})
#Count the number of recoding terms to render
counter <- reactiveValues(n = 0)
observeEvent(input$add_recode, {counter$n <- counter$n + 1})
observeEvent(input$rm_recode, {
if(counter$n > 0) counter$n <- counter$n - 1
})
#Recoding button functionality
recoding_i <- reactive({
n <- counter$n
if(n>0){
isolate({
lapply(seq_len(n),function(i){
fluidRow(
column(width=4,
textInput(inputId = paste0('recode_call',i),
label=paste0('Recode_',i)))
)
}
)
})
}
})
#Render the dynamic UI
output$recoding <- renderUI({ recoding_i() })
#Observes press of recode button.
observeEvent(input$'execute_recode',{
v[["print_execute_complete"]] <- TRUE
})
#Observes press of reset button.
observeEvent(input$'reset_recode',{
v[["print_execute_complete"]] <- FALSE
})
#Loop over recoding input boxes.
observeEvent(v$print_execute_complete, {
if(v[["print_execute_complete"]] == TRUE){
if(counter$n==0|is.null(counter$n)){
return(myData())
} else {
lapply(seq_len(counter$n), function(i){
if(is.null((v[["data"]]))){
v$data <- myData() %>% mutate(eval.secure(parse(text=paste0('[[input$recode_call',i,']]'))))
} else {
v$data <- v[["data"]] %>% mutate(eval.secure(parse(text=paste0('[[input$recode_call',i,']]'))))
}
}
)
}
}
})
#Confirmation text
output$execute_complete <- renderText({
req(v[["print_execute_complete"]])
if(v[["print_execute_complete"]] == TRUE){
"Recoding Complete."
}
})
#Render recoded data table
output$recoded_dt <- DT::renderDataTable({
req(v[["print_execute_complete"]] == TRUE)
if(!is.null(v[["data"]])){
return(DT::datatable(v[["data"]], filter='top'))
} else {
return(iris)#DT::datatable(myData(),filter='top'))
}
})
}
)
ui <- shinyUI(fluidPage(
titlePanel("Something is Wrong"),
# Input: Select a file ----
navlistPanel(
tabPanel("Recoding",
h3("Instruction"),
fluidRow(p("Write a functional call in one of the action boxes below. A call takes the form of one of the following :"
,style="font-family: 'times'; font-si16pt")
),
fluidRow(actionButton('add_recode', 'Add recode term'),
actionButton('rm_recode', 'Remove recode term')),
br(),
br(),
uiOutput('recoding'),
br(),
br(),
fluidRow(actionButton('execute_recode', "Recode",icon = icon('angle-double-right')),
actionButton('reset_recode', "Reset", icon=icon('angle-double-right'))),
textOutput('execute_complete'),
br(),
br(),
br(),
DT::dataTableOutput('recoded_dt')
)
)
)
)
shinyApp(ui, server)
The following code captures a dynamic number of textInputs and converts them to code matching: 'Variable name' 'Code call'. These must be handled separately by rlang evaluation since anything left of := must be a symbol. The chain of functions transform a textInput to actionable code.
I have tried to understand why this works (edits welcome by those who understand rlang/tidyeval!):
For each of the additional textInput boxes created, a counter allows an anonymous function to loop over and create and paste together valid input name, e.g. input$recode_call1. This is then evaluated as text, parsed into an expression, where it is evaluated and interpreted, and then turned into an expression.
Unanswered questions about this answer:
rlang::eval_tidy() be swapped out for, e.g. unix::eval.safe()?library(ggplot2)
library(shiny)
library(DT)
library(dplyr)
library(plotly)
library(colourpicker)
library(RAppArmor)
server <- shinyServer(function(input, output, session){
#Tracks user changes to input
v <- reactiveValues(data=NULL, print_execute_complete=NULL)
#For development, mtcars
myData <- reactive({
return(mtcars)
})
#Count the number of recoding terms to render
counter <- reactiveValues(n = 0)
observeEvent(input$add_recode, {counter$n <- counter$n + 1})
observeEvent(input$rm_recode, {
if(counter$n > 0) counter$n <- counter$n - 1
})
#Recoding button functionality
recoding_i <- reactive({
n <- counter$n
if(n>0){
isolate({
lapply(seq_len(n),function(i){
fluidRow(
column(width=4,
textInput(inputId = paste0('recode_call',i),
label=paste0('Recode_',i)))
)
}
)
})
}
})
#Render the dynamic UI
output$recoding <- renderUI({ recoding_i() })
#Observes press of recode button.
observeEvent(input$'execute_recode',{
v[["print_execute_complete"]] <- TRUE
})
#Observes press of reset button.
observeEvent(input$'reset_recode',{
v[["print_execute_complete"]] <- FALSE
})
#Loop over recoding input boxes.
observeEvent(v$print_execute_complete, {
if(v[["print_execute_complete"]] == TRUE){
n <- counter$n
if(counter$n==0){
v$data <- myData()
} else {
v$data <- myData()
lapply(seq_len(n), function(i){
recode_call_i <- rlang::parse_expr(rlang::eval_tidy(rlang::parse_expr(eval(paste0("input$recode_call",i)))))
var_name_i <- rlang::sym(rlang::eval_tidy(rlang::parse_expr(paste0("input$recode_name",i))))
v$data <- mutate(v$data,!!var_name_i := !!recode_call_i)
}
)
}
}
}
)
#Confirmation text
output$execute_complete <- renderText({
req(v[["print_execute_complete"]])
if(v[["print_execute_complete"]] == TRUE){
"Recoding Complete."
}
})
#Render recoded data table
output$recoded_dt <- DT::renderDataTable({
req(v[["print_execute_complete"]] == TRUE)
if(!is.null(v[["data"]])){
return(DT::datatable(v[["data"]], filter='top'))
} else {
return(iris)#DT::datatable(myData(),filter='top'))
}
})
}
)
ui <- shinyUI(fluidPage(
titlePanel("This time it works"),
# Input: Select a file ----
navlistPanel(
tabPanel("Recoding",
h3("Instruction"),
fluidRow(p("Write a functional call in one of the action boxes below. A call takes the form of one of the following :"
,style="font-family: 'times'; font-si16pt")
),
fluidRow(actionButton('add_recode', 'Add recode term'),
actionButton('rm_recode', 'Remove recode term')),
br(),
br(),
uiOutput('recoding'),
br(),
br(),
fluidRow(actionButton('execute_recode', "Recode",icon = icon('angle-double-right')),
actionButton('reset_recode', "Reset", icon=icon('angle-double-right'))),
textOutput('execute_complete'),
br(),
br(),
br(),
DT::dataTableOutput('recoded_dt')
)
)
)
)
shinyApp(ui, server)