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

user_10082579 0
Viewed 352

I have an app that uses plot_click functionality to draw points on a graph and create a table to track the coordinates of each point. As part of the app I have a remove button which lets users remove the selected rows if needed. If a row is removed then the plot is updated.

I added a column to my table that is editable, so users can write notes. The problem I have is that when I remove a row, the notes added on other cells also disappears.

I believe I have to update the remove event with input$mytable_cell_edit and probably create another event for cell edit but not sure how to to do this.

Sample code below

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)

I tried a similar solution to this but didn't work.

dt shiny datatables r
1 Answers

This seems to work. Sorry I forgot the rounding.

enter image description here

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)
user_11001070
Related