[英]R shiny DT hover shows detailed table
I am trying to work on an R shiny app where I want to show a consolidated table on top and when the user hovers on any line item it would show the detailed section of that table.So here's the code for the first table我正在尝试使用 R 闪亮的应用程序,我想在顶部显示一个合并表,当用户将鼠标悬停在任何行项目上时,它会显示该表的详细部分。所以这是第一个表的代码
library(ggplot2)
ui <- fluidPage(
titlePanel("Basic DataTable"),
# Create a new row for the table.
DT::dataTableOutput("table")
)
server <- function(input, output) {
data <- mpg
data <-data %>% group_by(manufacturer,year) %>%
summarise(cty = round(mean(cty),2),hwy = round(2,mean(hwy)))
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
data
}))
}
shinyApp(ui,server)
Now when the user hovers on Audi
for example it should show a detailed version just for Audi
something like this in a table below.Can this be done in shiny with DT on hover or click.现在,当用户将鼠标悬停在
Audi
,它应该在下表中显示一个专门为Audi
提供的详细版本。这可以在悬停或单击时使用 DT 以闪亮的方式完成。
Here is a way.这是一种方法。 If you prefer to display the child table on click rather than on hover, replace
"table.on('mouseover', 'td', function(){"
with "table.on('click', 'td', function(){"
.如果您更喜欢单击而不是悬停时显示子表,请将
"table.on('mouseover', 'td', function(){"
替换为"table.on('click', 'td', function(){"
。
library(shiny)
library(DT)
data(mpg, package = "ggplot2")
callback <- c(
"table.on('mouseover', 'td', function(){",
" var index = table.cell(this).index();",
" Shiny.setInputValue('cell', index, {priority: 'event'});",
"});"
)
ui <- fluidPage(
br(),
DTOutput("tbl")
)
server <- function(input, output, session){
dat <- mpg
output[["tbl"]] <- renderDT({
datatable(
dat,
callback = JS(callback)
)
})
filteredData <- eventReactive(input[["cell"]], {
i <- input[["cell"]]$row + 1
j <- input[["cell"]]$column
if(j > 0){
dat[dat[[j]] == dat[i,j], , drop = FALSE]
}else{
NULL
}
})
output[["tblfiltered"]] <- renderDT({
datatable(
filteredData(),
fillContainer = TRUE,
options = list(
pageLength = 5
)
)
})
observeEvent(filteredData(), {
showModal(
modalDialog(
DTOutput("tblfiltered"),
size = "l",
easyClose = TRUE
)
)
})
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.