R Shiny DT：鼠标移出表格时如何让input[["cell"]]重置为NULL

问题说明 #

我正在开发R Shiny应用，需要实现鼠标悬停表格单元格时显示对应文本的功能。基于现有示例修改后遇到问题：当鼠标移出表格时，input[["cell"]]会保留最后触碰的单元格值，无法自动恢复为NULL。

原代码 #

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"),
  htmlOutput("msg")
)

server <- function(input, output, session){

  dat <- mpg

  output[["tbl"]] <- renderDT({
    datatable(
      dat,
      callback = JS(callback)
    )
  })

  output[["tblfiltered"]] <- renderDT({
    datatable(
      filteredData(),
      fillContainer = TRUE,
      options = list(
        pageLength = 5
      )
    )
  })

  output$msg <- renderText(paste(input[["cell"]], collapse = ","))

}

shinyApp(ui, server)

解决方法 #

只需在JavaScript回调中添加表格的mouseleave事件监听，当鼠标离开整个表格时，将input[["cell"]]设为null即可。修改后的callback代码如下：

callback <- c(
  "table.on('mouseover', 'td', function(){",
  "  var index = table.cell(this).index();",
  "  Shiny.setInputValue('cell', index, {priority: 'event'});",
  "});",
  "table.on('mouseleave', function(){",
  "  Shiny.setInputValue('cell', null, {priority: 'event'});",
  "});"
)

完整修改后代码 #

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'});",
  "});",
  "table.on('mouseleave', function(){",
  "  Shiny.setInputValue('cell', null, {priority: 'event'});",
  "});"
)

ui <- fluidPage(
  br(),
  DTOutput("tbl"),
  htmlOutput("msg")
)

server <- function(input, output, session){

  dat <- mpg

  output[["tbl"]] <- renderDT({
    datatable(
      dat,
      callback = JS(callback)
    )
  })

  # 注：原代码中filteredData()未定义，若需使用需自行实现该函数，此处临时替换为dat避免报错
  output[["tblfiltered"]] <- renderDT({
    datatable(
      dat,
      fillContainer = TRUE,
      options = list(
        pageLength = 5
      )
    )
  })

  output$msg <- renderText({
    if(is.null(input[["cell"]])){
      "" # 鼠标移出时显示空文本
    } else {
      paste(input[["cell"]], collapse = ",")
    }
  })

}

shinyApp(ui, server)

说明 #

• 添加的mouseleave事件会在鼠标离开表格区域时触发，将cell输入值重置为null
• 优化了renderText部分，当input[["cell"]]为null时显示空文本，避免输出NULL字样

内容的提问来源于stack exchange，提问作者Duncan Ellis