Shiny / Plotly: обновление графика с метками только выбранных точек

Question

Используя R Shiny и плотно, я создал интерактивный точечный график.

Как я могу изменить свой код, чтобы интерактивно маркировать только точки, которые были выбраны пользователем?

Примерсюжет

Большое вам спасибо за помощь!Всего наилучшего, Кристиан

library(plotly)
library(shiny)
library(dplyr)

data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
  mutate(ID = row_number())

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("hover"),
  verbatimTextOutput("click"),
  verbatimTextOutput("brush"),
  verbatimTextOutput("zoom"))

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

  output$plot <- renderPlotly({
    p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
      geom_point()
    ggplotly(p) %>% layout(dragmode = "select")
  })
}

shinyApp(ui, server)

Answer 1

Ниже приведено возможное решение.Я использую реактивную функцию, чтобы «пометить» выбранные точки.Я не был уверен, как именно вы хотите отобразить идентификаторы для выбранных точек.Код добавляет идентификатор в виде текста, когда точка выбрана.Кроме того, я добавляю немного дрожания, чтобы убрать идентификаторы от точек.

library(plotly)
library(shiny)
library(dplyr)

data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
  mutate(ID = row_number())

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("hover"),
  verbatimTextOutput("click"),
  verbatimTextOutput("brush"),
  verbatimTextOutput("zoom"))

server <- function(input, output, session) {
  output$plot <- renderPlotly({
    data <- get_data()
    p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
      geom_point() + geom_text(data=subset(data, show_id),aes(X1,X2,label=ID), position = position_jitter(width = 20,height = 20))
    ggplotly(p, source = "subset") %>% layout(dragmode = "select")
  })

  get_data <- reactive({
    event.data <- event_data("plotly_selected", source = "subset")
    data <- data %>% mutate(show_id = FALSE)
    if (!is.null(event.data)) {
      data$show_id[event.data$pointNumber + 1] <- TRUE
    }
    data
  })
}

shinyApp(ui, server)