如何删除 table 中的一行并同步闪亮应用程序中的散点图 plot_click 事件

Question

我正在使用 plot_click 在基础 R 图上绘制点，对于每个点，都会向数据 table 添加一行，其中包含每个点的 x/y 坐标。

我在应用程序中添加了一个按钮，让用户可以在 table 上删除 select 行。删除一行时，图上的点也将被删除。但是，我遇到的问题是没有保留剩余点的颜色。我相信这可能是由于 table 上的行 ID 发生了变化，并且每次删除行时都没有更新图表？

我需要绘图上数据点的颜色保持一致，而不是每次删除一行时都更改。

这是一个最小的例子。您可以看到在用户开始向 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)

Answer 1

又是lz100

所以有几件事

您忘记更新删除事件中的 val$color。
不需要这么长的 else if。
你说的对，跟你的身份证有关。您的 ID 不是唯一的。每次您单击或删除时，它们都会自行刷新。你想要一些无论你采取什么行动都不会改变的ID。

这是工作代码

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)

如何删除 table 中的一行并同步闪亮应用程序中的散点图 plot_click 事件

How to remove a row in a table and synchronize a scatter plot plot_click event in shiny app

r

shiny