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)