R 闪亮传递反应到 selectInput 选项

在 服务器这边的一个闪亮的应用程序(由 RStudio 开发)中，我有一个反应器，它通过解析 textInput的内容来返回一个变量列表。然后在 selectInput和/或 updateSelectInput中使用变量列表。

我做不到，有什么建议吗？

我已经试过两次了。第一种方法是使用反应性 outVar直接进入 selectInput。第二种方法是在 updateSelectInput中使用反应性 outVar。都不管用。

服务器 R

shinyServer(
function(input, output, session) {


outVar <- reactive({
vars <- all.vars(parse(text=input$inBody))
vars <- as.list(vars)
return(vars)
})


output$inBody <- renderUI({
textInput(inputId = "inBody", label = h4("Enter a function:"), value = "a+b+c")
})


output$inVar <- renderUI({  ## works but the choices are non-reactive
selectInput(inputId = "inVar", label = h4("Select variables:"), choices =  list("a","b"))
})


observe({  ## doesn't work
choices <- outVar()
updateSelectInput(session = session, inputId = "inVar", choices = choices)
})


})

Ui.R

shinyUI(
basicPage(
uiOutput("inBody"),
uiOutput("inVar")
)
)

不久前，我发布了同样的问题在闪亮的讨论，但它没有引起多少兴趣，所以我再次问，抱歉，https://groups.google.com/forum/#!topic/shiny-discuss/e0MgmMskfWo

编辑1

@ Ramnath 友好地贴出了一个看起来可行的解决方案，由他表示为 编辑2。但是这个解决方案并没有解决问题，因为 textinput是在 ui而不是在 server一边，因为它是在我的问题。如果我将 Ramnath 第二次编辑的 textinput移动到 server端，问题又出现了，即: 没有显示任何内容，RStudio 崩溃。我发现在 as.character中包装 input$text可以使问题消失。

编辑2

在进一步的讨论中，Ramnath 向我展示了当服务器在其参数被 textinput返回之前试图应用动态函数 outVar时出现的问题。解决方案是首先检查 is.null(input$inBody)是否存在。

检查是否存在参数是构建一个闪亮的应用程序 的关键方面，那么为什么我没有想到这一点呢？是的，但我肯定做错了什么！考虑到我花在这个问题上的时间，这是一个痛苦的经历。我在代码之后展示了如何检查存在。

下面是 Ramnath 的代码，将 textinput移动到 server端。它会让 RStudio 崩溃，所以不要在家里尝试。(我用过他的记号)

library(shiny)
runApp(list(
ui = bootstrapPage(
uiOutput('textbox'),  ## moving Ramnath's textinput to the server side
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))  ## existence check needed here to prevent a crash
vars <- as.list(vars)
return(vars)
})


output$textbox = renderUI({
textInput("text", "Enter Formula", "a=b+c")
})


output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))

我通常检查是否存在的方法是这样的:

if (is.null(input$text) || is.na(input$text)){
return()
} else {
vars <- all.vars(parse(text = input$text))
return(vars)
}

Ramnath 的代码更短:

if (!is.null(mytext)){
mytext = input$text
vars <- all.vars(parse(text = mytext))
return(vars)
}

这两种方法似乎都有效，但是从现在开始，我将按照 Ramnath 的方法来做: 也许我的构造中的一个不平衡的括号早些时候阻止了我使检查起作用？Ramnath 的支票更直接。

最后，我想指出一些关于我的各种调试尝试的事情。

在调试过程中，我发现服务器端有一个“排序”“输出”优先级的选项，我曾试图解决这个问题，但由于问题在其他地方，所以没有成功。尽管如此，了解这一点还是很有趣的，而且目前似乎还不太为人所知:

outputOptions(output, "textbox", priority = 1)
outputOptions(output, "variables", priority = 2)

在这个任务中，我也 尽力了 try:

try(vars <- all.vars(parse(text = input$text)))

很接近了，但还是没修好。

我偶然发现的第一个解决方案是:

vars <- all.vars(parse(text = as.character(input$text)))

我想知道它为什么会起作用会很有趣: 是因为它使事情变得足够慢吗？是因为 as.character“等待”input$text是非空的吗？

不管是什么情况，我都非常感谢 Ramnath 的努力、耐心和指导。

87276 次浏览
小开
最佳答案

You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.

runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns = renderUI({
mydata = get(input$dataset)
selectInput('columns2', 'Columns', names(mydata))
})
}
))

EDIT. Another Solution using updateSelectInput

runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
selectInput('columns', 'Columns', "")
),
server = function(input, output, session){
outVar = reactive({
mydata = get(input$dataset)
names(mydata)
})
observe({
updateSelectInput(session, "columns",
choices = outVar()
)})
}
))

EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.

library(shiny)
runApp(list(
ui = bootstrapPage(
textInput("text", "Enter Formula", "a=b+c"),
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))
vars <- as.list(vars)
return(vars)
})


output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
小开

As far as I can tell, the problem is that input$inBody does not retrieve a character even though the selectInput function is given a character as value, namely value = "a+b+c". The solution is therefore to wrap input$inBody in a as.character

The following works:

The observe approach with updateSelectInput:

observe({
input$inBody
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
updateSelectInput(session = session, inputId = "inVar", choices = vars)
})

The reactive approach with selectInput:

outVar <- reactive({
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
return(vars)
})


output$inVar2 <- renderUI({
selectInput(inputId = "inVar2", label = h4("Select:"), choices =  outVar())
})

Edit: I have edited my question with an explanation based on Ramnath's feedback. Ramnath has explained the problem and provided a better solution, which I give as an edit of my question. I'll keep this answer for the record.

小开

server.R

### This will create the dynamic dropdown list ###


output$carControls <- renderUI({
selectInput("cars", "Choose cars", rownames(mtcars))
})




## End dynamic drop down list ###


## Display selected results ##


txt <- reactive({ input$cars })
output$selectedText <- renderText({  paste("you selected: ", txt() ,sep="") })




## End Display selected results ##

ui.R

uiOutput("carControls"),
br(),
textOutput("selectedText")

提交答案