如何在 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)