R闪亮。如何使选择输入选项在对数据进行子集化时互为响应

Question

我正在寻找一种方法让用户根据多个变量的输入值（例如名称和年龄）来子集数据，但是一旦在一个输入中进行了选择，其他下拉菜单应该是被动的，只能提供与已经选择的输入相对应的选项。我从“名字”到“年龄”工作，但如果首先选择“年龄”，我也希望它以另一种方式工作。我已经在下面发布了我的代码。

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”为“21”显示为“时代”选择的名字，只有“20”和，但后来曾经的那些时期之一被点击，我想“名称”下拉列表中的选项会作出反应，并仅显示选定年龄段的选项。

任何建议将非常感激！

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

Answer 2

我有finnaly这样的：

我觉得这是什么你在找什么？告诉我 ！

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)