如何在 R Shiny 中为 DT 使用 localStorage 选项?

How to use the localStorage option for DT in R Shiny?

我想设计一个闪亮的应用程序,允许用户将他们的输入保存在本地存储中,这意味着当用户使用他们的网络浏览器重新打开该工具时,该工具会重新加载用户上次提供的值。这主要是通过shinyStore包实现的。

下面是一个例子。到目前为止,我可以使用 shinyStore 恢复任何闪亮的输入小部件,例如 textInput。但是,我现在还想从 DT 包的数据表中恢复编辑后的值。

我知道编辑值的信息在input$DT_out_cell_edit中,但它不是一个单一的值,所以updateStore功能不起作用。我考虑过使用 DT 包中的 dataTableProxyreplaceData,但它们无法保留上次应用程序运行时的值。最后,我尝试按照本例设置 stateSave = TRUE,但它无法记录编辑后的值。

如果可以的话,有什么想法请告诉我。如果不可能,也请告诉我。

library(shiny)
library(DT)
library(shinyStore)

ui <- fluidPage(
  headerPanel("shinyStore Example"),
  sidebarLayout(
    sidebarPanel = sidebarPanel(
      initStore("store", "shinyStore-ex1"),
      # A button to save current input to local storage
      actionButton("save", "Save", icon("save")),
      # A button to clear the input values and local storage
      actionButton("clear", "Clear", icon("stop"))
    ),
    mainPanel = mainPanel(
      fluidRow(
        textInput(inputId = "text1", label = "A text input", value = ""),
        DTOutput(outputId = "DT_out")
      )
    )
  )
)

server <- function(input, output, session) {
  
  output$DT_out <- renderDT(
    datatable(
      mtcars,
      selection = "none", editable = TRUE,
      options = list(
        stateSave = TRUE
      )
    )
  )
  
  # Update the input with local storage when the app runs
  observe({
    if (input$save <= 0){
      updateTextInput(session, inputId = "text1", value = isolate(input$store)[["text1"]])
    }
    updateStore(session, name = "text1", isolate(input$text1))
  })
  
  # Clear the local storage
  observe({
    if (input$clear > 0){
      updateTextInput(session, inputId = "text1", value = "")
      
      updateStore(session, name = "text1", value = "")
    }
  })
}

shinyApp(ui, server)

请检查以下内容:

我正在使用反应值 uiTable 来跟踪对数据所做的更改table。 单击保存按钮后,updateStore 用于保存 data.frame

当新会话开始时 input$store$uiTable 会监视更改。如果 table 被更改,它将通过 replaceData 更新。

目前这不适用于 data.frame 的行名,因为它需要一些额外的代码,在我看来没有必要说明原理。


编辑: 我通过 data.table 添加了 mtcars 行名作为列并禁用了 DT 行名的编辑,以便为将来提供更直观的示例读者。

library(shiny)
library(DT)
library(shinyStore)
library(data.table)

mtcarsDT <- data.table(mtcars, keep.rownames = TRUE)
cols <- names(mtcarsDT)
mtcarsDT[, (cols) := lapply(.SD, as.character), .SDcols = cols]

ui <- fluidPage(
  headerPanel("shinyStore Example"),
  sidebarLayout(
    sidebarPanel = sidebarPanel(
      initStore("store", "shinyStore-ex1"),
      actionButton("save", "Save", icon("save")),
      actionButton("clear", "Clear", icon("stop"))
    ),
    mainPanel = mainPanel(
      fluidRow(
        textInput(inputId = "text1", label = "A text input", value = ""),
        DTOutput(outputId = "DT_out")
      )
    )
  )
)

server <- function(input, output, session) {
  
  rv <- reactiveValues(uiTable = mtcarsDT)
  
  mydataTableProxy <- dataTableProxy(outputId = "DT_out")
  
  output$DT_out <- renderDT({
    datatable(mtcarsDT, selection = "none", editable = list(target = 'cell', disable = list(columns = c(0)))
    )})
  
  observeEvent(input$DT_out_cell_edit, {
    # data.frame rownames would need extra handling...
    if(input$DT_out_cell_edit$col > 0){
      rv$uiTable[input$DT_out_cell_edit$row, input$DT_out_cell_edit$col] <- input$DT_out_cell_edit$value
    }
  })
  
  observeEvent(input$save, {
    updateStore(session, name = "text1", input$text1)
    updateStore(session, name = "uiTable", rv$uiTable)
  }, ignoreInit = TRUE)
  
  observeEvent(input$clear, {
    # clear current user inputs:
    updateTextInput(session, inputId = "text1", value = "")
    replaceData(mydataTableProxy, data = mtcarsDT)
    
    # clear tracking table:
    rv$uiTable <- mtcarsDT
    
    # clear shinyStore:
    updateStore(session, name = "text1", value = "")
    updateStore(session, name = "uiTable", mtcarsDT)
  }, ignoreInit = TRUE)
  
  observeEvent(input$store$uiTable, {
    updateTextInput(session, inputId = "text1", value = input$store[["text1"]])
    replaceData(mydataTableProxy, data = as.data.frame(input$store$uiTable))
  })
  
}

shinyApp(ui, server)