I am using plot_click to draw points on a base R plot, for every point, a row is added to a data table containing the x/y coordinates for each point.

I added a button to the app that let users select rows on the table and delete them. When a row is deleted, the point on the plot is also deleted. However, the problem I have is that color of the remaining points is not maintained. I believe this may be due to the row IDs changing on the table and not updating the plot every time a row is removed?

I need the colors of the data points on the plot to remain consistent, instead of changing every time a row is removed.

Here is a minimal example. You can see how the colors behave randomly after users starts removing and adding rows to the table.

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"),
  uiOutput("input_color")
  
)


#server
server <- function(input, output) {
  
  
  #input for colors
  #create list courts
  output$input_color <- renderUI({
    
    pickerInput(
      inputId = "color",
      label = "Marker Color", 
      choices = c("white", "yellow", "black", "red", "green", "blue"),
      multiple = FALSE,
      selected = "black"
    )
    
  })
  
  
  #click inputs
  val <- reactiveValues(clickx = numeric(), clicky = numeric(), shape= 2)
  mytable <- reactive(
    data.frame(`Location X` = round(val$clickx,2), 
               `Location Y` = round(val$clicky,2))
  )
  
  #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$color <- c(val$color, if (input$color == "white") "white" 
                   else if (input$color == "yellow") "yellow"
                   else if (input$color == "black") "black"
                   else if (input$color == "red") "red"
                   else if (input$color == "green") "green"
                   else if (input$color == "blue") "blue"
                   else NULL)
    
  }) 
  
  #interactive plot
  output$plot <- renderPlot({
    par(bg = 'red')
    plot(c(-25, 25), c(-50, 50), type = "n", axes = T , ylab = "", xlab = "")
    points(val$clickx, val$clicky, cex = 2, pch=19, col = val$color)
  })
  
  #mytable
  output$mytable <- renderDT({
    datatable(mytable() %>%
                mutate(ID = row_number()) %>%
                arrange(desc(ID)) %>%
                select(ID, everything()),
              rownames= F)
  })
  # remove btn
  observeEvent(input$remove, {
    req(input$mytable_rows_selected)
    val$clickx <-  val$clickx[-input$mytable_rows_selected]
    val$clicky <-  val$clicky[-input$mytable_rows_selected]
  })
  
}

shinyApp(ui, server)

CodePudding user response：

It's lz100 again.

So there are several things

1. You forget to update the val$color in remove event.
2. That long else if is not needed.
3. You are right, it is related to your IDs. Your IDs are not unique. They refresh themselves every time you click or remove. You want some IDs that are unchanged no matter what actions you take.

Here is the working code

library(shiny)
library(tidyverse)
library(shinyWidgets)
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"),
    uiOutput("input_color")
    
)


#server
server <- function(input, output) {
    
    
    #input for colors
    #create list courts
    output$input_color <- renderUI({
        
        pickerInput(
            inputId = "color",
            label = "Marker Color", 
            choices = c("white", "yellow", "black", "red", "green", "blue"),
            multiple = FALSE,
            selected = "black"
        )
        
    })
    
    
    #click inputs
    val <- reactiveValues(
        clickx = numeric(), 
        clicky = numeric(), 
        color = character(),
        shape= 2, 
        id = numeric(), 
        id_total = 0
    )
    
    mytable <- reactive(
        data.frame(`Location X` = round(val$clickx,2), 
                   `Location Y` = round(val$clicky,2),
                   color = val$color,
                   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$color <- c(val$color, input$color)
        val$id_total <- val$id_total   1
        val$id <- c(val$id, val$id_total)
    }) 
    
    #interactive plot
    output$plot <- renderPlot({
        par(bg = 'red')
        plot(c(-25, 25), c(-50, 50), type = "n", axes = T , ylab = "", xlab = "")
        points(val$clickx, val$clicky, cex = 2, pch=19, col = val$color)
    })
    
    #mytable
    output$mytable <- renderDT({
        datatable(mytable() %>%
                      # mutate(ID = row_number()) %>%
                      arrange(desc(ID)) %>%
                      select(ID, everything()),
                  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$color <-  val$color[val$id %in% selected_ids]
        val$id <-  val$id[val$id %in% selected_ids]
    })
    
}

shinyApp(ui, server)