How to create a grid layout when the panels are generated in HTML?

Viewed 99

The below reproducible code works as it should, except I'm having a difficult time laying out its Shiny output in a grid pattern. I've been fooling with fluidPage(fluidRow(column...))), dashboard(...), with no luck. I keep getting what is shown in the first image at the bottom or worse. Whether I use R Studio browser or Edge browser, I keep getting 3 vertically stacked panels per that first image below when running this code.

I think the problem is the panels are generated in HTML. I've tried fooling with HTML/CSS too to move the panels around, and it's been a mess.

How would one tweak this code to get the layout shown in the 2nd image at the bottom? The panels can be of fixed width, they don't need to be fluid if that matters.

Reproducible code:

library(shiny)
library(htmlwidgets)
library(sortable)
library(magrittr)

icon_list <- function(x){lapply(x,function(x) {tags$div(tags$strong(x))})}

ui <- fluidPage(
 
  fluidRow(
      class = "panel-body",
      column(
        4,
        class = "panel panel-default",
        tags$div(class = "panel-heading","Drag from here:"),
        tags$div(
          class = "panel-body",
          id = "sort1",
          icon_list(c("A","B","C","D","E"))
          )
      ),
      column(
        4,
        class = "panel panel-default",
        tags$div(class = "panel-heading","To here:"),
        tags$div(
          class = "panel-body",
          id = "sort2"
          )
      ),
      column(
        4,
        class = "panel panel-default",
        tags$div(class = "panel-heading","Drag here to delete:"),
        tags$div(
          class = "panel-body",
          id = "sortable_bin"
          )
      )
  ),
  sortable_js(
    "sort1",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "sortGroup1",
        put = FALSE)
    )
  ),
  sortable_js(
    "sort2",
    options = sortable_options(
      group = list(
        group = "sortGroup1",
        put = TRUE,
        pull = TRUE)
    )
  ),
  sortable_js(
    "sortable_bin",
    options = sortable_options(
      group = list(
        group = "sortGroup1",
        put = TRUE,
        pull = TRUE),
      onAdd = htmlwidgets::JS("function (evt) { this.el.removeChild(evt.item); }")
    )
  )
)

server <- function(input, output) {}

shinyApp(ui, server)

enter image description here

enter image description here

Addendum 1:

I tried the first solution offered, it still doesn't work. Then I tried converting all fluidPage() and fluidRow() to fixedPage() and fixedRow(), respectively, and I'm still unable to get a grid pattern! Below is that latest failed attempt:

ui <- fixedPage(
   fixedRow(
     class = "panel-body",
     column(
       6,
       fixedRow(
         column(6,
           class = "panel panel-default",
           tags$div(class = "panel-heading","Drag from here:"),
           tags$div(
             class = "panel-body",
             id = "sort1",
             icon_list(c("A","B","C","D","E"))
             )
         ),
         column(12,
           class = "panel panel-default",
           tags$div(class = "panel-heading","Drag here to delete:"),
           tags$div(
             class = "panel-body",
             id = "sortable_bin"
             )
         )
      )
    ),
     column(
       6,
       fixedRow(
         column(12,
           class = "panel panel-default",
           tags$div(class = "panel-heading","To here:"),
           tags$div(
             class = "panel-body",
             id = "sort2"
             )
         )
       )
     )
  ),
  sortable_js(
    "sort1",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "sortGroup1",
        put = FALSE)
    )
  ),
  sortable_js(
    "sort2",
    options = sortable_options(
      group = list(
        group = "sortGroup1",
        put = TRUE,
        pull = TRUE)
    )
  ),
  sortable_js(
    "sortable_bin",
    options = sortable_options(
      group = list(
        group = "sortGroup1",
        put = TRUE,
        pull = TRUE),
      onAdd = htmlwidgets::JS("function (evt) { this.el.removeChild(evt.item); }")
    )
  )
)
server <- function(input, output) {}
shinyApp(ui, server)

Addendum 2:

