Search code examples
rggplot2plotlydata-visualization

How to customize barchart in plotly R?


On barchart: 'sale' and 'share' variables are visualized via bars, while 'cost' by a red line. Now I want to drop/remove this red line and keep only numbers into boxes and add corresponding variable in the legend map. Moreover I want to add average value of 'share' as a horizontal line on the Y axis

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")

enter image description here


Solution

  • Actually, this is a lot easier than you might think. Instead of I('red') for the color, this can be changed to I('transparent'). Now the box by cost looks a bit obnoxious. It would probably be better if it looked like the boxes next to sale and share.

    As far as the horizontal line, I've added it. I don't know if you wanted it labeled, a specific color...only that you want this line. So that's what I've added. I opted to use red since it sticks out.

    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("transparent"),
                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",
             shapes = list(type = "line", x0 = 0, x1 = 1, xref = "paper",
                           y0 = mean(df$share), y1 = mean(df$share),
                           line = list(color = "red"),
                           name = "Average Share")) -> pL
    
    or = ("function(el){
          costLeg = el.querySelectorAll('g.traces')[2];    /* third legend entry */
          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', 15);                       /* starting point of box */
          costLC.setAttribute('y', -5);          /* 12 from middle; account for stroke */
          costLC.setAttribute('width', 11);                  /* 12; account for stroke */
          costLC.setAttribute('height', 10);     /* 12 from middle; account for stroke */
          costLC.setAttribute('style',
              'fill: rgb(0, 0, 0); fill-opacity: 0; stroke-width: 2px; stroke: black;');
          costLeg.insertBefore(costLC, costLeg.lastChild);
          }")
    
    pL %>% htmlwidgets::onRender(or)
    

    enter image description here

    This was updated

    The code was changed from document.querySelectorAll to el.querySelectorAll in the JS.