R Shiny。如何在对数据进行子集化时使selectinput选择彼此反应

时间:2017-06-15 14:09:41

标签: r shiny subset dropdown reactive

我正在寻找一种方法让用户根据多个变量的输入值(例如姓名和年龄)对数据进行子集化,但是一旦在一个输入中做出选择,其他下拉列表应该是被动的并且仅提供对应的选项已经选择的输入。我有它从“名字”到“年龄”的工作,但如果首先选择“年龄”,我也希望它以另一种方式工作。我在下面发布了我的代码。

l <- NULL;
l$name <- c('b','e','d','b','b','d','e')
l$age <- c(20,20,21,21,20,22,22)
l <- as.data.frame(l)
l <- as_data_frame(l)
l$name <- as.character(l$name)

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

assign('All Names',unique(sort(l$name)))
assign("All Ages", unique(sort(l$age)))
data1 <- reactive(l[which(l$name %in% if(exists(input$name))
{get(input$name)}else{input$name}),])

output$Box1 =  renderUI(
if(is.null(input$name) || input$name == "All Names"){
selectInput("name", "Choose Name", choices=c(c("All Names"), 
unique(sort(l$name))))
 }else{selectInput("name", "Choose Name", choices=c(input$name,c("All 
Names")))}
)

output$Box2 =  renderUI(
  if(is.null(input$age) || input$age == "All Ages"){
  selectInput("age", "Choose Age", choices=c("All Ages", 
unique(sort(data1()$age))))
  }else{ selectInput("age", "Choose Age", choices=c(input$age, "All Ages"))}
  )
output$table1 <- renderTable(data1())
output$text1 <- renderPrint(input$name)
data2 <- reactive(data1()[which(data1()$age %in% if(exists(input$age))
{get(input$age)}else{input$age}),])
output$table2 <- renderTable(data2())

})

ui <-shinyUI(fluidPage(
uiOutput("Box1"),
uiOutput("Box2")
,tableOutput("table1"),
textOutput("text1"),
tableOutput("table2")
))

shinyApp(ui,server)

例如,当用户选择“b”作为名称时,只有“20”和“21”显示为“年龄”选项,但是一旦点击其中一个年龄,我希望选择“名称”下拉列表作出反应并仅显示所选年龄的选项。

任何建议都会非常感激!

2 个答案:

答案 0 :(得分:1)

这是你想要的(如果没有告诉我,我会试着找到我可以帮助你的方式):

l <- NULL
l$name <- c('b','e','d','b','b','d','e')
l$age <- c(20,20,21,21,20,22,22)
l <- as.data.frame(l)
l$name <- as.character(l$name)
library(shiny)


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



  data1 <- reactive({


    if(input$Box1 == "All" & input$Box2 == "All"){
    l
    }else if (input$Box1 == "All" & input$Box2 != "All"){
  l[which(l$age == input$Box2),]  
    }else if (input$Box1 != "All" & input$Box2 == "All"){
      l[which(l$name == input$Box1),]  
    }else{
      l[which(l$name == input$Box1 & l$age==input$Box2),]
    }
  })


output$table1 <- renderPrint({
  data1()}
  )

})

ui <-shinyUI(fluidPage(
  selectInput("Box1","Choose name :", choices = c('All',unique(l$name))),
  selectInput("Box2","Choose age :", choices = c('All',unique(l$age))),
  verbatimTextOutput("table1")
))

shinyApp(ui,server)

答案 1 :(得分:1)

我已经完成了这个:

我认为这就是你要找的东西?告诉我!

l <- NULL
l$name <- c('b','e','d','b','b','d','e')
l$age <- c(20,20,21,21,20,22,22)
l <- as.data.frame(l)
l$name <- as.character(l$name)
l$age <- as.numeric(l$age)
library(shiny)

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

  data1 <- reactive({
    if(input$Box1 == "All"){
      l
    }else{
      l[which(l$name == input$Box1),]
    }
  })

  data2 <- reactive({
    if (input$Box2 == "All"){
      l
    }else{
      l[which(l$age == input$Box2),]
    }
  })

  observe({

    if(input$Box1 != "All"){
      updateSelectInput(session,"Box2","Choose an age", choices = c("All",unique(data1()$age)))
    }

    else if(input$Box2 != 'All'){
      updateSelectInput(session,"Box1","Choose a name", choices = c('All',unique(data2()$name)))
    }

    else if (input$Box1 == "All" & input$Box2 == "All"){
      updateSelectInput(session,"Box2","Choose an age", choices = c('All',unique(l$age)))
      updateSelectInput(session,"Box1","Choose a name", choices = c('All',unique(l$name)))
    }
  })


  data3 <- reactive({
    if(input$Box2 == "All"){
      data1()
    }else if (input$Box1 == "All"){
      data2()
    }else if (input$Box2 == "All" & input$Box1 == "All"){
      l
    }
    else{
      l[which(l$age== input$Box2 & l$name == input$Box1),]
    }
  })

  output$table1 <- renderTable({
    data3()
  })


})



ui <-shinyUI(fluidPage(
  selectInput("Box1","Choose a name", choices = c("All",unique(l$name))),
  selectInput("Box2","Choose an age", choices = c("All",unique(l$age))),
  tableOutput("table1")
))

shinyApp(ui,server)