带有 datatable 和 editable 单元格的闪亮应用程序。如何在用户从table中删除行后保存编辑的内容?

Shiny app with datatable with editable cells. How to save the edited content after the user removes rows from the table?

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

我在我的 table 中添加了一个列,即 editable,因此用户可以写笔记。我遇到的问题是,当我删除一行时,添加在其他单元格上的注释也会消失。

我认为我必须使用输入 $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)

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

这似乎有效。对不起,我忘记四舍五入了。

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)