过滤dataframe的两个属性时同步两个selectinput（多选）

Question

在我的 shinydashboard 应用程序中，我想为用户提供按替代属性过滤数据框的选项。我的数据框在 1:1 关系中有一个“ID”列和一个“名称”列。使用两个 selectizeInputs，用户可以通过一个或另一个来过滤天气。

我现在想要实现的是在选择其中一个项目时更新另一个 selectizeInput。所以两个 selectizeInputs 都显示数据框的相应项目。我设法解决了这个问题，只要我将选择限制为单个项目，而不是多项选择。

以下最小代码是目前为止我能得到的最接近的代码，但它不允许多项选择。显然是由于一种死锁情况，即第一个选择的项目导致另一个 seletizeInput 过滤相同的元素，自动将第一个 selectizeInput 再次更新为这个单个项目。

library(shiny)
library(shinydashboard)
library(tidyverse)

ui <- dashboardPage(
  dashboardHeader(title = 'Test alternative select') ,
  
  dashboardSidebar(
    sidebar <- dashboardSidebar(
      sidebarMenu(
              selectizeInput(inputId = 'id' ,
                             label = 'ID' ,
                             choices = NULL ,
                             selected = NULL ,
                             multiple = TRUE ,
                             options = list(plugins = list('remove_button'))) ,
              selectizeInput(inputId = 'name' ,
                             label = 'Name' ,
                             choices = NULL ,
                             selected = NULL ,
                             multiple = TRUE ,
                             options = list(plugins = list('remove_button')))
        ))) ,
  
  dashboardBody()
)
  
  server <- function(input, output , session) {
    
    data <- tribble(
      ~ID , ~Name ,
      '1' , 'France' ,
      '2' , 'Italy' ,
      '3' , 'Germany' ,
      '4' , 'Spain' ,
      '5' , 'Portugal'
    )
    
    observe({
      if (is.null(input$id)) {
        updateSelectizeInput(session = session ,
                             inputId = 'name' ,
                             choices = data$Name ,
                             options = list(plugins= list('remove_button')))
      } else {
        choices <- data %>%
          filter(ID %in% input$id) %>%
          pull(Name)
        
        updateSelectizeInput(session = session ,
                             inputId = 'name' ,
                             choices = choices ,
                             selected = choices ,
                             options = list(plugins= list('remove_button')))
      }
    })
    
    observe({
      if (is.null(input$name)) {
        updateSelectizeInput(session = session ,
                             inputId = 'id' ,
                             choices = data$ID ,
                             options = list(plugins= list('remove_button')))
      } else {
        choices <- data %>%
          filter(Name %in% input$name) %>%
          pull(ID)
        
        updateSelectizeInput(session = session ,
                             inputId = 'id' ,
                             choices = choices ,
                             selected = choices ,
                             options = list(plugins= list('remove_button')))
      }
    })
  }
  
  shinyApp(ui, server)

我不确定这是否可以通过这种方式解决，但如果“是”，我可能不得不以某种方式使用“隔离”。但是我想不通。

Answer 1

经过一些尝试和错误后，我找到了一个解决方案，对我的代码进行了以下更改。基本上我使用 observeEvent 而不是 observe.

我用 freezeReactiveValue() 尝试了 kenshuri 的提示（感谢），但它没有帮助，甚至变得更糟。

下面的解决方案确实是我想要实现的。唯一剩下的问题：当删除一个框中的所有项目时，最后一个保留在另一个框中。但我可以接受。

library(shiny)
library(shinydashboard)
library(tidyverse)


ui <- dashboardPage(
  dashboardHeader(title = 'Test alternative select') ,
  
  dashboardSidebar(
    sidebar <- dashboardSidebar(
      sidebarMenu(
        selectizeInput(inputId = 'id' ,
                       label = 'ID' ,
                       choices = NULL ,
                       selected = NULL ,
                       multiple = TRUE ,
                       options = list(plugins = list('remove_button'))) ,
        selectizeInput(inputId = 'name' ,
                       label = 'Name' ,
                       choices = NULL ,
                       selected = NULL ,
                       multiple = TRUE ,
                       options = list(plugins = list('remove_button')))
      ))) ,
  
  dashboardBody()
)

server <- function(input, output , session) {
  data <- tribble(
    ~ID , ~Name ,
    '1' , 'France' ,
    '2' , 'Italy' ,
    '3' , 'Germany' ,
    '4' , 'Spain' ,
    '5' , 'Portugal'
  )
  
  observe({
    if (is.null(input$id) & is.null(input$name)) {
      updateSelectizeInput(session , 'name' , choices = data$Name , selected = NULL)
      
      updateSelectizeInput(session , 'id' , choices = data$ID , selected = NULL)
    }
  })
  
  observeEvent(input$id, {
      sel <- data %>% filter(ID %in% input$id) %>% pull('Name')
      updateSelectizeInput(session , 'name' , selected = isolate(sel))
  })
  
  observeEvent(input$name, {
      sel <- data %>% filter(Name %in% input$name) %>% pull('ID')
      updateSelectizeInput(session , 'id' , selected =isolate(sel))
  })

}

shinyApp(ui, server)

Answer 2

也许您正在寻找这个

server <- function(input, output , session) {
  data <- tribble(
    ~ID , ~Name ,
    '1' , 'France' ,
    '2' , 'Italy' ,
    '3' , 'Germany' ,
    '4' , 'Spain' ,
    '5' , 'Portugal'
  )
  
  observeEvent(input$id, {
    if (is.null(input$id)) {
      updateSelectizeInput(session , 'name' , choices = data$Name , selected = NULL)
    } else{
      sel <- data %>% filter(ID %in% input$id) %>% pull('Name')
      updateSelectizeInput(session , 'name' , selected = isolate(sel))
    }
    print(input$id)
  }, ignoreNULL = FALSE)
  
  observeEvent(input$name, {
    if (is.null(input$name)) {
      updateSelectizeInput(session , 'id' , choices = data$ID , selected = NULL)
    } else {
      sel <- data %>% filter(Name %in% input$name) %>% pull('ID')
      updateSelectizeInput(session , 'id' , selected =isolate(sel))
    }
    
  }, ignoreNULL = FALSE)
  
}

过滤dataframe的两个属性时同步两个selectinput（多选）

Synchronise two selectizeInputs when filtering two attributes of a data frame (mulitple selection)

r

shiny

shinydashboard