Selection problem of bucketlist in sortable package - r

Question

There are 3 districts which are A, B, and C in my data. I would like to establish a new district from the subdistricts of the current districts. For example, I select 2 of 3 districts via selectInput. And then, I would like to use bucket_list for selecting the subdistricts. The bucket list should show the subdistricts of selected districts. I do not want to see subdistricts of 3rd districts on a bucket list. I want to see only what I selected via selectInput. I could not manage this. After that, I want to create some tables using the DT package based on what I selected in the bucket list. My codes are below. I would be happy if you could help.
Here’s code:
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)
Also, when I remove # on these codes:
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))
The shiny close itself.

Answer 1

Perhaps this will meet your needs
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)