具有反应性列和弹出工具提示的 R 闪亮数据表答案

【问题标题】：R shiny Datatable with Reactive Columns and Popover Tooltips具有反应性列和弹出工具提示的 R 闪亮数据表
【发布时间】：2020-10-14 23:22:41
【问题描述】：

有谁知道如何在 R Shiny 中将反应性列与弹出工具提示集成？

我有一些基于 post 和代码的使用 Datatable 的反应性列的工作代码：

library(shiny)
library(DT)

server<-function(input, output,session) { 
  
  shinyInput <- function(FUN, len, id, ivals, ...) {
    inputs <- numeric(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(
        FUN(paste0(id, i), label = NULL,
            value=ivals[i],...)
      )
    }
    inputs
  }
  
  it_df <- reactive({
    data.frame(
      Parameters = rep("X",7),
      Values = shinyInput(numericInput, 7,
                          'param_values', 
                          numeric(7),
                          width = '100%'),
      stringsAsFactors = FALSE
    )
  })
  output$param_table <- DT::renderDataTable(
    datatable(it_df(),escape = FALSE,
              options = list(
                preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node());}"),
                drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());}")
              )
    ))
}

ui <- fluidPage( DT::dataTableOutput('param_table'))

shinyApp(ui,server)

我还有一些基于 post 和代码的弹出框工具提示的工作代码：

library(shiny)
library(DT)

ui<-shinyUI(
  mainPanel(
    DT::dataTableOutput("tbl")
  )   
) 

server<-shinyServer(function(input, output,session) {
  output$tbl = DT::renderDataTable(
    datatable(iris[1:5, ], callback = JS("
                                    var tips = ['First row name', 'Second row name', 'Third row name',
                                    'Fourth row name', 'Fifth row name'],
                                    firstColumn = $('#tbl tr td:first-child');
                                    for (var i = 0; i < tips.length; i++) {
                                    $(firstColumn[i]).attr('title', tips[i]);
                                    }")), server = FALSE)
}) 

shinyApp(ui = ui, server = server)

但是我在将两者结合起来时遇到了很多麻烦。部分原因是我缺乏 JS 知识。

谢谢，非常感谢任何帮助！

【问题讨论】：

标签： javascript r shiny datatable

【解决方案1】：

只需将您提供的两个 javascript 代码组合到一个 datatable 函数中即可。这应该有效：

library(shiny)
library(DT)

ui<-shinyUI(
  mainPanel(
    DT::dataTableOutput("tbl")
  )   
) 

server<-shinyServer(function(input, output,session) {
  shinyInput <- function(FUN, len, id, ivals, ...) {
    inputs <- numeric(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(
        FUN(paste0(id, i), label = NULL,
            value=ivals[i],...)
      )
    }
    inputs
  }
  
  it_df <- reactive({
    data.frame(
      Parameters = rep("X",5),
      Values = shinyInput(numericInput, 5,
                          'param_values', 
                          numeric(5),
                          width = '100%'),
      stringsAsFactors = FALSE
    )
  })
  output$tbl = DT::renderDataTable(
    datatable(it_df(), escape = FALSE, options = list(
      preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node());}"),
      drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());}")
    ),
    callback = JS("
                                    var tips = ['First row name', 'Second row name', 'Third row name',
                                    'Fourth row name', 'Fifth row name'],
                                    firstColumn = $('#tbl tr td:first-child');
                                    for (var i = 0; i < tips.length; i++) {
                                    $(firstColumn[i]).attr('title', tips[i]);
                                    }")), server = FALSE)
}) 

shinyApp(ui = ui, server = server)

【讨论】：

谢谢！那很简单。出于某种原因，我认为回调部分位于选项部分中。
另外“output$tbl”必须匹配回调中的JS“#tbl”。我的代码中没有我的代码，弄清楚这一点非常令人头疼。