在HTML中生成面板时如何创建网格布局？

Question

下面的可重现代码可以正常工作，除了我很难将它的 Shiny 输出布置成网格模式。我一直在玩 fluidPage(fluidRow(column...)))、dashboard(...)，但没有运气。我不断得到底部或更糟的第一张图片中显示的内容。无论我使用 R Studio 浏览器还是 Edge 浏览器，当运行这段代码时，我都会在下面的第一张图片中获得 3 个垂直堆叠的面板。

我认为问题是面板是在 HTML 中生成的。我也试过玩弄 HTML/CSS 来移动面板，结果一团糟。

如何调整此代码以获得底部第二张图片中显示的布局？面板可以是固定宽度的，如果重要的话，它们不需要是流动的。

可重现代码：

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)

附录 1：

我尝试了提供的第一个解决方案，它仍然不起作用。然后我尝试将所有fluidPage()和fluidRow()分别转换为fixedPage()和fixedRow()，但我仍然无法得到网格图案！以下是最近一次失败的尝试：

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)

附录 2：

下面是一个更简单的代码示例，反映了 I_O 的注释，用 HTML 分隔面板内容 () 使用 div() 保留行和列，而不会潜在地干扰 CSS 类。我仍然没有得到所需的网格面板，也可以在最底部看到显示使用 R Studio 浏览器和 Edge 浏览器输出的图像。请注意，我摆弄了 fluidRow(...)、column(width = x, ...)、class = x, style="width: 120px" 的变体，但似乎没有任何效果。

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) {}

Answer 1

您可以使用包含两列宽度为 6 的父级流体行，这又包含子级流体行，如果您为它们分配完整的 12 个单位宽度，列将堆叠在其中。

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 根据需要。即便如此，在窄设备上，右栏可能会显示在下方而不是左栏旁边，因为您使用的是流畅（原文如此）布局。您可以通过 additional CSS (see including CSS in Shiny) or by drafting your own non-responsive HTML template.

禁用此行为

编辑用 HTML 分隔面板内容 () 使用 div() 保留行和列而不会潜在地干扰 CSS 类像这样：


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.
         )
)

Answer 2

下面是采用 I_O 输入和输入来解决此 OP 问题的解决方案。它将 OP 中的所有 Shiny fluidRow(...) 和 column(...) 替换为 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)

在HTML中生成面板时如何创建网格布局？

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

html

css

r

shiny

sortablejs