rplotlywaterfall

Is there a way to change legend to show increasing and decreasing colors for waterfall plot using Plotly (r)?


I've plotted a waterfall chart/plot using plotly. I'm trying to change the legend so that it displays the increasing/decreasing colors (red/green) that I've set. Does anyone know how I would go about doing this? I'm try display only one legend for the entire figure rather than one legend for each subplot. Currently, what displays is the trace with a red and green box (as I've indicated in the picture).

enter image description here

Here is the data:

structure(list(Date = structure(c(1569888000, 1572566400, 1575158400, 
1577836800, 1580515200, 1583020800, 1585699200, 1588291200, 1590969600, 
1569888000, 1572566400, 1575158400, 1577836800, 1580515200, 1583020800, 
1585699200, 1588291200, 1590969600, 1569888000, 1572566400, 1575158400, 
1577836800, 1580515200, 1583020800, 1585699200, 1588291200, 1590969600
), class = c("POSIXct", "POSIXt"), tzone = "UTC"), Percent_change = c(-45, 
-50, -25, -30, -40, -35, -1, -5, -25, 30, 45, 50, -30, -40, -35, 
-1, -5, -25, 50, -45, -30, -15, -20, -35, -1, -5, -25), Toys = c("Toy 1", 
"Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", 
"Toy 1", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", 
"Toy 2", "Toy 2", "Toy 2", "Toy 3", "Toy 3", "Toy 3", "Toy 3", 
"Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -27L))  

Here is the code:

  percent <- function(x, digits = 2, format = "f", ...) {
  paste0(formatC(x, format = format, digits = digits, ...), "%")
}
      my_plot <- . %>% 
  plot_ly(x = ~Date, y = ~Percent_change, type = "waterfall",
          hoverinfo = "text",
          hovertext = ~paste("Date :", Date,
                             "<br> % Change:", percent(Percent_change)),
          increasing = list(marker = list(color = "red")),
          decreasing = list(marker = list(color = "green")),
          totals = list(marker = list(color = "blue")),
          textposition = "outside", legendgroup = "trace 1") %>%
  add_annotations(
    text = ~unique(Toys),
    x = 0.5,
    y = 1,
    yref = "paper",
    xref = "paper",
    xanchor = "middle",
    yanchor = "top",
    showarrow = FALSE,
    font = list(size = 15),
    yshift = 10
  )  %>%
  layout(yaxis = list(title = "% Change",
                      ticksuffix = "%"),
         xaxis = list(title = c("Date")),
         showlegend =T)


example_data %>%
  dplyr::filter(!is.na(Date)) %>% 
  group_by(Toys) %>%
  distinct()  %>%
  do(p = my_plot(.)) %>%
  subplot(nrows = 3, shareX = FALSE, titleY= TRUE, titleX= FALSE) 

I would like the legend to specifically look like this with the title "Trend" above:

enter image description here


Solution

  • We can create two initial traces representing the two legend items.

    After that we need to assign all increasing and decreasing traces into the legendgroups introduced with the initial traces and hide their legend items:

    library(plotly)
    library(dplyr)
    library(data.table)
    
    example_data <- structure(list( Date = structure(c(1569888000, 1572566400,
    1575158400, 1577836800, 1580515200, 1583020800, 1585699200, 1588291200,
    1590969600, 1569888000, 1572566400, 1575158400, 1577836800, 1580515200,
    1583020800, 1585699200, 1588291200, 1590969600, 1569888000, 1572566400,
    1575158400, 1577836800, 1580515200, 1583020800, 1585699200, 1588291200,
    1590969600), class = c("POSIXct",  "POSIXt"), tzone = "UTC"), Percent_change =
    c(-45, -50, -25, -30, -40, -35, -1, -5, -25, 30, 45, 50, -30, -40, -35, -1,
    -5, -25, 50, -45, -30, -15, -20, -35, -1, -5, -25), Toys = c("Toy 1", "Toy 1",
    "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 2", "Toy 2",
    "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 3",
    "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3")),
    class = c("tbl_df",  "tbl",  "data.frame"), row.names = c(NA, -27L))
    
    percent <- function(x, digits = 2, format = "f", ...) {
      paste0(formatC(x, format = format, digits = digits, ...), "%")
    }
    
    my_plot <- . %>%
      plot_ly(
        x = ~ Date[1],
        y = 0,
        type = "bar",
        name = "increasing",
        color = I("darkgreen"),
        legendgroup = "increasing",
        showlegend = ~ all(showlegend)
      ) %>%
      add_trace(
        x = ~ Date[1],
        y = 0,
        type = "bar",
        name = "decreasing",
        color = I("red"),
        legendgroup = "decreasing",
        showlegend = ~ all(showlegend)
      ) %>%
      add_trace(
        x = ~ Date,
        y = ~ Percent_change,
        type = "waterfall",
        # split = ~ legendgroup,
        hoverinfo = "text",
        hovertext = ~ paste("Date :", Date, "<br> % Change:", percent(Percent_change)),
        increasing = list(marker = list(color = "red")),
        decreasing = list(marker = list(color = "green")),
        totals = list(marker = list(color = "blue")),
        textposition = "outside",
        legendgroup = ~ legendgroup,
        showlegend = FALSE
      ) %>%
      add_annotations(
        text = ~ unique(Toys),
        x = 0.5,
        y = 1,
        yref = "paper",
        xref = "paper",
        xanchor = "middle",
        yanchor = "top",
        showarrow = FALSE,
        font = list(size = 15),
        yshift = 10
      )  %>%
      layout(yaxis = list(title = "% Change", ticksuffix = "%"),
             xaxis = list(title = c("Date")),
             legend = list(
               itemclick = FALSE,
               itemdoubleclick = FALSE,
               groupclick = FALSE
             ))
    
    example_data %>%
      dplyr::filter(!is.na(Date))  %>%
      mutate(legendgroup = case_when(
        Percent_change >= 0 ~ "increasing",
        Percent_change < 0 ~ "decreasing",
      )) %>%
      mutate(showlegend = data.table::rleid(Toys, legendgroup) %in% c(1, 2)) %>%
      group_by(Toys) %>%
      distinct() %>%
      do(p = my_plot(.)) %>%
      subplot(
        nrows = 3,
        shareX = FALSE,
        titleY = TRUE,
        titleX = FALSE
      )
    

    result

    PS: if you prefer to display your waterfall using separate traces for the increasing and decreasing parts use split = ~ legendgroup in the add_trace call. Furthermore you'll need to set itemclick etc. back to TRUE in the layout call for an interactive legend.