一个下拉菜单的R闪亮updateSelectInput选项与另一个下拉菜单的选择即一个是另一个的子类别

问题描述

我有一个数据表MegaP2，其中包含器官类型，分为肺和皮肤，然后各种细胞类型都来自任一肺或皮肤。我试图使单元格行下拉框中的可用选项仅反映来自第一个下拉框中所选的 Organ 的选项。

如果我选择皮肤或肺，它会完美显示相关的细胞系，但是如果我尝试选择其他器官类型，则会进一步限制细胞系只选择两个器官中的那些，而不是为所有新的器官选择提供所有细胞系。这也阻止了我单击单元格下拉菜单进行更改。

我认为我需要某种方式来使器官类型在进行新选择时刷新，但是任何帮助将不胜感激。

我已经这样创建了选择列表：

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,selected = "All")
      
    ),mainPanel(
    tableOutput("MegaData")
  )
  )
)

我的服务器代码如下： 我已经留在“全选”会话更新中，以防引起问题，因为理想情况下，我希望它也可以使用这些更新。

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,selected = selected_choices6)
  })
}

解决方法

我认为您应该直接使用数据表来选择选项。也许你可以尝试一下

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),selected = "All")
  })
  
  selectedData <- reactive({
    req(MegaP1(),input$Cell)
    data <- subset(MegaP1(),celltype %in% input$Cell)
  })

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

}

shinyApp(ui = ui,server = server)