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

Question

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

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

我知道编辑值的信息在input$DT_out_cell_edit ，但它不是单个值，因此updateStore函数不起作用。 我想过使用DT包中的dataTableProxy和replaceData ，但它们无法保留上次运行应用程序时的值。 最后，我尝试在本例中设置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)

Answer 1

请检查以下内容：

我使用reactiveValue uiTable来跟踪对数据表所做的更改。 单击保存按钮后，将使用updateStore保存data.frame 。

当一个新会话开始时， input$store$uiTable被监控变化。 如果表已更改，则通过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)