一个下拉菜单的 R shiny updateSelectInput 选择与另一个选择（即一个是另一个的子类别）

Question

我有 table 数据 MegaP2 器官类型，分为肺和皮肤，然后是各种细胞类型，所有这些细胞都来自肺或皮肤。我已尝试使 Cell Lines 下拉框中的可用选项仅反映来自 selected Organ 的选项第一个下拉框。

如果我 select 皮肤或肺它完美地给出了相关的细胞系，但是如果我尝试 select 其他器官类型然后进一步将细胞系限制为仅在两个器官中的细胞系，而不是为新器官提供所有细胞系 selection。它还会阻止我单击细胞系下拉菜单进行更改。

我想我需要一些方法让器官类型在制作新的 selection 时刷新，但我们将不胜感激任何帮助。

我已经创建了选择列表：

Cell_type = c("All", as.character(levels(MegaP2$Cell_line)))
Organ_type = as.character(levels(MegaP2$Organ))

Lung_cells = filter(MegaP2, Organ == "Lung")
#Then to remove the levels that have been filtered out
Lung_cells = droplevels(Lung_cells)
Lung_lines = c("All", as.character(levels(Lung_cells$Cell_line)))
Skin_cells = filter(MegaP2, Organ == "Skin")
Skin_cells = droplevels(Skin_cells)
Skin_lines = c("All", as.character(levels(Skin_cells$Cell_line)))

我的（相关）ui 代码如下所示：

ui = fluidPage(
  titlePanel(title=div(img(src="cell_image.png", height = 140, width = 400), "The Senescent Cell")),
  sidebarLayout(
    sidebarPanel(
      selectInput("OrganT",
                  label = "Organ",
                  choices = Organ_type,
                  multiple = T,
                  selected = "All"),
      selectInput("Cell",
                  label = "Cell Line",
                  choices = Cell_type,
                  multiple = T,
                  selected = "All")
      
    ),
  mainPanel(
    tableOutput("MegaData")
  )
  )
)

而我的服务器代码如下：我已将所有会话更新留在 Select 中，以防出现问题，理想情况下我希望它也能与这些更新一起使用。

server = function(input, output, session) {
  selectedData <- reactive({
    req(input$OrganT)
    req(input$Cell)
    MegaP2 %>% 
      dplyr::filter(Cell_line %in% input$Cell & Organ %in% input$OrganT)
  })
  output$MegaData = renderTable({
    data = selectedData()
  })
  observe({    
    if("Lung" %in% input$OrganT & !"Skin" %in% input$OrganT)
      choices2 = Cell_type[which(Cell_type %in% Lung_lines)]
    else if("Skin" %in% input$OrganT & !"Lung" %in% input$OrganT)
      choices2 = Cell_type[which(Cell_type %in% Skin_lines)]
    else
      choices2 = Cell_type
    updateSelectInput(session, "Cell", choices = choices2, selected = choices2)
                                    
    if("All" %in% input$Cell)
      selected_choices6 = choices2[-1]
    else
      selected_choices6 = input$Cell
    updateSelectInput(session, "Cell", selected = selected_choices6)
  })
}

Answer 1

我认为你应该直接使用数据 table 来 select 选择。也许你可以试试这个

ui = fluidPage(
  titlePanel(title=div(img(src="cell_image.png", height = 140, width = 400), "The Senescent Cell")),
  sidebarLayout(
    sidebarPanel( 
      uiOutput("organt"),
      uiOutput("cellt")
    ),
    mainPanel(
      tableOutput("MegaData")
    )
  )
)


server = function(input, output, session) {
  
  df1 <- veteran
  MegaP <- df1 %>% mutate(Organ=ifelse(trt==1,"Lung","Skin"))
  
  output$organt <- renderUI({
    selectInput("OrganT",
                label = "Organ",
                choices = unique(MegaP$Organ),
                multiple = T,
                selected = "All")
  })
  
  MegaP1 <- reactive({
    data <- subset(MegaP, Organ %in% req(input$OrganT))
  })
  
  output$cellt <- renderUI({
    selectInput("Cell",
                label = "Cell Line",
                choices = unique(MegaP1()$celltype),
                multiple = T,
                selected = "All")
  })
  
  selectedData <- reactive({
    req(MegaP1(),input$Cell)
    data <- subset(MegaP1(), celltype %in% input$Cell)
  })

  output$MegaData = renderTable({
    selectedData()
  })

}

shinyApp(ui = ui, server = server)

一个下拉菜单的 R shiny updateSelectInput 选择与另一个选择（即一个是另一个的子类别）

R shiny updateSelectInput choices for one dropdown menu with choices from another (ie one is a subcategory of the other)

r

shiny

shiny-server