Below is a simpler code example, reflecting I_O's comment to wrap the panel content with HTML divisions () using div() to keep rows and columns without potentially interfering CSS classes. I still don't get the desired grid panel, also see image at the very bottom showing output using R Studio browser and Edge browser. Note that I have fiddled with variations of fluidRow(...), column(width = x, ...), class = x, style="width: 120px", and nothing seems to work.

ui <- fluidPage(
  fluidRow(
    column(6,
           div(class = "panel panel-default",
               div(class = "panel-heading", "Panel 1"),
               div(class = "panel-body", "panel 1 id")
           ),
           div(class = "panel panel-default",
               div(class = "panel-heading", "Panel 2"),
               div(class = "panel-body", "panel 2 id")
           )
           
    ),
    column(6,
           div(class = "panel panel-default",
               div(class = "panel-heading", "Panel 3"),
               div(class = "panel-body", "panel 3 id")
           ),
           div(class = "panel panel-default",
               div(class = "panel-heading", "Panel 4"),
               div(class = "panel-body", "panel 4 id")
           )
    )
  )
)

server <- function(input, output) {}

enter image description here

2 Answers

You can use a parent fluid row with two columns of width 6 each, which in turn contain child fluid rows within which columns will stack if you assign them full 12 units width.

ui <- fluidPage(
    fluidRow(
        column(6,
               fluidRow(
                   column(12, div(tags$h1("Drag from here"))),
                   column(12, div(tags$h1("Drag here to delete"))),
                   )
               ),
        column(6,
               fluidRow(
                   column(12, div(tags$h1("To here"))),
                   )
               )
    )
)

Extend/fill as required. Even so, on narrow devices the right column might be displayed below instead of beside the left one, because you're using a fluid (sic) layout. You can disable this behaviour via additional CSS (see including CSS in Shiny) or by drafting your own non-responsive HTML template.

edit Wrap panel content with HTML divisions () using div() to keep rows and columns without potentially interfering CSS classes like so:


fluidRow(
  column(6,
         div(class = "panel panel-default",
             div(class = "panel-heading", "Drag from here:"),
             div(class = "panel-body", "draggable content")
             ),
         div(class = "panel panel-default",
             div(class = "panel-heading", "Delete these:"),
             div(class = "panel-body", "unwanted content")
             )
         ),
  column(6,
         ## etc.
         )
)

Below is a solution that takes I_O input and How to create a simple grid panel layout using HTML/CSS within Shiny? input to resolve this OP question. It replaces all Shiny fluidRow(...) and column(...) in OP with CSS:

icon_list <- function(x){lapply(x,function(x) {tags$div(tags$strong(x))})}

ui <- fluidPage(

# parent (I think!):        
  div(style = "margin-top: 2rem; width: 60%; display: grid; grid-template-columns: 1fr 1fr; gap: 2rem;",
  
  # the below 3 div(...) are children of the above parent div(...)
  
    div(class = "panel panel-default",
        div(class = "panel-heading", "Drag from here"),
        div(class = "panel-body", 
            id= "sort1",
            icon_list(c("A","B","C","D","E"))
            )
    ),
    div(class = "panel panel-default",
        div(class = "panel-heading", "Drag to here"),
        div(class = "panel-body", 
            id = "sort2"
            )
    ),
        
    div(class = "panel panel-default",
        div(class = "panel-heading", "Trash bin"),
        div(class = "panel-body", 
            id = "sortable_bin"
            )
    )
  
  ),
  sortable_js(
    "sort1",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "sortGroup1",
        put = FALSE)
    )
  ),
  sortable_js(
    "sort2",
    options = sortable_options(
      group = list(
        group = "sortGroup1",
        put = TRUE,
        pull = TRUE)
    )
  ),
  sortable_js(
    "sortable_bin",
    options = sortable_options(
      group = list(
        group = "sortGroup1",
        put = TRUE,
        pull = TRUE),
      onAdd = htmlwidgets::JS("function (evt) { this.el.removeChild(evt.item); }")
    )
  )
)

server <- function(input, output) {}

shinyApp(ui, server)
Related