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).
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:
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
)
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.