R: How to modify the legend in plotly?-CodePudding

I have 3 numerical variables and plotting them via barchart in plot_ly. 'sale' and 'share' columns are visualized via bars, while 'cost' by red line. Now I want to customize legend a bit and add black border around cost in legend map (see expected outcome)

df <- data.frame (model  = c("A", "B", "C","D","E","F"),
                  share = c(12,20,15,9,60,20),
                  sale = c(16,25,18,14,67,28),
                  cost = c(14,19,28,24,57,28))

#set levels of model by cost
df$model <- factor(df$model, levels = arrange(df, desc(df$cost))$model)

library(tidyverse)

df_long <- df %>% 
  pivot_longer(
    cols = -model
  ) 


df_long %>% 
  filter(name != "cost") %>% 
  plot_ly(x = ~model, y = ~value, color = ~name, type = "bar", 
          customdata = ~name,  colors = c("blue", "gray"),
          hovertemplate = paste0("Model: %{x}<br>Value: %{y}<br>",
                                 "Name: %{customdata}<extra></extra>")) %>%
  add_lines(inherit = F, data = df, x = ~model, 
            y = ~cost, color = I("red"),
            name = "cost",
            hovertemplate = paste0("Model: %{x}<br>Value: %{y}<br>",
                                   "Name: cost<extra></extra>")) %>% 
  add_annotations(data = df, x = ~model, y = ~cost, text = ~cost,
                  bgcolor = "white", bordercolor = "black", 
                  xshift = 15, yshift = 15, showarrow = F) %>% 
  layout(barmode = "group")

output:

Expected output:

CodePudding user response：

This one was tricky! I know that Plotly doesn't have anything built-in to do this simply. I tried to work out using shapes to draw this box, but that doesn't work, because it puts the legend on top (so most of the box is hidden). I'm apparently more stubborn than Plotly though.

This answer requires the package htmlwidgets. I didn't change your plot other an assigning it to an object. I named your Plotly object pL for this answer.

The content for the onRender function:

or = ("function(el){
      costLeg = document.querySelectorAll('g.traces')[2];      /* third legend entry */
      cChW = costLeg.firstChild.getBoundingClientRect().width; /* text only */
      cR = costLeg.lastChild.getBoundingClientRect();          /*g trace space*/ 
      cR2 = costLeg.lastChild.outerHTML.split('\" ');
      cy = cR2[3].split('\"')[1];                              /* the y without padding*/
      cDf = cR.width - cChW - 14;                 /*legend width - text width - padding*/
      costLC = costLeg.lastChild.cloneNode(true); /* copy the current rect element */
      costLC.removeAttribute('pointer-events');   /* remove the pointer events */
      costLeg.removeAttribute('class');           /*stop refresh from changing it*/
      costLC.setAttribute('x', 3);                /* calc values   or minus padding */
      costLC.setAttribute('y', (cR.height - 6)/2 * -1); /* measure from center */
      costLC.setAttribute('width', cDf);
      costLC.setAttribute('height', cR.height - 6);
      costLC.setAttribute('style',
          'fill: rgb(0, 0, 0); fill-opacity: 0; stroke-width: 2px; stroke: black;');
      costLeg.insertBefore(costLC, costLeg.lastChild);
      }")

Call the plot and add the onRender function to draw the box.

pL %>% htmlwidgets::onRender(or)

By the way, this should scale with your plot, as well.