sortable包中bucketlist的选择问题

Question

我的数据中有 3 个区，分别是 A、B 和 C。我想从当前区的分区中建立一个新区。例如，我通过 selectInput 选择了 3 个区中的 2 个。然后，我想使用 bucket_list 来选择分区。遗愿清单应显示所选地区的分区。我不想在遗愿清单上看到第三区的分区。我只想查看通过 selectInput 选择的内容。我无法做到这一点。之后，我想根据我在存储桶列表中选择的内容，使用 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),
                                  
                                  hr(),
                                  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,"SUBDISTRICT","Select a SUBDISTRICT Category",choices = unique(x))

闪亮的关闭本身。

Answer 1

也许这会满足你的需要

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),
                       
                       hr(),
                       fluidRow(column(3, verbatimTextOutput("value"))),
                       DTOutput("t1"),
                       selectInput("subdistrict", label = h3("PLEASE SELECT THE SUBDISTRICTS!"), 
                                   choices = unique(data$SUBDISTRICT),
                                   selected = 0,
                                   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)