CODEWITHSUNDEEP
r
Christian
Christian

Reputation: 11

Shiny / Plotly: Update plot with labels of only selected points

Using R Shiny and plotly I created a interactive scatter plot.

How can I modify my code to interactively label only the points which were selected by the user?

Example plot

Thank you so much for your help! All the best, Christian

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)

Upvotes: 1

Views: 1464

Answers (1)

Tom
Tom

Reputation: 592

Below is a possible solution. I use a reactive function to "label" selected points. I wasn't sure how exactly you want to display the IDs for selected points. The code adds the ID as text when a point is selected. Also, I add some jitter to move the IDs away from the points.

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)

Upvotes: 2

Related Questions