rshinyplotlyhtmlwidgetsstacked-bar-chart

Adding custom modebar button to allow functionality of a third hovermode by color

This is hopefully my final question for this plot. I received help twice previously, both of which worked in standalone plotly graphs, but my plotly object being present in the context of a shiny app presented other issues.

There were two solutions presented by Kat: here.

  1. The first fix with the HTML button caused the plot to add a button each time a shiny input was changed, so that was not a good fix.
  2. The second solution with the plotly button works great, but seems to have issues when cycling through the different hover options. The "hover by color" option would get stuck on only one of the colors and no longer move with the mouse.

Hoping to have found the solution for my use case, but need help with the JavaScript required for the custom event handler to replace the function {hovermode = 'x'} for "compare by color on hover" that I have currently.

Essentially I want to have hover by color functionality as an option with the new custom modebar buttons.

Data:

library(shiny)
library(tidyverse)
library(plotly)
library(bslib)
library(htmlwidgets)

dat <- data.frame(group1=(rep(letters[1:4], each=5)), 
           group2=rep(LETTERS[1:5], times=4),
           pct = c(rep(.2, times=5), 
                   c(.1, .1, .1, .3, .4), 
                   c(.2, .2, .2, .3, .1),
                   c(.3, .1, .2, .2, .2))
)

creating custom buttons:

closest <- list(
  name = "Show closest data on hover",
  icon = list(
    width = 1792,
    height = 1792,
    path = "M1203 544q0 13-10 23l-393 393 393 393q10 10 10 23t-10 23l-50 50q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l466-466q10-10 23-10t23 10l50 50q10 10 10 23z",
    transform = 'matrix(1 0 0 -1 0 1792)'
    ),
  click = htmlwidgets::JS(
    "function(gd) {
       Plotly.relayout(gd, {hovermode: 'closest'});
    }"
  )
)

colorcompare <- list(
  name = "Compare by color on hover",
  icon = list(
    width = 1792,
    height = 1792,
    path = "M1011 1376q0 13-10 23l-50 50q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l466-466q10-10 23-10t23 10l50 50q10 10 10 23t-10 23l-393 393 393 393q10 10 10 23zm384 0q0 13-10 23l-50 50q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l466-466q10-10 23-10t23 10l50 50q10 10 10 23t-10 23l-393 393 393 393q10 10 10 23z",
    transform = 'matrix(1 0 0 -1 0 1792)'
    ),
  click = htmlwidgets::JS(
    "function(gd) {
      Plotly.relayout(gd, {hovermode: 'x'});
    }"
  )
)

ycompare <- list(
  name = "Compare y data on hover",
  icon = list(
    width = 1792,
    height = 1792,
    path = "M1395 864q0 13-10 23l-466 466q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l50-50q10-10 23-10t23 10l393 393 393-393q10-10 23-10t23 10l50 50q10 10 10 23zm0-384q0 13-10 23l-466 466q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l50-50q10-10 23-10t23 10l393 393 393-393q10-10 23-10t23 10l50 50q10 10 10 23z",
    transform = 'matrix(1 0 0 -1 0 1792)'
    ),
  click = htmlwidgets::JS(
    "function(gd) {
      Plotly.relayout(gd, {hovermode: 'y'});
    }"
  )
)

and lastly, the plot:

plot <- dat %>%
  plot_ly() %>%
  add_bars(x = ~pct, y = ~group1,  color = ~group2,
           split = ~group2, customdata = ~group2,
           hovertemplate = paste0("%{x:.2f%}<br>", "<extra>%{customdata}</extra>")) %>% 
  layout(yaxis = list(title = 'Group 1', autorange = 'reversed', categoryorder = 'trace'),
         xaxis = list(title = 'Percent', tickformat = ".0%"),
         barmode = 'stack', hovermode = 'y', legend = list(traceorder = "normal")) %>%
  config(displaylogo = FALSE, modeBarButtonsToAdd = list(closest, colorcompare, ycompare),
         modeBarButtonsToRemove = list('hoverCompareCartesian','hoverClosestCartesian')) 

plot
Solution

  • I'm not sure how this might impact whatever else you have in your Shiny app-- however, without Shiny, this will work.

    This adds a class name to the body and then whenever you hover checks whether the class indicates the need for compare by color or not.

    The click functions

    closest:

      click = htmlwidgets::JS(
    "function(gd) {
      document.querySelector('body').classList.replace('byColor', 'no');
      Plotly.relayout(gd, {hovermode: 'closest'});
    }"
  )

    colorcompare:

      click = htmlwidgets::JS(
    "function(gd) {
      document.querySelector('body').classList.replace('no', 'byColor');
      Plotly.relayout(gd, {hovermode: 'closest'});
    }"
  )

    and ycompare:

      click = htmlwidgets::JS(
    "function(gd) {
      document.querySelector('body').classList.replace('byColor', 'no');
      Plotly.relayout(gd, {hovermode: 'y'});
    }"
  )

    And finally to get the data for the colorcompare hover and onRender call that needs to go with your plot:

      onRender(
    "function(el, x) {
      document.querySelector('body').classList.add('no');
      el.on('plotly_hover', function(d) {
        if(document.querySelector('body').classList.contains('byColor')) {
          tellMe = d.points[0].pointNumber;      /* changes by color */
          gimme = d.points[0].curveNumber;       /* stays the same by color */
          let xlen = el.data[0].x.length;        /* number of stacked bars */
          let thatsIt = [];
          for(i = 0; i < xlen; i++) {            /* make a hover for each bar */
            thatsIt.push({curveNumber: gimme, pointNumber: i})
          }
          Plotly.Fx.hover(el.id, thatsIt);
        }
      });
    }")

    graph