可排序包中bucketlist的选择问题

问题描述

我的数据中有 3 个区，分别是 A、B 和 C。我想从现有区的分区建立一个新区。例如，我通过 selectInput 选择了 3 个区中的 2 个。然后，我想使用 bucket_list 来选择分区。遗愿清单应显示所选地区的分区。我不想在遗愿清单上看到第三区的分区。我只想查看我通过 selectInput 选择的内容。我无法做到这一点。之后，我想根据我在bucket列表中选择的内容使用DT包创建一些表。我的代码如下。如果您能提供帮助，我会很高兴。

代码如下：

library(shiny)
library(semantic.dashboard)
library(ggplot2)
library(plotly)
library(DT)
library(sortable)
library(gsheet)

data <- gsheet2tbl('https://docs.google.com/spreadsheets/d/1TqFoIQzTYyWKP8N43jcAxAV71TTA7ldfeRcGtpqfarM/edit#gid=201611728')



ui <- dashboardPage(
   dashboardHeader(color = "green",title = "NEW disTRICT",inverted = TRUE,size = "very wide"),dashboardSidebar(
       size = "thin",color = "teal",sidebarMenu(
           menuItem(tabName = "dist","NEW disTRICT ESTABLISHMENT",icon = icon("tree")),menuItem(tabName = "subdist","NEW SUBdisTRICT ESTABLISHMENT",icon = icon("tree"))
           
       )
   ),dashboardBody(
       tabItems(
           selected = 1,tabItem(
               tabName = "dist",fluidRow(
                   fluidPage( textInput("caption","ENTER THE NAME OF THE NEW disTRICT","",width = 500,placeholder = "PLEASE ENTER NEW NAME HERE!"),fluidRow(column(5,verbatimtextoutput("value1"))),hr(),fluidPage(
                                  
                                  
                                  selectInput("select",label = h3("PLEASE SELECT THE disTRICTS!"),choices = (data$disTRICT),selected = 0,multiple= TRUE),fluidRow(column(3,verbatimtextoutput("value")))
                                  
                              ),),if(interactive()) {
                       bucket_list(
                           header = c("NEW disTRICT ESTABLISHMENT"),add_rank_list(
                               text = "PLEASE SELECT SUBdisTRICT HERE!",labels = "x",options = sortable_options(
                                   multiDrag = TRUE),add_rank_list(
                               text = "select the subdistricts of the new district"
                           ),add_rank_list(
                               text = "select the subdistrict of the current district"
                           ),add_rank_list(
                               text = "select the subdistrict of the current district 2"
                           )    
                       )
                   }
                   
               ),)
           )
       ),theme = "cerulean"
   )


server <- shinyServer(function(input,output,session) {
   
   observe({ print(input$select) 
       #output$x <- data$SUBdisTRICT[data$disTRICT == input$select]  
       #output$x <- data %>% filter(disTRICT == input$select) %>% select(SUBdisTRICT) 
       #updateSelectInput(session,"SUBdisTRICT","Select a SUBdisTRICT Category",choices = unique(x))
   })
   
   output$value <- renderText({paste(input$select)
       
       
       
   })
   
   output$value1 <- renderText({ input$caption })
   
   

   })

shinyApp(ui,server)

此外，当我删除这些代码上的 # 时：

observe({ print(input$select) 
       #output$x <- data$SUBdisTRICT[data$disTRICT == input$select]  
       #output$x <- data %>% filter(disTRICT == input$select) %>% select(SUBdisTRICT) 
       #updateSelectInput(session,choices = unique(x))

闪亮的自己关闭。

解决方法

也许这会满足您的需求

library(shiny)
library(semantic.dashboard)
library(ggplot2)
library(plotly)
library(DT)
library(sortable)
library(gsheet)

data <- gsheet2tbl('https://docs.google.com/spreadsheets/d/1TqFoIQzTYyWKP8N43jcAxAV71TTA7ldfeRcGtpqfarM/edit#gid=201611728')

ui <- dashboardPage(
  dashboardHeader(color = "green",title = "NEW DISTRICT",inverted = TRUE,size = "very wide"),dashboardSidebar(
    size = "thin",color = "teal",sidebarMenu(
      menuItem(tabName = "dist","NEW DISTRICT ESTABLISHMENT",icon = icon("tree")),menuItem(tabName = "subdist","NEW SUBDISTRICT ESTABLISHMENT",icon = icon("tree"))
      
    )
  ),dashboardBody(
    tabItems(
      selected = 1,tabItem(
        tabName = "dist",fluidRow(
          fluidPage( textInput("caption","ENTER THE NAME OF THE NEW DISTRICT","",width = 500,placeholder = "PLEASE ENTER NEW NAME HERE!"),fluidRow(column(5,verbatimTextOutput("value1"))),hr(),fluidPage(
                       
                       selectInput("select",label = h3("PLEASE SELECT THE DISTRICTS!"),choices = unique(data$DISTRICT),selected = 0,multiple= TRUE),fluidRow(column(3,verbatimTextOutput("value"))),DTOutput("t1"),selectInput("subdistrict",label = h3("PLEASE SELECT THE SUBDISTRICTS!"),choices = unique(data$SUBDISTRICT),multiple= TRUE)
                       
                     )
          ),uiOutput("mybucket")
        ),)
    )
  ),theme = "cerulean"
)


server <- shinyServer(function(input,output,session) {
  
  dat <- reactive({
    data[data$DISTRICT %in% req(input$select),]
  })
  
  output$mybucket <- renderUI({
    req(dat())
    bucket_list(
      header = c("NEW DISTRICT ESTABLISHMENT"),add_rank_list(
        text = "PLEASE SELECT SUBDISTRICT HERE!",labels = unique(dat()$SUBDISTRICT),options = sortable_options(
          multiDrag = TRUE),),add_rank_list(
        text = "select the subdistricts of the new district"
      ),add_rank_list(
        text = "select the subdistrict of the current district"
      ),add_rank_list(
        text = "select the subdistrict of the current district 2"
      )    
    )
  })
  
  output$t1 <- renderDT(dat())
  
  observeEvent(input$select,{
    updateSelectInput(session,"subdistrict","Select a SUBDISTRICT Category",choices = unique(dat()$SUBDISTRICT))
    
  })
  
  output$value <- renderText({paste(input$select)})
  
  output$value1 <- renderText({ input$caption })
  
  
})

shinyApp(ui,server)