R闪亮的DT悬停显示详细表格

Question

我正在尝试开发一个 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)

现在，例如，当用户将鼠标悬停在Audi 上时，它应该在下表中显示仅针对Audi 的详细版本。可以在悬停或单击时使用 DT 以闪亮的方式完成。

Answer 1

这是一种方法。如果您希望在单击而不是悬停时显示子表，请将 "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)