R 闪亮 |使用动态 UI 评估用户 textInput
R Shiny | evaluating user textInput with dynamic UI
我想安全地允许我的应用程序用户能够在我闪亮的应用程序中操作数据集 - 通过将代码传递给数据 %>% mutate (input$textInput1)，然后更新包含操作的反应值数据，v$data.
有关于如何使用单个预先命名的输入并对其进行解析的答案，但我无法推断如何为多个文本输入定义它。
例如'input$textinput1','input$textinput2'..
在激活输入字段的情况下按下重新编码按钮会导致错误：
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)
以下代码捕获动态数量的 textInputs 并将它们转换为代码匹配：'Variable name' 'Code call'。这些必须由 rlang 评估单独处理，因为 := 剩下的任何东西都必须是一个符号。函数链将 textInput 转换为可操作的代码。
我已经 尝试 了解为什么会这样（理解 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.
关于此答案的未回答问题：
- 错误可能性。某些输入会产生错误吗？
- 安全问题。可以/应该
rlang::eval_tidy() 换出，例如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)
我想安全地允许我的应用程序用户能够在我闪亮的应用程序中操作数据集 - 通过将代码传递给数据 %>% mutate (input$textInput1)，然后更新包含操作的反应值数据，v$data.
有关于如何使用单个预先命名的输入并对其进行解析的答案，但我无法推断如何为多个文本输入定义它。 例如'input$textinput1','input$textinput2'..
在激活输入字段的情况下按下重新编码按钮会导致错误：
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)
以下代码捕获动态数量的 textInputs 并将它们转换为代码匹配：'Variable name' 'Code call'。这些必须由 rlang 评估单独处理，因为 := 剩下的任何东西都必须是一个符号。函数链将 textInput 转换为可操作的代码。
我已经 尝试 了解为什么会这样（理解 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.
关于此答案的未回答问题：
- 错误可能性。某些输入会产生错误吗？
- 安全问题。可以/应该
rlang::eval_tidy()换出，例如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)