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

Question

我正试图从R闪亮的flexdashboard编辑并保存对可编辑DT的更新，但无法从这里的10多个答案中找到解决方案，这些答案涉及反应逻辑、闪亮、flexdashard和可编辑DT。每个功能(渲染漂亮的DT、编辑、反应过滤(单独工作很好，但不能一起工作。

使用来自的指导https://github.com/rstudio/DT/pull/480(可以编辑表#480中的值(和https://github.com/rstudio/DT/issues/359(replaceData((不适用于闪亮的模块(我制作了这个可复制的示例，但在第一次编辑后它就冻结了。

有人能帮忙看看问题是什么吗？谢谢你抽出时间。

---
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

我今天遇到了同样的问题。我想我找到了解决办法。对不起，已经晚了两年。

因此，如果你将数据加载到闪亮的块之外，它很可能会阻止它被重写。闪亮的块将保存在您的环境中的数据上。

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)
})
}
)