R 闪亮：使用闪亮的 JS 从数据表中获取信息

如何解决R 闪亮：使用闪亮的 JS 从数据表中获取信息

我想读出所有列名以及它们在我的数据表中的显示顺序。由于不同的原因，我无法使用“stateSave”等选项。

我没有关于 JS 的胶水，但我确信可以用它来完成，所以我需要你帮助我。我试过像

这样的代码片段

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

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

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

更多信息，为什么我不使用 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',"  var type = originalEvent.type;","  if(type == 'keydown' && targetName == 'input'){","    if([9,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)