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

Question

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

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

我知道编辑值的信息在 中input$DT_out_cell_edit，但它不是单个值，因此该updateStore功能不起作用。我考虑过使用包中的dataTableProxy和，但它们无法保留应用程序上次运行时的值。最后，我尝试按照本示例进行设置，但它无法记录编辑后的值。replaceDataDTstateSave = 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

请检查以下内容：

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

当新会话开始时input$store$uiTable，将监视更改。如果表发生更改，则会通过 进行更新replaceData。

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

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

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)