R 闪亮的 flexdashboard -- 结合反应性元素、可编辑的 DT 数据表并保存到文件

Question

I am trying to edit and save updates to an editable DT from an R shiny flexdashboard, but unable to find resolution from the 10+ answers on here that address reactive logic, shiny, flexdashboard, and editable DT. Each function (rendering beautiful DT, editing, reactive filtering) works great on its own but NOT together.

Using guidance from https://github.com/rstudio/DT/pull/480 (Make it possible to edit values in table #480) and https://github.com/rstudio/DT/issues/359 (replaceData() not working with shiny modules) I made this reproducible example, but it freezes up after the first edit.

Can anyone help to see what the issue is? Thank you for your time.

---
title: "Editable DT Flexdashboard"
runtime: shiny
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

```{r global, include=FALSE}
# This block loads in packages and the data for this sample problem

library(DT)
library(tibble)
library(dplyr)
library(tidyr)
library(magrittr)
library(flexdashboard)
options(shiny.sanitize.errors=FALSE)

df <-
structure(list(Week = structure(c(17700, 17700, 17700, 17700, 
17700, 17700, 17707, 17707, 17707, 17707, 17707, 17707, 17714, 
17714, 17714, 17714, 17714, 17714, 17721, 17721, 17721, 17721, 
17721, 17721, 17728, 17728, 17728, 17728, 17728, 17728, 17735, 
17735, 17735, 17735, 17735, 17735, 17742, 17742, 17742, 17742, 
17742, 17742, 17749, 17749, 17749, 17749, 17749, 17749, 17756, 
17756, 17756, 17756, 17756, 17756), class = "Date"), Topic = c("Cooking", 
"Stamp Collecting", "Work", "Sales", "Stamp Repair", "Personal", 
"Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal", "Cooking", "Stamp Collecting", "Work", "Sales", "Stamp Repair", 
"Personal"), Percent = c("40", "40", "20", "0", "0", "0", "40", 
"30", "20", "5", "5", "0", "20", "50", "15", "5", "10", "0", 
"20", "40", "30", "5", "5", "0", "20", "50", "20", "0", "10", 
"0", "0", "40", "30", "20", "5", "5", "40", "40", "20", "0", 
"0", "0", "0", "40", "30", "20", "5", "5", "40", "40", "20", 
"0", "0", "0")), .Names = c("Week", "Topic", "Percent"), row.names = c(NA, 
-54L), class = c("tbl_df", "tbl", "data.frame"))
```

```{r, include = FALSE}
# This block helped previous DTs not be invisible, and I am afraid to take it out
DT::datatable(data.frame(x=1))
```

Sidebar {.sidebar}
=====================================

## Steps:
1. Filter DT by input$Topic. Pick "Stamp".
2. Edit filtered table on the screen -- make at least two edits on first page, one edit on second.
3. Save updated dataframe as XLS or CSV.

```{r}
selectInput("Topic", label = "Topic:", 
     choices = c("ALL", "Stamp", "Cooking", "Work", "Personal") )
```


Main Tab Title
===================================== 

Row {.tabset} 
-------------------------------------

### Editable Table

```{r echo=FALSE}
library(tibble)
library(DT)
library(dplyr)
library(magrittr)
library(ggplot2)

# make a copy of the data frame for use within the reactive
# (helps prevent accidentally overwriting df when there are multiple code chunks)
this.df <- df

# Filter the data frame so that the results can be presented in the DT
x <- reactive({
  if (input$Topic == "Stamp") {
       this.df %>% filter(grepl("stamp", Topic, ignore.case=TRUE)) 
  } else {
     if (input$Topic != "ALL") {
        this.df %>% filter(Topic %in% input$Topic)
     } else {
        this.df
     }
  }
})

# Store the data frame produced by the reactive x() to x1
output$x1 = renderDT(x(), selection="none", rownames=F, editable=T)

# Here is the code from Part 4 of https://github.com/rstudio/DT/pull/480:
proxy <- dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
  info = input$x1_cell_edit
      str(info)
      i = info$row
      j = info$col + 1  # column index offset by 1
      v = info$value
  x[i, j] <<- DT::coerceValue(v, x[i, j])
  replaceData(proxy, x, resetPaging=FALSE, rownames=FALSE)
})

DTOutput("x1")
```

Answer 1

I had the same issue today. I think I found a solution. Sorry it's two years late.

So if you load the data in outside of the shiny block it'll obv keep it from being re-written. The shiny block will save over the data in your environment.

source_data <- iris

shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('dt_table')
  ),
  server = function(input, output, session) {
    
    reactive_values <- reactiveValues(source_data = NULL)
    
    
    observe({
      source_data$Date <- Sys.time() + seq_len(nrow(source_data))
      reactive_values$source_data <- source_data
    })
    
    output$dt_table <- DT::renderDataTable(
      reactive_values$source_data,
      editable = TRUE,
      filter = "top",
      selection = 'none'
      # rownames = FALSE
    )

    proxy <- dataTableProxy('dt_table')
    observeEvent(input$dt_table_cell_edit, {
      info = input$dt_table_cell_edit
      str(info)
      i <- info$row
      j <- info$col
      v <- info$value
      reactive_values$source_data[i, j] <<- DT:::coerceValue(v, reactive_values$source_data[i, j])
      source_data[i, j] <<- DT:::coerceValue(v, reactive_values$source_data[i, j])
      # replaceData(proxy, source_data, resetPaging = FALSE, rownames = FALSE)
    })
  }
)