在R Shiny中,使用由先前选择填充的SelectInput中的值

时间:2015-07-09 20:32:53

标签: r shiny

我有一个非常简单的Shiny应用程序。

我想选择一个ID和一个日期,然后得到结果。

数据很简单 DF_custs <- data.frame(ID=c(1,2,3,3), Date=c('1/1/2010', '1/1/2011', '1/1/2012', '1/1/2013'), result=c(100, 200, 300, 400))

UI已设置,目前看起来像这样:

enter image description here

说,我选择ID号3.然后,填充选择日期菜单。接下来我选择一个日期。到现在为止还挺好。

我的问题是,我需要实现什么样的对象才能显示正确的结果,这取决于我刚刚选择的日期?目前,这个功能已经缺失,无论如何,应用程序都会打破这两个结果。

在寻求解决这个问题时,我不确定SelectInput是否会有多大用处。我看到与SelectInput一起使用的renderUI执行它应该执行的操作,即在UI中呈现下拉列表。如何将SelectInput 返回中的值发送到服务器?

我可以尝试对output$result进行某种修改,例如

  output$result <- renderText({ 
    ans <- get_cust()$result
    ans <- ans[which(ans$Date==output$dates), Date]
    paste("Result: ", ans)})

但现在我在某些Dr悖论中,如果ans已经存在,则ans无法存在。

对我来说,在最终结果出现之前需要执行一系列操作时,使用Shiny中的反应性会感到不舒服。这不可避免地意味着需要在不同时间评估事物。当事情一下子发射并且所有被动的东西快乐地一起执行时,闪亮是容易的。但即使在这样的简单玩具环境中,我也意识到我需要在工具箱中使用其他工具。非常感谢任何帮助。

app.R

DF_custs <- data.frame(ID=c(1,2,3,3), Date=c('1/1/2010', '1/1/2011', '1/1/2012', '1/1/2013'), result=c(100, 200, 300, 400))
DF_custs$Date <- as.character(DF_custs$Date)

## app.R ##
server <- function(input, output, session) {

  get_cust <- reactive({
    cust <- DF_custs[which(DF_custs$ID == input$ID), ]
    return(cust)})

  output$result <- renderText({ 
    ans <- get_cust()$result
    paste("Result: ", ans)})


  output$dates<-renderUI({
    selectInput('dates', 'Select date:', choices=get_cust()$Date, selected=get_cust()$Date)})
}

ui <- fluidPage(
      numericInput(inputId="ID", label="Pick an ID: ", value=1),
      uiOutput("dates"),

      mainPanel(textOutput("result"))

)

shinyApp(ui = ui, server = server)

PS感谢@Victorp的帮助here

2 个答案:

答案 0 :(得分:1)

我再一次,只是这样做:

output$result <- renderText({ 
   ans <- get_cust()$result
   ans <- ans[DF_custs$Date[which(DF_custs$ID == input$ID)] == input$dates]
   paste("Result: ", ans)
})

你可以做一些更有效的事情但是它会起作用,如果你想检查input$dates是否已定义,你可以添加if!is.null(input$dates)来阻止代码执行。

答案 1 :(得分:1)

以下是使用服务器中的observeEventreactive以及{i}中日期selectInput的简单解决方案:

DF_custs <- data.frame(ID=c(1,2,3,3),
           Date=c('1/1/2010', '1/1/2011',
                  '1/1/2012', '1/1/2013'),         
           result=c(100, 200, 300, 400))
DF_custs$Date <- as.character(DF_custs$Date)

server <- function(input, output, session) {

  result <- reactive({paste("Result: ", input$ID, " @ ", input$Date) })
  output$result <- renderText({ result()})
  observeEvent(input$ID, {updateSelectInput(session, "Date", 
               choices=DF_custs[input$ID == DF_custs$ID, "Date"])}) 

}

ui <- fluidPage(
  numericInput(inputId="ID", label="Pick an ID: ", value=1,
               min=1, max=3, step=1),
  selectInput(inputId="Date",label="Pick a date",
               choices=c("Choose") , selectize = FALSE ),
  mainPanel(textOutput("result"))

)

shinyApp(ui = ui, server = server)

希望这有帮助!还有更多示例@ RStudio