【发布时间】：2020-06-26 07:44:46
【问题描述】：
这是我几天前提出的一个问题的更新。我已经解决了这个问题并且非常接近解决方案，但需要一些帮助才能让我越过终点线。
我在下面提供了一个示例输入数据框 (data1) 和所需的结果 (result)，以显示我想要结束的位置。
我的实际数据集包括大约 1000 个样本，每个样本有大约 150 行 x-y 坐标数据，我需要绘制、检查、添加信息，然后提取这些数据以进行进一步分析。 到目前为止，我已经设置了一个闪亮的应用程序，它允许我使用单选按钮使用“站点”和“样本”标识符选择特定样本，然后绘制选定的数据。我还为修改后的数据表添加了一个下载按钮。
该应用程序使用brushedPoints 函数允许我选择绘图的一部分，然后在两个表中显示选定的点：i) 可编辑的数据表和 ii) 显示数据编辑的第二个数据表将导出的表。第二个数据表可能不是必需的，但它向我展示了如何/是否将编辑合并到将要导出的数据表中。
目前，当我突出显示数据点并在顶部表格中输入“移动”或“停留”列时，编辑无法显示在底部表格或下载的 csv 文件中。
欢迎所有建议。 感谢您的宝贵时间。
# data
site <- c('a','a','a','a','a','b','b','b','b','b')
sample <- c("1a", "1a", "1a", "1a", "1a","2b", "2b", "2b","2b", "2b")
x <- c(1, 2, 3, 4, 5, 6, 7, 8 , 9, 10)
y <- c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
move <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')
stay <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')
sub <- data.frame(site, sample, x, y, move, stay)
# example result
site <- c('a','a','a','a','a','b','b','b','b','b')
sample <- c("1a", "1a", "1a", "1a", "1a","2b", "2b", "2b","2b", "2b")
x <- c(1, 2, 3, 4, 5, 6, 7, 8 , 9, 10)
y <- c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
move <- c('na', 'yes', 'na', 'no', 'na', 'down', 'na', 'up', 'na', 'na')
stay <- c(1, 20, 'na', 'na', 50, 'na', 69, 'na', 'na', 77)
result <- data.frame(site, sample, x, y, move, stay)
#================================================================================================
ui <- fluidPage(
sidebarPanel(
downloadButton("download","Download"),
radioButtons("site", "Site",
choices = unique(sub$site)),
radioButtons("sample", "Sample",
choices = unique(sub$sample))),
mainPanel(
plotOutput("plot1", brush = "plot_brush"),
DTOutput("plot_brushed_points"),
verbatimTextOutput("acutal_data")
)
)
server <- function(input, output, session) {
# Change second radio button options based on first radio button
observeEvent(input$site,{
Choices = unique(sub$sample[sub$site == input$site])
updateRadioButtons(session, "sample", choices = Choices)
})
# Make data set reactive values
sub_react = reactiveValues(data = sub)
# Get data for plot
reactive_data <- reactive({
selected_sample = input$sample
filter(sub_react$data, sample == selected_sample)
})
# Make plot
output$plot1 <- renderPlot({
our_data <- reactive_data()
ggplot(our_data, aes(x = x, y = y)) +
geom_line(aes(), color = 'black') +
geom_point(aes(size = 5))+
geom_point(shape = 1 ,size = 5, colour = "black") +
xlim(0, 10) +
ylim(0, 100)
})
# Display rows of data highlighted in plot
dat <- reactive({
our_data <- reactive_data()
brushedPoints(our_data, input$plot_brush, xvar = "x", yvar = "y", allRows = FALSE)
})
# Render highlighted data in plot
output$plot_brushed_points = renderDT(dat(), selection = 'none', editable = TRUE)
# Show actual data frame to check edits are correct
output$acutal_data <- renderPrint({dat()})
# Transfer edits from top table to bottom table
##############################################
## I suspect this is where the problem lies ##
##############################################
proxy = dataTableProxy('plot_brushed_points')
observeEvent(input$plot_brushed_points_cell_edit, {
info = input$plot_brushed_points_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
sub_react$data[i, j] <- isolate(coerceValue(v, sub_react$data[i, j]))
replaceData(proxy, sub_react$data, resetPaging = FALSE)
})
# Download modified data table as a csv file
output$download <- downloadHandler(
filename = function() {
paste0("Modified_data.csv")
},
content = function(con) {
write.csv(sub_react$data, con, row.names = FALSE, na = "")
}
)
}
shinyApp(ui, server)
【问题讨论】：