在闪亮的应用程序中更新滤镜 [英] Updating filters in shiny app

问题描述

我有一个更新筛选器的应用程序，但似乎不能正常工作，我无法修复它。我想让所有过滤器在我更改依赖过滤时更新 我想问题出在观察事件上。 感谢您的帮助

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)

推荐答案

您在我的帖子上发表了评论，说您遇到了与我相同的问题。它看起来有点不同，但我找到了问题的解决方案，所以我发布了下面的代码，以防它对您有所帮助。

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)

这篇关于在闪亮的应用程序中更新滤镜的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！