R Glänzend. Wie man Selectinput Auswahlen reaktiv miteinander macht, während ich Daten unterwerfe

Question

Ich suche nach einer Möglichkeit für Benutzer, Daten auf der Basis von eingegebenen Werten mehrerer Variablen, wie Name und Alter, zu unterteilen, aber sobald eine Wahl in einer Eingabe getroffen wurde Andere Dropdown-Listen sollten reaktiv sein und nur Auswahlmöglichkeiten bieten, die der bereits gewählten Eingabe entsprechen. Ich lasse es von "Name" zu "Alter" gehen, aber ich möchte auch, dass es in die andere Richtung geht, wenn "Alter" zuerst gewählt wird. Ich habe meinen Code unten gepostet.

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) 

Zum Beispiel, wenn der Benutzer für den Namen „b“ wählt, nur „20“ und „21“ als „Alter“ Entscheidungen zeigen, aber dann einmal einer jenes Alter angeklickt wird, würde Ich mag die Auswahlmöglichkeiten im Dropdown-Menü "Name", um zu reagieren und nur Optionen mit dem gewählten Alter anzuzeigen.

Alle Vorschläge würden wirklich geschätzt werden!

Answer 1

Ist es das, was Sie wollen (wenn es mir nicht sagen Ich werde versuchen, wie finde ich Ihnen helfen kann):

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

ich diese finnaly haben:

Ich denke, das ist das, was du suchst nach ? Sag mir !

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)