R shiny:在 shiny 中使用 JS 从 Datatable 获取信息

R shiny: Getting information from Datatable with JS in shiny

我想读出所有列名以及它们在我的数据中的显示顺序table。由于不同的原因,我不能使用像“stateSave”这样的选项。

我对 JS 不太了解,但我确信可以用它来完成,所以我需要你帮助我。 我尝试了

这样的代码片段
datatable(
data,
callback = JS(
              "function(data, type, row, meta) {",
              "  name = data.columns().names();",
              "  Shiny.setInputValue('test', name, {priority: 'event'});",
              "};"
            )
)

但我没有工作。我猜是因为功能?我真的不知道。

总结一下:我想要一个闪亮的输入,它显示我的数据的当前“列状态”table,例如列名及其索引。

更多信息,为什么我不使用 R 中的 colnames:

我想使用我在互联网上找到的 DT 和其他 JS 脚本的不同扩展。除其他外,我想使用 colReorder 和一个函数来更改单个列的可见性。我想用自制的弹出窗口和复选框解决后一个功能。这些应该与 table 的顺序相同(在使用 colReorder 之后)并且应该显示所有列,可见与否。 我还必须添加新的行和列,所以我不时重新加载 table。近似函数不适用于 server = TRUE,我需要其他扩展和我的 JS 脚本。

我的下一次尝试是使用 savestate = TRUE 和 input$name_state 来读出顺序和可见性,但这在重新加载 table.

所以我的计划是找到一个 JS 脚本,它给我 table 的顺序和可见的列名,这样我就可以自己组合所有信息。

这是我的扩展、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
    )
)

圣诞快乐, 舍夫科赫

这是 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)