带有可编辑单元格的数据表的闪亮应用程序。用户从表中删除行后如何保存编辑的内容？

Question

我有一个应用程序，它使用plot_click 功能在图表上绘制点并创建一个表来跟踪每个点的坐标。作为应用程序的一部分，我有一个删除按钮，用户可以根据需要删除选定的行。如果删除一行，则绘图会更新。

我在表格中添加了一列可编辑的列，以便用户可以编写注释。我遇到的问题是，当我删除一行时，其他单元格上添加的注释也会消失。

我相信我必须使用 input$mytable_cell_edit 更新删除事件，并可能为单元格编辑创建另一个事件，但不知道如何执行此操作。

下面的示例代码

library(shiny)
library(tidyverse)
library(DT)


#UI
ui <- basicPage(
  column(width = 3, plotOutput("plot", click = "plot_click", width = "350px", height="700px")),
  column(width = 9, DTOutput("mytable")),
  actionButton("remove", "remove")
  
)


#server
server <- function(input, output) {
  
  
  #click inputs
  val <- reactiveValues(
    clickx = numeric(), 
    clicky = numeric(), 
    shape= 2, 
    id = numeric(),
    id_total = 0
  )
  
  mytable <- reactive(
    data.frame(`Location X` = round(val$clickx,2), 
               `Location Y` = round(val$clicky,2),
               ID = val$id)
  )
  
  #bind clicks
  observeEvent(input$plot_click, {
    val$clickx = c(val$clickx, input$plot_click$x)
    val$clicky = c(val$clicky, input$plot_click$y)
    val$id_total <- val$id_total + 1
    val$id <- c(val$id, val$id_total)
  }) 
  
  #interactive plot
  output$plot <- renderPlot({
    plot(c(-25, 25), c(-50, 50), type = "n", axes = T , ylab = "", xlab = "")
    points(val$clickx, val$clicky, cex = 2, pch=19, col = "black")
  })
  
  #mytable
  output$mytable <- renderDT({
    datatable(mytable() %>%
                mutate(Notes = "") %>%
                arrange(desc(ID)) %>%
                select(ID, everything()),
              editable = list(target = "cell", disable = list(columns = 0:2)),
              rownames= F)
  })
  # remove btn
  observeEvent(input$remove, {
    req(input$mytable_rows_selected)
    selected_ids <-  sort(val$id, TRUE)[-input$mytable_rows_selected]
    val$clickx <-  val$clickx[val$id %in% selected_ids]
    val$clicky <-  val$clicky[val$id %in% selected_ids]
    val$id <-  val$id[val$id %in% selected_ids]
  })
 
  
}

shinyApp(ui, server)

我尝试了类似的解决方案，但没有成功。

Answer 1

这似乎有效。抱歉我忘记了四舍五入。

library(shiny)
library(DT)

ui <- basicPage(
  br(),
  actionButton("remove", "remove", class = "btn-primary"),
  br(),
  fluidRow(
    column(
      width = 3, 
      plotOutput("plot", click = "plot_click", width = "100%", height = "700px")
    ),
    column(
      width = 9, 
      DTOutput("mytable")
    )
  )
)


callback <- c(
  '$("#remove").on("click", function(){',
  '  table.rows(".selected").remove().draw();',
  '});'
)

#server
server <- function(input, output, session) {

  mytable <- data.frame(
    ID           = integer(),
    `Location X` = numeric(),
    `Location Y` = numeric(),
    Notes        = character(),
    check.names = FALSE
  )
  
  ID <- reactiveVal(0L)
  
  Xcoords <- reactiveVal()
  Ycoords <- reactiveVal()
  
  #mytable
  output[["mytable"]] <- renderDT({
    datatable(
      mytable,
      rownames = FALSE,
      editable = list(target = "cell", disable = list(columns = c(0L, 1L, 2L))),
      callback = JS(callback)
    )
  }, server = FALSE)
  
  proxy <- dataTableProxy("mytable")
  
  #bind clicks
  observeEvent(input[["plot_click"]], {
    x <- input[["plot_click"]][["x"]]
    y <- input[["plot_click"]][["y"]]
    Xcoords(c(Xcoords(), x))
    Ycoords(c(Ycoords(), y))
    newRow <- as.data.frame(list(ID() + 1L, x, y, ""))
    ID(ID() + 1L)
    addRow(proxy, newRow, resetPaging = FALSE)
  }) 
  
  #interactive plot
  output[["plot"]] <- renderPlot({
    plot(c(-25, 25), c(-50, 50), type = "n", ylab = NA, xlab = NA)
    points(Xcoords(), Ycoords(), cex = 2, pch = 19, col = "black")
  })
  
  # remove btn
  observeEvent(input[["remove"]], {
    req(input[["mytable_rows_selected"]])
    indices <- input[["mytable_rows_selected"]]
    Xcoords(Xcoords()[-indices])
    Ycoords(Ycoords()[-indices])
  })
  
}

shinyApp(ui, server)