如何在 Shiny 應用程序中將 dataframe 顯示為網格，而不是表格？

Question

我在 dataframe 中有一些數據。 我可以將 dataframe 顯示為帶有 DataTables 的表格。

但是，我想將數據顯示為具有 N 列的網格，以便數據框中的每 N 行都顯示在同一行中。

將數據顯示為網格：

如上圖所示，我通過使用 HTML 直接渲染數據框來顯示一個網格。 但下一步是我卡住的地方，即我希望能夠在單擊網格中的單元格時顯示模式對話框。 我在數據表中有這個工作，但我無法弄清楚如何使 div 可點擊，這樣在處理事件時我知道點擊了哪個單元格？

library("shiny")
library("tidyr")
library("tidyverse")
library("dplyr")
library("shinydashboard")


# generate html grid from data frame
getHTML <- function (frames) {
  innerhtml = '<div class="grid-container">'
  for (row in 1:(nrow(frames))) {
      id <- frames[row, "id"]
      name  <- frames[row, "names"]
        row_html = '<div class="grid-item">'
        row_html = paste(row_html, '<span>Name: ' , name, "id ", row , '</span>')
        row_html = paste(row_html, '</div>')
        
         innerhtml = paste(innerhtml, row_html)
  }
  paste(innerhtml, "</div>")
  return (innerhtml)
}

#show modal dialog for player id and name
plotModal <- function(id, name) {
  modalDialog(
         p(paste("Player  # ", id, ", " , name,", was clicked")),
         title = paste("Player " , id),
        
        easyClose = TRUE
      )
}

ui <- dashboardPage(
  # Application title
  dashboardHeader(title = "Dashboard"),

  dashboardSidebar(
      h3("Filters")
    ),

    dashboardBody(
        tags$head(tags$style(HTML('
      .grid-container {
        display: grid;
        grid-template-columns: auto auto auto auto;
 
        }
        .grid-item {
        background-color: rgba(255, 255, 255, 0.8);
        border: 1px solid rgba(0, 0, 0, 0.8);
          padding: 20px;


        }'))),

      fluidRow(
        box(title="Render as table", column(width=12, DT::dataTableOutput("player_table"))),
       box(title="Render as Grid", column(width=12,   uiOutput("player_grid")))
      )
    )
)


server <- function(input, output, session) {
# data to be rendered
    frames = data.frame(names= c("james","kyle", "sally","hannah","jeff","kurt"), ids=c(1:6))

  output$player_table <- DT::renderDataTable({
    DT::datatable(frames, rownames=FALSE,  selection = 'single')
  })

        
#when a row in the table is clicked, show popup
  observeEvent(input$player_table_cell_clicked, {
    info = input$player_table_cell_clicked
    # do nothing if not clicked yet, or the clicked cell is not in the 1st column
    if (is.null(info$value)) {
      return()
    }
  
    row = frames[info$row, ]
    showModal(plotModal(row$id, row$names))
  })

output$player_grid <- renderUI ({
      HTML(getHTML(frames))
  })
  
}

# Create Shiny app ----
shinyApp(ui, server,options=list(host="0.0.0.0", port=8015))

Answer 1

這是一種方法：

library(shiny)
library(shinydashboard)

js <- "
$(document).ready(function(){
  $('body').on('click', '.grid-item span', function(){
    var name = $(this).data('name'),
        id = $(this).data('id');
    Shiny.setInputValue('cell', {name: name, id: id});
  });
});
"

# generate html grid from data frame
getHTML <- function (frames) {
  innerhtml = '<div class="grid-container">'
  for (row in 1:(nrow(frames))) {
    id <- frames[row, "ids"]
    name  <- frames[row, "names"]
    row_html = '<div class="grid-item">'
    cell <- sprintf("<span data-name='%s' data-id='%s'>Name: %s - id: %s</span>", 
                    name, id, name, id)
    row_html = paste(row_html, cell)
    row_html = paste(row_html, '</div>')
    innerhtml = paste(innerhtml, row_html)
  }
  paste(innerhtml, "</div>")
  return (innerhtml)
}

#show modal dialog for player id and name
plotModal <- function(id, name) {
  modalDialog(
    p(paste("Player  # ", id, ", " , name,", was clicked")),
    title = paste("Player " , id),
    
    easyClose = TRUE
  )
}

ui <- dashboardPage(
  # Application title
  dashboardHeader(title = "Dashboard"),
  
  dashboardSidebar(
    h3("Filters")
  ),
  
  dashboardBody(
    tags$head(tags$style(HTML('
                              .grid-container {
                              display: grid;
                              grid-template-columns: auto auto auto auto;
                              }
                              .grid-item {
                              background-color: rgba(255, 255, 255, 0.8);
                              border: 1px solid rgba(0, 0, 0, 0.8);
                              padding: 20px;
                              }')),
              tags$script(HTML(js))),
    
    fluidRow(
      box(title="Render as Grid", column(width=12, uiOutput("player_grid")))
    )
  )
)


server <- function(input, output, session) {
  # data to be rendered
  frames = data.frame(
    names= c("james","kyle", "sally","hannah","jeff","kurt"), 
    ids=c(1:6)
  )
  
  #when a row in the table is clicked, show popup
  observeEvent(input$cell, {
    showModal(plotModal(input$cell$id, input$cell$name))
  })
  
  output$player_grid <- renderUI ({
    HTML(getHTML(frames))
  })
  
}

# Create Shiny app ----
shinyApp(ui, server)