r - 如何在 Shiny 应用程序中将数据框显示为网格而不是表格?
问题描述
我在数据框中有一些数据。我可以使用 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))
解决方案
这是一种方法:
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)
推荐阅读
- javascript - 如何根据javascript中的特定字符序列拆分文本
- docker - 在服务器 2016/2019 上自动安装 Docker CLI
- javascript - Get input value for country code with jquery [auto country by IP/intl-tel-input jquery library]
- python - Python:使用 argparse 从命令行调用函数
- mysql - 错误;无法更新存储函数/触发器中的表“分数”,因为它已被调用此存储函数/触发器的语句使用
- angular - 角,NGXS。我应该如何在状态对象中正确实现身份验证订阅?
- arrays - 位排序的空间复杂度是多少?
- python - 是否可以修补在另一个类中调用的方法?
- angular - 使用 rxjs 将 loadFBX 承诺包装在 observable 中
- javascript - 用 node.js、js 和 html(DOM) 编写 json 文件