For loop over add_rank_list within dynamic bucket_list

[JoergBauer]

I'm working on an interface for the output of a route optimization algorithm. The algorithm takes customers that need to be delivered on the next day, clusters them into a desired quantity of tours and optimizes the order within each tour. The result then gets stored in a reactive as a list with each element of the list being one tour.

To enable the user to reorder the customers within a tour or change the assignment to tours I included Drag & Drop. Therefore I created a bucket list as a dynamic UI element wherein the labels of the rank lists represent the assigned customers to the tours. The problem is that beside the labels also the quantity of rank lists needs to be dynamic, but implementing a for loop over add_rank_list within the bucket_list doesn't work (error: is_add_rank_list(x = dot) is not TRUE).

Below are simplistic examples to make the issue more tangible. I would be very grateful if you could help me to figure out how I can achieve what I'm looking for.

App with dynamic labels but static quantity of lists (working):

library(shiny)
library(sortable)

ui <- fluidPage(
  numericInput("quant", label = "Desired quantity of tours", 
               value = 2, min = 2, max = 5, step = 1),
  uiOutput("DnD"),
  verbatimTextOutput("customised_tours")
)

server <- function(input, output){
  Tours = reactive({
    df = data.frame(x = 1:20)
    output = split(df, rep(1:input$quant, length.out = nrow(df), each = ceiling(nrow(df)/input$quant))) 
    return(output)
  })
  output$DnD = renderUI({
    bucket_list(
      header = "Change assignment to tours or order within tours",
      group_name = "bucket_list",
      orientation = "horizontal",
      add_rank_list(
        text = "Tour1",
        labels = as.list(Tours()[[1]][,"x"]),
        input_id = "rank_list_tour1"
      ),
      add_rank_list(
        text = "Tour2",
        labels = as.list(Tours()[[2]][,"x"]),
        input_id = "rank_list_tour2"
      )
    )
  })
  output$customised_tours = renderPrint({
    input$bucket_list 
  })
}
shinyApp(ui = ui, server = server)

App with dynamic labels and dynamic quantity of lists (needed but not working):

library(shiny)
library(sortable)

ui <- fluidPage(
  numericInput("quant", label = "Desired quantity of tours", 
               value = 2, min = 2, max = 5, step = 1),
  uiOutput("DnD"),
  verbatimTextOutput("customised_tours")
)

server <- function(input, output){
  Tours = reactive({
    df = data.frame(x = 1:20)
    output = split(df, rep(1:input$quant, length.out = nrow(df), each = ceiling(nrow(df)/input$quant))) 
    return(output)
  })
  output$DnD = renderUI({
    bucket_list(
      header = "Change assignment to tours or order within tours",
      group_name = "bucket_list",
      orientation = "horizontal",
      for(i in 1:length(Tours())){
        add_rank_list(
          text = paste("Tour", i, sep = ""),
          labels = as.list(Tours()[[i]][,"x"]),
          input_id = paste("rank_list_tour", i, sep = "")
        )
      }
    )
  })
  output$customised_tours = renderPrint({
    input$bucket_list 
  })
}
shinyApp(ui = ui, server = server)

[andrie]

Thanks for reporting a good reprex.

I think your use case is not something we considered when designing the interface. So, try as I may, I couldn't get your example to work using the current sortable code base.

However, I think it's a comparatively simple fix, and I have been able to get this to work locally. Before I commit this, let me discuss this with one of my developer colleagues.

[andrie]

We have made a small change in the dev branch that allows you to use !!! from rlang to achieve your aim.

Here is the essential piece you have to change in your example. Firstly, create a list of add_rank_list() elements:

  rank_list_tour <- function(i) {
    add_rank_list(
      text = paste("Tour", i, sep = ""),
      labels = as.list(tours()[[i]][,"x"]),
      input_id = paste("rank_list_tour", i, sep = "")
    )
  }

  n_tour <- reactive({
    length(tours())
  })

  list_of_ranklists <- reactive({
    lapply(1:n_tour(), rank_list_tour)
  })

And then, inside the bucket_list(), use !!!list_of_ranklists to unquote splice 👍

  output$DnD = renderUI({
    bucket_list(
      header = "Change assignment to tours or order within tours",
      group_name = "bucket_list",
      orientation = "horizontal",
      !!!list_of_ranklists()
    )
  })

---

Here is the full working example (make sure you use the dev branch`):

library(shiny)
library(sortable)

ui <- fluidPage(
  numericInput("quant", label = "Desired quantity of tours", 
               value = 2, min = 2, max = 5, step = 1),
  uiOutput("DnD"),
  verbatimTextOutput("customised_tours")
)

server <- function(input, output){
  tours = reactive({
    df = data.frame(x = 1:20)
    split(df, rep(1:input$quant, length.out = nrow(df), each = ceiling(nrow(df)/input$quant)))
  })

  rank_list_tour <- function(i) {
    add_rank_list(
      text = paste("Tour", i, sep = ""),
      labels = as.list(tours()[[i]][,"x"]),
      input_id = paste("rank_list_tour", i, sep = "")
    )
  }

  n_tour <- reactive({
    length(tours())
  })

  list_of_ranklists <- reactive({
    lapply(1:n_tour(), rank_list_tour)
  })

  output$DnD = renderUI({
    bucket_list(
      header = "Change assignment to tours or order within tours",
      group_name = "bucket_list",
      orientation = "horizontal",
      !!!list_of_ranklists()
    )
  })
  output$customised_tours = renderPrint({
    input$bucket_list 
  })
}

shinyApp(ui = ui, server = server)

[JoergBauer]

Thank you for your quick reply, everything works perfectly now. I really appreciate your help!

[jmallon]

I previously installed the dev version and have it working great locally. I now need to install this fix on my server - @andrie has the dev branch been merged?

[jmallon]

I previously installed the dev version and have it working great locally. I now need to install this fix on my server - @andrie has the dev branch been merged?

(ignore this - I realize now you were referring to the sortable package, not rlang)