我正在寻找一种方法让用户根据多个变量的输入值(例如姓名和年龄)对数据进行子集化,但是一旦在一个输入中做出选择,其他下拉列表应该是被动的并且仅提供对应的选项已经选择的输入。我有它从“名字”到“年龄”的工作,但如果首先选择“年龄”,我也希望它以另一种方式工作。我在下面发布了我的代码。
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”显示为“年龄”选项,但是一旦点击其中一个年龄,我希望选择“名称”下拉列表作出反应并仅显示所选年龄的选项。
任何建议都会非常感激!
答案 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)