R shiny: Getting information from Datatable with JS in shiny

Question

I want to read out all column names and in which order they are displayed in my Datatable. I can't use options like "stateSave" because of different reasons.

I don't have a glue about JS, but I'm sure it can be done with it, so I need you to help me. I tried code snippets like

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

but I didn't work. I'll guess it is because of the function? I really don't know.

So to summarise: I want a shiny input which shows me the current "column-state" of my datatable, e.g. column names and their index.

More information, why I don't use the colnames from R:

I want to use different extensions of DT and other JS scripts I found in the internet. Among others I want to use colReorder and a function to change the visibilty of single columns. The latter function I want so solve with a self-made pop up and checkboxes. These should be in the same order as the table (after using colReorder) and should show alle columns, visible or not. Also I have to add new rows and columns, so I reload my table from time to time. The approx-functions dont't work for server = TRUE, which I need for other extensions and my JS-script.

My next try was to use savestate = TRUE and input$name_state to read out the order and visibility but this didn't work well with the reloading of the table.

So my plan is to find a JS script that gives me the order and visible colnames of my table, so I can cominate all information for myself.

Here are my extensions, DT-options and used JS-scripts:

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

Merry x-mas, Chefkoch

Answer 1

Here is the code for rownames = FALSE. You'll have to adapt it if you use 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)