使用 initComplete 在 Shiny 应用程序中使用 Javascript 定位特定的 DT::datatable 表

Question

假设我们有一个带有两个 DT 表的 Shiny 应用程序，我们希望在表呈现后使用一些 Javascript 对其进行修改。我们将不同的上标附加到每个表的标题中；我们将上标“1”附加到表 1，将上标“2”附加到表 2。此 JS 使用initComplete 触发，即在呈现表时。

我的 JS 技能不存在，所以我目前正在选择要附加到 th:contains(<header-string>) 的表头。例如，将上标附加到包含字符串 'Sepal' 的表头：

jsc <- '
    function(settings, json) {
        $("th:contains(\'Sepal\')").append(\'<sup>1</sup>\');
    }
'

由于我们需要为不同的表使用不同的上标，因此我们需要为每个表定义单独的 Javascript 来触发。这个问题是表头都包含我要查找的字符串，导致两个上标都附加到两个表头。

假设不同的表在相关的表头中总是包含相同的字符串（因此th:contains 将不是一个可行的选择——表头可能完全相同），我们如何选择一个特定的将 Javascript 应用到的表？我们无法在 Shiny 应用中为 datatable 调用提供 elementId，例如，

output$table1<- renderDT({datatable(iris, elementId = 'table1')})

导致警告

renderWidget(instance) 中的警告： 忽略显式提供的小部件 ID“table1”； Shiny 不使用它们

下面是一个可重现的示例。这两个表具有相同的列名，因此 Javascript 将两个上标附加到每个表的 Sepal.Length 标头。所需的输出是让第一个表的Sepal.Length 标头带有上标“1”，第二个表的Sepal.Length 标头带有上标“2”，而当前示例将“12”附加到两个表的标头。

有趣的是，当应用程序在 RStudio 查看器中打开时，只运行第一个 initComplete，因此两个表头都有一个上标“1”。我忽略了这一点并在 Firefox 和 Chrome 上检查结果。

library(shiny)
library(DT)

jsc <- '
    function(settings, json) {
        $("th:contains(\'Sepal\')").append(\'<sup>1</sup>\');
    }
'

jsc2 <- '
    function(settings, json) {
        $("th:contains(\'Sepal\')").append(\'<sup>2</sup>\');
    }
'

ui <- {
    fluidPage(
        fluidRow(
            column(6,
               DTOutput('table1')
            ),
            column(6,
               DTOutput('table2')
            )
        )
    )
}

server <- function(input, output, session) {
    output$table1 <- renderDT({
        datatable(iris[, c('Species', 'Sepal.Length')],
            options(
                initComplete = JS(jsc))
        )
    })
    
    output$table2 <- renderDT({
        datatable(iris[, c('Species', 'Sepal.Length')],
            options(
                initComplete = JS(jsc2)  
            )
        )
    })
}

options(shiny.launch.browser = TRUE)
shinyApp(ui, server)

请注意，我知道我们可以使用escape = FALSE 将<sup>1</sup> 直接写入表头，但是还有其他JS 函数要在表上执行，因此这种方法不适合。谢谢你的建议。

Answer 1

首先，options 必须是一个列表：

datatable(iris[, c('Species', 'Sepal.Length')],
          options = list(
            initComplete = JS(jsc)
          )
)

现在，您可以通过在 jQuery 选择器中提供 id 来定位表：

jsc <- '
    function(settings, json) {
        $("#table1 th:contains(\'Sepal\')").append(\'<sup>1</sup>\');
    }
'

否则，$("th:contains(\'Sepal\')") 会选择所有包含Sepal 的th，可以在整个页面上找到。

但是这种方式如果改变id需要改变JS代码。这样做更实际：

jsc <- '
    function(settings, json) {
        var $table = $(this.api().table().node());
        $table.find("th:contains(\'Sepal\')").append(\'<sup>1</sup>\');
    }
'

完整代码：

library(shiny)
library(DT)

jsc <- '
    function(settings, json) {
        var $table = $(this.api().table().node());
        $table.find("th:contains(\'Sepal\')").append(\'<sup>1</sup>\');
    }
'

jsc2 <- '
    function(settings, json) {
        var $table = $(this.api().table().node());
        $table.find("th:contains(\'Sepal\')").append(\'<sup>2</sup>\');
    }
'

ui <- {
  fluidPage(
    fluidRow(
      column(6,
             DTOutput('table1')
      ),
      column(6,
             DTOutput('table2')
      )
    )
  )
}

server <- function(input, output, session) {
  output$table1 <- renderDT({
    datatable(iris[, c('Species', 'Sepal.Length')],
              options = list(
                initComplete = JS(jsc)
              )
    )
  })
  
  output$table2 <- renderDT({
    datatable(iris[, c('Species', 'Sepal.Length')],
              options = list(
                initComplete = JS(jsc2)  
              )
    )
  })
}

shinyApp(ui, server)