r - Shiny update the clicked point to highlight it

Question

Here is a working example of extracting the on-click event. I would like to ask you if there is a way to update the clicked point with either increase in size or highlight it etc.,?

library(shiny)
library(plotly)

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

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

    nms <- row.names(mtcars)

    output$plot <- renderPlotly({
        p <- ggplot(mtcars, aes(x = mpg, y = wt, col = as.factor(cyl), key = nms)) + 
           geom_point()
        ggplotly(p)

    })

    output$click <- renderPrint({
        d <- event_data("plotly_click")
        if (is.null(d)) "Click events appear here (double-click to clear)" 
        else cat("Selected point associated with Car: ", d$key)
    })

}

shinyApp(ui, server)

I have searched SO and other appropriate sources for finding a solution to the below question, but could not find one.

Update:

• This solution works better for this toy plot. But, my original use case contains 50+ levels for the variable of interest and there are high chances that Magenta or any other color would already be present. Also, it takes a considerable amount of time to change the color.
• Is there any way to increase the size of the clicked point to differentiate it from 100s of nearby points?

A related question to change the shape of the clicked point has been asked here.

Answer 1

You could add Plotly's events to your Shiny app with htmlwidget's onrender function.

ggplotly(p) %>% onRender(javascript)

An array of colors is passed to the restyle function. The selected point (pointNumber) is colored magenta while the others get the color from the legend. You could do the same thing with the marker size, marker symbol is a bit more tricky because Plotly does not accept arrays here.

function(el, x){
  el.on('plotly_click', function(data) {
    colors = [];
    var base_color = document.getElementsByClassName('legendpoints')[data.points[0].curveNumber].getElementsByTagName('path')[0].style['stroke']
    for (var i = 0; i < data.points[0].data.x.length; i += 1) {
      colors.push(base_color)
    };
    colors[data.points[0].pointNumber] = '#FF00FF';
    Plotly.restyle(el, 
                   {'marker':{color: colors}}, 
                   [data.points[0].curveNumber]
                  );

  });
}

---

library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("plot")
)

javascript <- "
function(el, x){
  el.on('plotly_click', function(data) {
    colors = [];

    var base_color = document.getElementsByClassName('legendpoints')[data.points[0].curveNumber].getElementsByTagName('path')[0].style['stroke']
    for (var i = 0; i < data.points[0].data.x.length; i += 1) {
      colors.push(base_color)
    };
    colors[data.points[0].pointNumber] = '#FF00FF';
    Plotly.restyle(el, 
                   {'marker':{color: colors}}, 
                   [data.points[0].curveNumber]
                  );
    //make sure all the other traces get back their original color
    for (i = 0; i < document.getElementsByClassName('plotly')[0].data.length; i += 1) {
      if (i != data.points[0].curveNumber) {
        colors = [];
        base_color = document.getElementsByClassName('legendpoints')[i].getElementsByTagName('path')[0].style['stroke'];
        for (var p = 0; p < document.getElementsByClassName('plotly')[0].data[i].x.length; p += 1) {
          colors.push(base_color);
        }
        Plotly.restyle(el, 
                       {'marker':{color: colors}}, 
                       [i]);
      }
    };
  });
}"
server <- function(input, output, session) {

  nms <- row.names(mtcars)

  output$plot <- renderPlotly({
    p <- ggplot(mtcars, aes(x = mpg, y = wt, col = as.factor(cyl), key = nms)) + 
      geom_point()
    ggplotly(p) %>% onRender(javascript)

  })
}

shinyApp(ui, server)

---

Some explanations:

• Plotly's events, e.g. plotly_click pass some information (data in this case) in the event function
• data.points contains the points for which the event was triggered
• in this case, we only have one point data.points[0] where pointNumber is the index of the original array and curveNumber is the trace number.
• Plotly stores all the input data in the div where the plot is drawn
• We can access it via document.getElementsByClassName('plotly')[0].data
• The legend can be accessed via document.getElementsByClassName('legendpoints')[i] where i is the index of the legend
• ggplotly or plot_ly return htmlwidgets
• Javascript or HTML code can be added with any of the htmlwidget functions, e.g. onrender in this case