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

问题

I have a table of data MegaP2 with Organ type, separated into Lung and Skin, and then various cell types all of which come from either lung or skin. I have tried to make the available choices in the Cell Lines dropdown box reflect only those that come from the selected Organ in the first dropdown box.

If I select Skin or Lung it gives the relevant cell lines perfectly, but then if I try to select the other organ type it then further restricts the cell lines to only those in both organs rather than giving all the cell lines for the new organ selection. It also prevents me from clicking into the cell line dropdown menu to make changes there.

I assume I need some way of getting the organ type to refresh when a new selection is made, but any help would be greatly appreciated.

I have created lists of choices as so:

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)))

My (relevant) ui code looks like this:

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")
  )
  )
)

And my server code is as follows: I have left in the Select All session updates in case that is causing the problem, as ideally I would like it to work with these also in place.

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)
  })
}

回答1:

I think you should directly use the data table to select the choices. Perhaps you can try this

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)

来源：https://stackoverflow.com/questions/64574600/r-shiny-updateselectinput-choices-for-one-dropdown-menu-with-choices-from-anothe

标签

Shiny

shiny-server