Custom Layout for sortable::bucket_list()

[jordanwebb10]

Good afternoon!

I'm looking to change the layout of the sortable::bucket_list from the first picture to something akin to the second. I'm a bit lost

Current App Layout

Prefered Layout

library(shiny)
library(tidyverse)
library(sortable)

playerPositions <- tibble(
  player = paste0("Player #",rep(1:22)),
  position = rep(c("GK", "LFB", "LCB", "RCB", "RFB", "CM", "LAM", "RAM", "LWAM", "RWAM", "FWD"), 2)
)

#UI ----
ui <- fluidPage(

  titlePanel("Soccer Positions"),

  uiOutput(outputId = 'position.buck.list')
)

#Server -----
server <- function(input, output, session) {


  output$position.buck.list <- renderUI({

     bucket_list(
        header = "Drag the athlete to desired position",
        group_name = "position.chart",
        orientation = "horizontal",
        add_rank_list(
          text = "GK",
          labels = as.list(playerPositions %>% filter(position == 'GK') %>% pull(player)),
          input_id = "GK"
        ),
        add_rank_list(
          text = "LFB",
          labels = as.list(playerPositions %>% filter(position == 'LFB') %>% pull(player)),
          input_id = "LFB"
        ),
        add_rank_list(
          text = "LCB",
          labels = as.list(playerPositions %>% filter(position == 'LCB') %>% pull(player)),
          input_id = "LCB"
        ),
        add_rank_list(
          text = "RCB",
          labels = as.list(playerPositions %>% filter(position == 'RCB') %>% pull(player)),
          input_id = "RCB"
        ),
        add_rank_list(
          text = "CM",
          labels = as.list(playerPositions %>% filter(position == 'CM') %>% pull(player)),
          input_id = "CM"
        ),
        add_rank_list(
          text = "LAM",
          labels = as.list(playerPositions %>% filter(position == 'LAM') %>% pull(player)),
          input_id = "LAM"
        ),
        add_rank_list(
          text = "RAM",
          labels = as.list(playerPositions %>% filter(position == 'RAM') %>% pull(player)),
          input_id = "RAM"
        ),
        add_rank_list(
          text = "LWAM",
          labels = as.list(playerPositions %>% filter(position == 'LAM') %>% pull(player)),
          input_id = "LWAM"
        ),
        add_rank_list(
          text = "RWAM",
          labels = as.list(playerPositions %>% filter(position == 'LAM') %>% pull(player)),
          input_id = "RWAM"
        ),
        add_rank_list(
          text = "FWD",
          labels = as.list(playerPositions %>% filter(position == 'FWD') %>% pull(player)),
          input_id = "FWD"
        )
     )

  })

}

shinyApp(ui = ui, server = server)

[jordanwebb10]

I was able to figure out a solution simply using fluidrow, and column containers. Secondly, I didn't realize that if the group_name argument was the same for different bucket_lists() it would allow the names to be drug from list to list.

Please see a working solution below.

library(shiny)
library(tidyverse)
library(sortable)

athleteData <- tibble(
  athleteName = paste0("Player #",rep(1:22)),
  athletePosition = rep(c("GK", "FB-L", "CB-L", "CB-R", "FB-R", "CM", "AM-L", "AM-R", "WAM-L", "WAM-R", "FWD"), 2)
)

position_bucket_list <- function(athleteData, positionName) {

  bucket_list(
    header = "",
    group_name = "position.chart",
    orientation = "horizontal",
    add_rank_list(
      text = positionName,
      labels = as.list(athleteData %>% filter(athletePosition == positionName) %>% pull(athleteName)),
      input_id = positionName
    )
  )

}

position_layout_4123 <- function(athleteData) {
  fluidPage(
    fluidRow(
      column(width = 1),
      column(width = 2, position_bucket_list(athleteData, 'WAM-L')),
      column(width = 2),
      column(width = 2, position_bucket_list(athleteData, 'FWD')),
      column(width = 2),
      column(width = 2, position_bucket_list(athleteData, 'WAM-R')),
      column(width = 1)
    ),
    fluidRow(
      column(width = 3),
      column(width = 2, position_bucket_list(athleteData, 'AM-L')),
      column(width = 2),
      column(width = 2, position_bucket_list(athleteData, 'AM-R')),
      column(width = 3)
    ),
    fluidRow(
      column(width = 5),
      column(width = 2, position_bucket_list(athleteData, 'CM')),
      column(width = 5)
    ),
    fluidRow(
      column(width = 2, position_bucket_list(athleteData, 'FB-L')),
      column(width = 1),
      column(width = 2, position_bucket_list(athleteData, 'CB-L')),
      column(width = 2),
      column(width = 2, position_bucket_list(athleteData, 'CB-R')),
      column(width = 1),
      column(width = 2, position_bucket_list(athleteData, 'FB-R'))
    ),
    fluidRow(
      column(width = 5),
      column(width = 2, position_bucket_list(athleteData, 'GK')),
      column(width = 5)
    )
  )
}


#UI ----
ui <- fluidPage(

  titlePanel("Soccer Positions"),

  uiOutput(outputId = 'position.buck.list'),

)

#Server -----
server <- function(input, output, session) {

  output$position.buck.list <- renderUI({position_layout_4123(athleteData)})

}

shinyApp(ui = ui, server = server)