Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
272 views
in Technique[技术] by (71.8m points)

r - Updating filters in shiny app

I have an app with updating filters but seems not to work correctly I can't fix it. I want all filters updating when I change a depending filter I think the problem is about observeEvent Thanks for help

library(shiny)
library(DT)
library(dplyr)

VG <- c("A", "A", "B", "B", "B", "C", "A")
AG <- c(1, 2, 1, 3, 4, 2, 1)
AP <- letters[1:7]
AK <- paste(VG, AG, AP, sep = "-")
data <- data.frame(VG, AG, AP, AK)

ui <- fluidPage(
  column(3,
         selectInput("VG", label = h4("VG.ETD"),choices = unique(data$VG)),
         selectInput("AG", label = h4("AG.ETD"),choices = unique(data$AG))),
  column(3,
         selectInput("AP", label = h4("AP.ETD"),choices = unique(data$AP)),
         selectInput("AK", label = h4("AK.ETD"),choices = unique(data$AK)),
         actionButton("go", "GO")),
  column(6,DT::dataTableOutput("dtt"))
)

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

  observeEvent(input$VG,{
    updateSelectInput(session, 'AG', choices = unique(data$AG[data$VG %in% input$VG]))
  })

  observeEvent(input$AG,{
    updateSelectInput(session, 'AP', choices = unique(data$AP[data$AG %in% input$AG &
                                                                data$VG %in% input$VG]))
  })

  observeEvent(input$AP,{
    updateSelectInput(session, 'AK', choices = unique(data$AK[data$AP %in% input$AP &
                                                                data$AG %in% input$AG &
                                                                data$VG %in% input$VG]))
  })

  df <- eventReactive(input$go, {
    data %>% filter(VG %in% input$VG, 
                    AG %in% input$AG,
                    AP %in% input$AP,
                    AK %in% input$AK)

  })

  output$dtt <- DT::renderDataTable({
    df()

  })

}

shinyApp(ui=ui,server=server)
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

You posted a comment on my post saying that you were having the same problem as me. It looks a little bit different, but I found a solution to my problem so I've posted the code below in case it helps you at all.

l <- NULL
l$name <- c('b','e','d','b','b','d','e','e','b','b')
l$age <- c(20,20,21,21,20,22,22,30,21,32)
l$gender <- c('Female', 'Female', 'Male', 'Female', 'Male','Male', 
'Female','Male',"Female","Male")
l <- as.data.frame(l)
l$name <- as.character(l$name)
l$age <- as.numeric(l$age)
l$gender <- as.character(l$gender)


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

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

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())
data3 <- reactive(data2()[which(data2()$gender %in% if(exists(input$gender))
{get(input$gender)}else{input$gender}),])

output$table3 <- renderTable(data3())


output$Box1 =  renderUI(
if((is.null(input$age)) & (is.null(input$gender))){
  selectInput("name", "Choose Name", choices=c("All Names",unique(sort(l$name))), selected = input$name)
} else{selectInput("name", "Choose Name", choices=c("All Names",unique(l[l$gender %in% (if(exists(input$gender)){get(input$gender)}else{input$gender}) & l$age %in% (if(exists(input$age)){get(input$age)}else{input$age}) , "name"])), selected = input$name)
}
)



output$Box2 =  renderUI(
if((is.null(input$name)) & (is.null(input$gender))){
  selectInput("age", "Choose Age", choices=c("All Ages", unique(sort(l$age))), selected = input$age)
}else{selectInput("age", "Choose Age", choices=c("All Ages",unique(l[l$gender %in% (if(exists(input$gender)){get(input$gender)}else{input$gender}) & l$name %in% (if(exists(input$name)){get(input$name)}else{input$name}) , "age"])), selected = input$age)}
)

output$Box3 =  renderUI(
  if((is.null(input$name)) & (is.null(input$age))){
    selectInput("gender", "Choose Gender", choices=c("All Genders", unique(sort(l$gender))), selected = input$gender)
  }else{

    selectInput("gender", "Choose Gender", choices=c("All Genders", unique(l[l$name %in% (if(exists(input$name)){get(input$name)}else{input$name}) & l$age %in% (if(exists(input$age)){get(input$age)}else{input$age}), "gender"])), selected = input$gender, multiple = TRUE)
  }
)



})

ui <-shinyUI(fluidPage(
uiOutput("Box1"),
uiOutput("Box2"),
uiOutput("Box3"),
tableOutput("table3")
))

shinyApp(ui,server)

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...