plotly.R icon indicating copy to clipboard operation
plotly.R copied to clipboard

Using Plotly event data with a key on a ggplotly object

Open jeffandcyrus opened this issue 2 years ago • 1 comments

I am using Plotly in an R Shiny dashboard with event data so a user can click on a visualization and the linked table will filter to show just that data observation. In the reprex below, I have a plot made in ggplot that I converted to a Plotly object using ggplotly. This works fine, but when identifying observations using pointNumber in the event data, it misidentifies the observation that was clicked on because the plot and the table have different numbers of observations.

Because of this, I'm trying to identify observations using a "key" argument, but no matter how I define the key, it does not appear as a column in the event data. When this plot is made using Plotly to begin with, eliminating ggplot entirely, it works fine and the key column does appear. However, the visualization I need to use is a phylogenetic tree that has proven impossible to visualize in Plotly, which is why I started it off in ggplot. I have searched extensively, but I can't find a way to make event data work with a key using a ggplot -> plotly object. Is there a way to make this work?

### Load data
data(mtcars)
mtcars$index <- c(1:32)
data <- mtcars


# Define UI
ui <- fluidPage(
  titlePanel("Dashboard"),
  tags$style('.container-fluid {
                             background-color: #e3f2fd;
              }'),
  fluidRow(
    
    column(6,
           h3("Scatterplot"),
           plotlyOutput("phylo_tree")),
    
    # Metadata
    column(12, h3("Metadata")),
    column(12, DT::dataTableOutput("data_table"))
    
  )
)

# Define server logic
server <- function(input, output) {
  
  
  output$phylo_tree <- renderPlotly({
    
    # Create a scatterplot using ggplot2
    scatterplot <- ggplot(mtcars, aes(x = mpg, y = hp, label = rownames(mtcars))) +
      geom_point() +
      geom_text(nudge_y = 5, nudge_x = 1, check_overlap = TRUE) +
      labs(title = "Scatterplot of mtcars Dataset",
           x = "Miles Per Gallon (mpg)",
           y = "Horsepower (hp)") +
      theme_minimal()
    
    scatterplot <- plotly::ggplotly(scatterplot, tooltip = "text", 
                                   source = "source1", key = ~index)
    
    # Collect data when a user clicks on a point
    event_register(scatterplot, event = "plotly_selected")
    
    
    scatterplot
  })
  
  
  output$data_table <- DT::renderDataTable({
    
    # Use click event data
    click_data <- event_data("plotly_click", source = "source1")
    
    observe({
      print(event_data("plotly_click", source = "source1"))
    })
    
    # Check if any points are clicked
    if (!is.null(click_data)) {
      # Filter data based on the clicked point
      data <- data[data$index %in% click_data$key,]

    }
    
    datatable(data, 
              rownames = FALSE, 
              filter = "top",
              extensions = "Buttons",  # Add download buttons
              options = list(scrollX = TRUE, dom = "Bfrtip", 
                             buttons = c("csv", "excel", "pdf"),
                             lengthMenu = list(c(10,25,50,-1),
                                               c(10,25,50,"All"))),
              selection = list(mode = "multiple", target = "row")) %>%
      formatStyle(names(data),lineHeight='80%') 
  })
  
  
}


Edit: I solved my own problem. The key needs to be specified in the aes() argument of the ggplot code. The following ggplot code should work with the above datatable code. Note that the id variable specified here should be some unique key identifier.

# Create a scatterplot using ggplot2
    scatterplot <- ggplot(mtcars, aes(x = mpg, y = hp, label = rownames(mtcars), key = id)) +
      geom_point() +
      geom_text(nudge_y = 5, nudge_x = 1, check_overlap = TRUE) +
      labs(title = "Scatterplot of mtcars Dataset",
           x = "Miles Per Gallon (mpg)",
           y = "Horsepower (hp)") +
      theme_minimal()

jeffandcyrus avatar Dec 21 '23 22:12 jeffandcyrus

Glad to hear you solved it. Feel free to close the issue.

asadow avatar Apr 20 '24 20:04 asadow