86

在一个闪亮的应用程序(由 RStudio 提供)中,在服务器端,我有一个反应式,它通过解析 a 的内容返回一个变量列表textInput。然后在selectInput和/或中使用变量列表updateSelectInput

我不能让它工作。有什么建议么?

我做了两次尝试。第一种方法是outVar直接使用反应式进入selectInput. 第二种方法是outVarupdateSelectInput. 两者都不起作用。

服务器.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)
    })

})

用户界面

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

不久前,我在shiny-discuss 上发布了同样的问题,但它引起的兴趣不大,所以我再次道歉,https: //groups.google.com/forum/#!topic/shiny-讨论/e0MgmMskfWo

编辑 1

@Ramnath 好心地发布了一个似乎有效的解决方案,由他表示为Edit 2 。但是该解决方案并不能解决问题,因为它textinput是在ui侧面而不是在server侧面,就像在我的问题中那样。如果我将textinputRamnath 的第二次编辑移到server一边,问题再次出现,即:没有显示和 RStudio 崩溃。我发现包裹input$text会使as.character问题消失。

编辑 2

在进一步的讨论中,Ramnath 向我展示了当服务器尝试outVar在其参数返回之前应用动态函数时出现问题textinput。解决方法是先检查是否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 的努力、耐心和指导。

4

3 回答 3

97

您需要renderUI在服务器端使用动态 UI。这是一个最小的例子。请注意,第二个下拉菜单是反应式的,会根据您在第一个下拉菜单中选择的数据集进行调整。如果您之前处理过闪亮的代码,那么代码应该是不言自明的。

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

编辑。另一种解决方案使用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:使用parse. 在此应用程序中,输入的文本公式用于使用变量列表动态填充下面的下拉菜单。

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())
    })
  }
))
于 2014-01-30T21:06:40.440 回答
4

据我所知,问题在于即使函数被赋予 a作为值,input$inBody也不会检索 a ,即. 因此,解决方案是包装在characterselectInputcharactervalue = "a+b+c"input$inBodyas.character

以下作品:

observe方法updateSelectInput:_

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

reactive方法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())
})

编辑:我已经根据 Ramnath 的反馈对我的问题进行了解释。Ramnath 已经解释了这个问题并提供了一个更好的解决方案,我将其作为我的问题的编辑。我会保留这个答案作为记录。

于 2014-01-31T22:50:39.700 回答
3

服务器.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 ##

用户界面

uiOutput("carControls"),
  br(),
  textOutput("selectedText")
于 2015-09-10T18:28:20.227 回答