Question

我有一个更新过滤器的应用程序，但似乎无法正常工作我无法修复它。我希望在更改依赖过滤器时更新所有过滤器我认为问题是关于observeEvent 谢谢你的帮助

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)

Answer 1

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

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)

Answer 2

我回答了一个类似的问题，你用这个解决方案评论过（说你有同样的问题）：

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)

在闪亮的应用中更新过滤器

2 个答案: