R - 闪亮的条件输入

时间:2017-08-02 12:45:15

标签: r shiny

我正在尝试根据先前的输入获得输入选择。

require(shiny)
require(dplyr)

dat <- data.frame(id1 = c(rep("A",5),rep("B",5)),
         id2 = c(rep("C",3),rep("D",3),rep("E",4)),
         id3 = c(rep("F",2),rep("G",3),rep("H",5)), stringsAsFactors=FALSE)


ui <- shinyUI(fluidPage(
    sidebarPanel(
    selectInput('id1', 'ID1', choices = unique(dat$id1)),
    selectInput("id2", "ID2", choices = unique(dat$id2)),
    selectInput("id3", "ID3", choices = unique(dat$id3))
    )
  )
)


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

observeEvent(
            { 
            input$id1 
            },{
            input$id2
            temp <- dat %>% filter(id1%in%input$id1)
            updateSelectInput(session,"id2",choices = unique(temp$id2))
            }
        )
}

shinyApp(ui = ui, server = server)

这适用于输入1和2,但是如果我向observeEvent添加另一个输入,则应用程序会崩溃。 E.g:

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

observeEvent(
                { 
                input$id1 
                },{
                input$id2
                temp <- dat %>% filter(id1%in%input$id1)
                updateSelectInput(session,"id2",choices = unique(temp$id2))
                },{
                input$id3
                temp <- dat %>% filter(id1%in%input$id1 & id2%in%input$id2)
                updateSelectInput(session,"id3",choices = unique(temp$id3))
                }
    )
}

如何将更多输入传递给observeEvent

1 个答案:

答案 0 :(得分:1)

更新:我找到了解决问题的方法。我将输入包装在reactive函数中,拆分输出并将其传递给相应的observeEvent函数。

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


change <- reactive({
    unlist(strsplit(paste(c(input$id1,input$id2,input$id3),collapse="|"),"|",fixed=TRUE))

    })

observeEvent(input$id1,{  
                    temp <- dat %>% filter(id1 %in% change()[1])
                    updateSelectInput(session,"id2",choices = unique(temp$id2))
                    }
                )

observeEvent(input$id2,{  
                    temp <- dat %>% filter(id1 %in% change()[1] & id2 %in% change()[2])
                    updateSelectInput(session,"id3",choices = unique(temp$id3))
                    }
                )           
    }