让 RowReorder 扩展在 Shiny DataTable 中工作

Question

我觉得我与我的应用程序非常接近 - 我需要做的最后一件事是让 RowReorder 扩展与能够使用代理表一起工作 - 我读过 Proxy Table 仅在以下情况下工作Server = True - 能够使用 Proxy 对我来说很重要，因为我将为用户呈现相当大的表格...速度很重要。

场景A

 output$TabBU <- renderDT(server=TRUE,
                      values,
                      escape = FALSE,

当服务器设置为 True 时...代理 Table 工作正常，我的应用程序中的级别 up/down 按钮按需要工作。但是 rowreorder 扩展不起作用 - 任何重新排序都会回到原来的位置

场景 B

 output$TabBU <- renderDT(server=FALSE,
                      values,
                      escape = FALSE,

当服务器设置为 False 时...Rowreorder 扩展按预期工作 - 但显然 Proxy Table 出现问题 - 正如预期的那样，下面一行出现此错误...抛出“无效 JSON响应

replaceData(proxyTable,
                values, resetPaging = FALSE
    )

完整代码如下

# Load packages
library(dplyr)
library(shiny)
library(data.table)
library(DT)


values <- data.frame(Country = c("England","Scotland","Wales"),Level = c(4,5,6))
  
  
ui <- fluidPage(
  tags$style("#TabBU { white-space:pre; }"),
  DT::dataTableOutput('TabBU')
)

server <- function(input, output) {
  
  
  getPlusButton <- function(n, idS = "", lab = "Pit") {
    if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
    ret <- shinyInput(actionButton, n,
                      'button_', label = ">>>",icon = icon("icon-plus-sign-alt"),
                      onclick = sprintf('Shiny.onInputChange(\"%splus_button_%s\",  this.id)' ,idS, lab))
    return (ret)
  }
  
  shinyInput <- function(FUN, n, id, ses, ...) {
    as.character(FUN(paste0(id, n), ...))
  }
  
  getMinusButton <- function(n, idS = "", lab = "Pit") {
    if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
    ret <- shinyInput(actionButton, n,
                      'button_', label = "<<<",icon = icon("icon-plus-sign-alt"),
                      onclick = sprintf('Shiny.onInputChange(\"%sminus_button_%s\",  this.id)' ,idS, lab))
    return (ret)
  }
  
  
  
  values <- values %>%
    mutate(id_level = 1:nrow(values)) %>%
    rowwise() %>%
    mutate(`-` = getMinusButton(id_level, idS = "", lab = "Tab1")) %>%
    mutate(`+` = getPlusButton(id_level, idS = "", lab = "Tab1")) %>%
    select(id_level,Country,Level,`-`,`+`) %>% ungroup()
  
  
  
  #Note    In order to Use PRoxy Tables - reloadData() only works for tables in the server-side processing mode,
  # e.g. tables rendered with renderDataTable(server = TRUE). 
  # The data to be reloaded (i.e. the one you pass to dataTableAjax()) 
  # must have exactly the same number of columns as the previous data object in the table.
  output$TabBU <- renderDT(server=T,
                      values,
                      escape = FALSE,
                      colnames = c(Position = 1),
                      # add the name
                      extensions = 'RowReorder',
                      selection = 'none',
                      options = list(
                        order = list(list(0, 'asc')),
                        rowReorder = TRUE,
                        pageLength = 500
                      ),callback=JS(
                        "// pass on data to R
    table.on('row-reorder', function(e, details, changes) {
        Shiny.onInputChange('TabBU_row_reorder', JSON.stringify(details));
    });")
  )
  
  proxyTable <<- dataTableProxy('TabBU')
 
  observeEvent(input$plus_button_Tab1, {
    
    i <- as.numeric(strsplit(input$plus_button_Tab1, "_")[[1]][2])
    j = which( colnames(values)=="Level" )
    v = as.numeric(values[i, j]) + 1
    
    values[[i, j]] <<- DT::coerceValue(v, values[[i, j]])

    replaceData(proxyTable,
                values, resetPaging = FALSE
    )
  })
  
  
  observeEvent(input$minus_button_Tab1, {

    i <- as.numeric(strsplit(input$minus_button_Tab1, "_")[[1]][2])
    j = which( colnames(values)=="Level" )
    v = as.numeric(values[i, j]) - 1
    
    values[[i, j]] <<- DT::coerceValue(v, values[[i, j]])
    replaceData(proxyTable,
                values, resetPaging = FALSE
    )
  })
  
  
}





shinyApp(ui, server)

Answer 1

当行重新排序时，必须在服务器端更新 table。这似乎有效：

library(shiny)
library(DT)

callback <- c(
  "table.on('row-reorder', function(e, details, edit){",
  "  var oldRows = [], newRows = [];",
  "  for(let i=0; i < details.length; ++i){",
  "    oldRows.push(details[i].oldData);",
  "    newRows.push(details[i].newData);",
  "  }",
  "  Shiny.setInputValue('rowreorder', {old: oldRows, new: newRows});",
  "});"
)

ui <- fluidPage(
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session){
  
  dat <- iris 
  
  output[["dtable"]] <- renderDT({
    datatable(dat, extensions = "RowReorder", callback = JS(callback), 
              selection = "none", 
              options = list(rowReorder = TRUE))
  })
  
  proxy <- dataTableProxy("dtable")
  
  observeEvent(input[["rowreorder"]], {
    old <- unlist(input[["rowreorder"]]$old)
    new <- unlist(input[["rowreorder"]]$new)
    dat[new, ] <<- dat[old, ]
    replaceData(proxy, dat, resetPaging = FALSE)
  })
  
}

shinyApp(ui, server)

让 RowReorder 扩展在 Shiny DataTable 中工作

Getting the RowReorder Extension to Work in a Shiny DataTable

r

shiny

data.table

dt