Updating UI elements selection in sortable rank list

[GreyMerchant]

Hello!

I am hoping someone can help me with my shiny question/problem below. You will see that we basic have 2 sets. We have a change_radio which when clicked changes the selection made in rb based on a updateSelectInput.

I want to do exactly the same thing but for a rank_list from the sortable package. When you click on change_bucket it should update the selection in the end_bucket. So lets say if clicked it should automatically add ccc to that bucket.

I looked at the documentation for sortable but didn't find a smiliar function like updateSelectInput. Any idea how I would go about doing this?

library(shiny)
library(sortable)

ui <- fluidPage(
  
  
  
  splitLayout(
  radioButtons("rb", "Choose one:",
               choiceNames = list(
                 icon("calendar"),
                 HTML("<p style='color:red;'>Red Text</p>"),
                 "Normal text"
               ),
               choiceValues = list(
                 "icon", "html", "text"
               ),
               selected = "text"
               ),
  textOutput("txt"),
  actionButton("change_radio","Change radio button selection")
),
bucket_list(
  header = "This is a bucket list. You can drag items between the lists.",
  add_rank_list(
    input_id = "start_bucket",
    text = "Drag from here",
    labels = c("a", "bb", "ccc")
  ),
  add_rank_list(
    input_id = "end_bucket",
    text = "to here",
    labels = NULL
  )
),


actionButton("change_bucket", "Change bucket selection")
)


server <- function(input, output, session) {
  output$txt <- renderText({
    paste("You chose", input$rb)
  })
  
  observeEvent(input$change_radio,{
    updateSelectInput(session, "rb", selected = "html")
    
  })
  
  observeEvent(input$change_bucket,{
    # browser()
    # updateSelectizeInput(session,"end_bucket",choices = c("a"), label = c("a"))
    # 
    # 
    # updateSelectInput(session,"end_bucket",choices = c("a"), label = c("a"))
  })
  
}

shinyApp(ui, server)

Shiny applications not supported in static R Markdown documents

^{Created on 2021-10-13 by the reprex package (v2.0.0)}

[nirgrahamuk]

Indeed the sortable package has not implemented convenience functions to update its outputs in place like is typical for many widgets. Still you can get full dynamic control over the state by using traditional methods of wrapping the creation inside of a uiOutput/renderUI.
Here is an example found from the sortable github.

## ---- update-rank-list-app ----------------------------------------------
## Example shiny app that dynamically updates a rank list

library(shiny)
library(sortable)

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("data", label = "Select the data source", choices = c("mtcars", "iris")),
      selectInput("nrow", label = "Number of rows", choices = c("15", "50", "All")),
      uiOutput("sortable")
    ),
    column(
      width = 8,
      h2("Results"),
      tableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  rv <- reactiveValues(data = data.frame())
  
  observeEvent(input$data, {
    rv$data <- get(input$data)
  })
  
  observeEvent(input$sortable, {
    rv$data <- rv$data[input$sortable]
  })
  
  output$sortable <- renderUI({
    rank_list("Drag column names to change order", names(rv$data), "sortable")
  })
  
  output$table <- renderTable({
    if (input$nrow == "All") {
      rv$data
    } else {
      head(rv$data, as.numeric(input$nrow))
    }
  })
}

shinyApp(ui, server)

[GreyMerchant]

I am not sure if I can use a uiOutput call in my specific situation as I am wrapping this into another function with a lot of specifics. I will have to explore. I can't do something like a session$sendCustomMessage potentially?

[GreyMerchant]

I tried the uiOutput but I am running into the classic "type 'closure' is not subsettable" so I am going to have to think of a very different way of doing this. The problem is that this sortable object is buried in a very specific set of triggered screens with js so it is very irregular to begin with...

[ismirsehregal]

Not sure if this is an option for you, but you could switch to library(shinyjqui) and it's orderInput along with updateOrderInput:

library(shiny)
library(shinyjqui)

ui <- fluidPage(
  tags$style(HTML(
    "div.ui-sortable-handle {
        border-radius: 3px;
        display: block;
        padding: 10px 15px;
        background-color: #f8f8f8;
        border: 1px solid #ddd;
        overflow: hidden;
        width: 100%;
    }"
  )),
  fluidRow(
    br(),
    column(3, wellPanel(orderInput('source', 'Source', items = month.abb, as_source = FALSE, connect = 'dest', placeholder = 'Drag items here...', style = "width: 100%;"), style = "background-color: white;")),
    column(3, wellPanel(orderInput('dest', 'Dest', items = NULL, as_source = FALSE, connect = 'source', placeholder = 'Drag items here...', style = "width: 100%;"), style = "background-color: white;"))
  ),
  column(3, fluidRow(actionButton("split", "Split"))
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$split, {
    updateOrderInput(
      session,
      inputId = "source",
      items = month.abb[1:6],
    )
    
    updateOrderInput(
      session,
      inputId = "dest",
      items = month.abb[7:12]
    )
  })
  
}

shinyApp(ui, server)

[ismirsehregal]

For future readers: here a renderUI-based library(sortable) solution was shared:

library(shiny)
library(sortable)

ui <- fluidPage(
  
  
  
  splitLayout(
    radioButtons("rb", "Choose one:",
                 choiceNames = list(
                   icon("calendar"),
                   HTML("<p style='color:red;'>Red Text</p>"),
                   "Normal text"
                 ),
                 choiceValues = list(
                   "icon", "html", "text"
                 ),
                 selected = "text"
    ),
    textOutput("txt"),
    actionButton("change_radio","Change radio button selection")
  ),
  uiOutput("sortable"),
  actionButton("change_bucket", "Change bucket selection")
)


server <- function(input, output, session) {
  output$txt <- renderText({
    paste("You chose", input$rb)
  })
  
  rv <- reactiveValues(
    labels_start = c("a", "bb", "ccc"),
    labels_end = NULL
  )
  
  output$sortable <- renderUI({
    bucket_list(
      header = "This is a bucket list. You can drag items between the lists.",
      add_rank_list(
        input_id = "start_bucket",
        text = "Drag from here",
        labels = rv$labels_start
      ),
      add_rank_list(
        input_id = "end_bucket",
        text = "to here",
        labels = rv$labels_end
      )
    )
    
  })
  
  observeEvent(input$change_radio,{
    updateSelectInput(session, "rb", selected = "html")
    
  })
  
  observeEvent(input$change_bucket,{
    rv$labels_start <- setdiff(input$start_bucket, "ccc")
    rv$labels_end <- c(setdiff(input$end_bucket, "ccc"), "ccc")
  })
  
}

shinyApp(ui, server)

[GreyMerchant]

This is by far the best solution to my problem. It is the cleanest and it will introduce little dependencies. @nirgrahamuk 's solution is good and under most circumstances that is likely what I would have done.