javascript - R Shiny : Getting information from Datatable with JS in shiny

Question

我想读出所有列名以及它们在我的数据表中的显示顺序。由于不同的原因，我无法使用“stateSave”等选项。
我没有关于 JS 的胶水，但我相信它可以用它来完成，所以我需要你帮助我。
我试过像这样的代码片段

datatable(
data,
callback = JS(
              "function(data, type, row, meta) {",
              "  name = data.columns().names();",
              "  Shiny.setInputValue('test', name, {priority: 'event'});",
              "};"
            )
)

但我没有工作。我猜是因为功能？我真的不知道。
所以总结一下:我想要一个 Shiny 的输入，它显示我的数据表的当前“列状态”，例如列名及其索引。
更多信息，为什么我不使用 R 中的列名:
我想使用我在互联网上找到的 DT 和其他 JS 脚本的不同扩展。其中，我想使用 colReorder 和一个函数来更改单列的可见性。我想要的后一个功能通过自制的弹出窗口和复选框来解决。这些应该与表格的顺序相同(使用 colReorder 之后)并且应该显示等位列，无论是否可见。
另外我必须添加新的行和列，所以我不时重新加载我的表。近似函数不适用于 server = TRUE，我需要其他扩展和我的 JS 脚本。
我的下一个尝试是使用 savestate = TRUE 和 input$name_state 来读出顺序和可见性，但这在重新加载表时效果不佳。
所以我的计划是找到一个 JS 脚本，它为我提供表格的顺序和可见的列名，这样我就可以为自己合成所有信息。
这是我的扩展、DT 选项和使用的 JS 脚本:

DT_optionen <- list(
  keys = TRUE,
  dom = "lpt",
  pageLength = "-1",
  lengthMenu = list(c(12, 24, -1), c("1 Jahr", "2 Jahre", "alles")),
  scrollX = TRUE,
  deferRender = TRUE,
  scrollY = 500,
  scroller = TRUE,
  fixedColumns = list(leftColumns = 2),
  colReorder = list(fixedColumnsLeft = 2,
                    realtime = FALSE
  ),
  columnDefs = list(
    list(visible = FALSE, targets = 3),
    list(className = 'dt-right', targets = "_all"),
    list(
      targets = 1,
      render = JS(Datum_sortieren)
    )
  )
)

# With this script you can use the return key 'excel-like' to change values after navigation with the arrow keys
# it only works with server = TRUE
own_JS <- c(
  "table.on('key', function(e, datatable, key, cell, originalEvent){",
  "  var targetName = originalEvent.target.localName;",
  "  if(key == 13 && targetName == 'body'){",
  "    $(cell.node()).trigger('dblclick.dt');",
  "  }",
  "});",
  "table.on('keydown', function(e){",
  "  if(e.target.localName == 'input' && [9,13,37,38,39,40].indexOf(e.keyCode) > -1){",
  "    $(e.target).trigger('blur');",
  "  }",
  "});",
  "table.on('key-focus', function(e, datatable, cell, originalEvent){",
  "  var targetName = originalEvent.target.localName;",
  "  var type = originalEvent.type;",
  "  if(type == 'keydown' && targetName == 'input'){",
  "    if([9,37,38,39,40].indexOf(originalEvent.keyCode) > -1){",
  "      $(cell.node()).trigger('dblclick.dt');",
  "    }",
  "  }",
  "});"

datatable(
      Ausgaben_anzeige,
      selection = "none",
      editable = TRUE,
      callback = JS(own_JS),
      extensions = c("KeyTable", "FixedColumns", "Scroller", "ColReorder"),
      options = DT_optionen
    )
)

圣诞快乐，
舍夫科赫

Answer 1

这是rownames = FALSE的代码.如果您使用 rownames = TRUE，则必须对其进行调整。 .

library(shiny)
library(DT)

js <- c(
  "table.on('column-reorder', function (e, settings, details) {",
  "  Shiny.setInputValue('order', details.mapping);",
  "});"
)

ui <- fluidPage(
  br(),
  verbatimTextOutput("colnames"),
  br(),
  DTOutput("tbl")
)

server <- function(input, output, session){
  
  output[["tbl"]] <- renderDT({
    datatable(
      iris,
      rownames = FALSE,
      extensions = "ColReorder",
      options = list(
        colReorder = TRUE
      ),
      callback = JS(js)
    )
  })
  
  columnsOrder <- reactiveVal(1:ncol(iris))
  
  observeEvent(input[["order"]], {
    columnsOrder(columnsOrder()[input[["order"]] + 1])
  })
  
  output[["colnames"]] <- renderPrint({
    colnames(iris)[columnsOrder()]
  })
  
}

shinyApp(ui, server)