闪亮的selectInput'Select All'层次结构

问题描述

编辑：添加示例数据。

我想为多个SelectInputs提供一个“全选”选项。因此，如果我选择“所有”国家/地区，则第二个selectInput下拉列表将显示所有区域，并且如果我选择一个特定国家/地区，则可以选择该国家/地区或特定国家/地区的“所有”区域。

为国家/地区选择所有作品，但我不知道如何将其应用于第二地区。

如果可能的话，我希望不使用pickerInPut。

数据：

train_loss = model.evaluate(x_train,y_train,verbose=0)[0]
train_mae = model.evaluate(x_train,verbose=0)[1]
print('training loss (MSE):',train_loss,'\ntraining MAE:',train_mae)

UI：

   Country <-  c('England','Scotland','Wales','Ireland','Spain','England','Spain')
    
    Region  <- c('north','East','South','north','West','South')
    
    Value   <- c(100,150,400,300,100,200,500,600,250,600)
    
    Outcomes <- c('Green','Red','','Amber','Green','Red')
    
    Outputs <- c('Red','Red')
    
    Risk <- c('Green','')
    
    
    Joined_data <- data.frame(Country,Region,Value,Outcomes,Outputs,Risk)

list<- unique(Joined_data$Country)
list2 <- unique(Joined_data$`Region`)

服务器：

ui<- dashboardPage(
  dashboardHeader(title = "Performance"),dashboardSidebar(selectizeInput(inputId = "Country",label = "Country",choices = c('All',list)),(selectizeInput(inputId = "Region",label = "Region",list2)))),dashboardBody( 
    fluidRow(
      Box(valueBoxOutput(outputId = "Total",width = 12),title = "Total"),Box(valueBoxOutput(outputId = "Value",title = "Value"),)
  ),)

解决方法

也许pickerInput可以满足您的需求，如下例所示。

ui = fluidPage(
  titlePanel(title=div(img(src="YBS.png",height = 140,width = 140),"This is a Test")),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({
    req(MegaP1())
    mychoices <- as.character(unique(MegaP1()$celltype))
    pickerInput(inputId = "Cell",label = "Cell Line",choices = mychoices,multiple = TRUE,options = list(`actions-box` = TRUE)
                )
  })
  
  selectedData <- reactive({
    req(MegaP1(),input$Cell)
    data <- subset(MegaP1(),celltype %in% input$Cell)
  })
  
  output$MegaData = renderTable({
    selectedData()
  })
  
}

shinyApp(ui = ui,server = server)

编辑：

要在不使用pickerInput的情况下执行此操作，可以尝试以下操作：

dat <- data.frame(Country,Region,Value,Outcomes,Outputs,Risk)

list<- unique(dat$Country)
list2 <- unique(dat$`Region`)

app <- shinyApp(
  ui = shinyUI(
    pageWithSidebar(
      headerPanel("Simple Test"),sidebarPanel(
        selectInput("cy","Country",choices = c("All",list )),selectInput("rg","Region",list2 ))
      ),mainPanel(
        DTOutput("out")
      )
    )
  ),server = function(input,session) {
    filtered <- reactive({
      rows <- (input$cy == "All" | dat$Country == input$cy) &
        (input$rg == "All" | dat$Region == input$rg)
      dat[rows,drop = FALSE]
    })
    output$out <- renderDT(filtered())
  }
)