I am trying to add a second x axis on a ggplotly plot, not to accommodate a second trace, but for better visualisation.
I have worked out that I do need to add a trace for it, but the question is how. The examples I have found to add simple, transparent traces are not working for my plot which has factors on the y-axis.
Please take it as given that for my purposes I need to use ggplotly and need the second axis. The example I am about to provide is just minimal, the real application has other requirements accommodated by ggplotly (as opposed to straight plotly or ggplot2). Imagine if there were 100 different iris species that people were scrolling through, and that the top axis provides a good guide at first. Using ggplot2, here is the example of what I would like to achieve with ggplotly:
library(tidyverse)
library(plotly)
dat <- iris %>%
group_by(Species) %>%
summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
count = n())
labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)
p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), y = meanSL)) +
geom_point() +
geom_hline(yintercept = 6, lty = 2) +
coord_flip() +
ggtitle("Means of sepal length by species") +
theme_classic()+
theme(axis.title.x=element_blank(),
axis.title.y=element_blank(),
axis.line.y = element_blank(),
plot.title = element_text(size = 10, hjust = 0.5))
p + scale_y_continuous(breaks = breaks, labels = labels, limits = limits, sec.axis = dup_axis(labels = labels_dup)) +
geom_text(aes(y = 4,label = paste0("n=",count)), size = 3)
and here is the output:
Here is a start to the ggplotly solution:
ax <- list(
side = "bottom",
showticklabels = TRUE,
range = limits,
tickmode = "array",
tickvals = breaks,
ticktext = labels)
ax2 <- list(
overlaying = "x",
side = "top",
showticklabels = TRUE,
range = limits,
tickmode = "array",
tickvals = breaks,
ticktext = labels_dup)
ggplotly(p) %>%
#<need a trace here e.g. add_lines, add_segment. It could either be transparent, or use the vertical line or count text in the plot as shown in the example> %>%
layout(
xaxis = ax,
xaxis2 = ax2)
Edit: Here is less minimal code that produces the warning when I use the suggested fix. I use geom_pointrange instead of stat_summary for reasons related to the hover text:
library(boot)
library(tidyverse)
library(plotly)
boot_sd <- function(x, fun=mean, R=1001) {
fun <- match.fun(fun)
bfoo <- function(data, idx) {
fun(data[idx])
}
b <- boot(x, bfoo, R=R)
sd(b$t)
}
#Summarise the data for use with geom_pointrange and add some hover text for use with plotly:
dat <- iris %>%
mutate(flower_colour = c(rep(c("blue", "purple"), 25), rep(c("blue", "white"), 25), rep(c("white", "purple"), 25))) %>%
group_by(Species) %>%
summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
countSL = n(),
meSL = qt(0.975, countSL-1) * boot_sd(Sepal.Length, mean, 1001),
lowerCI_SL = meanSL - meSL,
upperCI_SL = meanSL + meSL,
group = "Mean &\nConfidence Interval",
colours_in_species = paste0(sort(unique(flower_colour)), collapse = ",")) %>%
as.data.frame() %>%
mutate(colours_in_species = paste0("colours: ", colours_in_species))
#Some plotting variables
purple <- "#8f11e7"
plot_title_colour <- "#35373b"
axis_text_colour <- "#3c4042"
legend_text_colour <- "#3c4042"
annotation_colour <- "#3c4042"
labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)
p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), text = colours_in_species)) +
geom_text(aes(y = 4.2,label = paste0("n=",countSL)), color = annotation_colour, size = 3) +
geom_pointrange(aes(y = meanSL, ymin=lowerCI_SL, ymax=upperCI_SL,color = group, fill = group), size = 1) +
scale_fill_manual(values = "#f4a01f", name = "Mean &\nConfidence Interval") +
scale_color_manual(values = "#f4a01f", name = "Mean &\nConfidence Interval") +
geom_hline(yintercept = 5, colour = "dark grey", linetype = "dashed") +
geom_hline(yintercept = 6, colour = purple, linetype = "dashed") +
coord_flip() +
ggtitle("Means of sepal length by species") +
theme_classic()+
theme(axis.text.y=element_text(size=10, colour = axis_text_colour),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
axis.line.y = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(size = 12, hjust = 0, colour = plot_title_colour),
legend.justification=c("right", "top"),
legend.box.just = "center",
legend.position ="top",
legend.title.align = "left",
legend.text=element_text(size = 8, hjust = 0.5, colour = legend_text_colour),
legend.title=element_blank())
ax <- list(
side = "top",
showticklabels = TRUE,
range = limits,
tickmode = "array",
tickvals = breaks,
ticktext = labels_dup)
ay <- list(
side = "right")
ax2 <- list(
overlaying = "x",
side = "bottom",
showticklabels = TRUE,
range = limits,
tickmode = "array",
tickvals = breaks,
ticktext = labels_dup,
tickfont = list(size = 11))
ggplotly(p, tooltip = 'text') %>%
add_markers(data = NULL, inherit = TRUE, xaxis = "x2") %>%
layout(
xaxis = ax,
xaxis2 = ax2,
yaxis = ay,
legend = list(orientation = "v", itemclick = FALSE, x = 1.2, y = 1.04),
margin = list(t = 120, l = 60)
)
and the warning is this: Warning message: 'scatter' objects don't have these attributes: 'label' Valid attributes include: 'type', 'visible', 'showlegend', 'legendgroup', 'opacity', 'name', 'uid', 'ids', 'customdata', 'meta', 'selectedpoints', 'hoverinfo', 'hoverlabel', 'stream', 'transforms', 'uirevision', 'x', 'x0', 'dx', 'y', 'y0', 'dy', 'stackgroup', 'orientation', 'groupnorm', 'stackgaps', 'text', 'texttemplate', 'hovertext', 'mode', 'hoveron', 'hovertemplate', 'line', 'connectgaps', 'cliponaxis', 'fill', 'fillcolor', 'marker', 'selected', 'unselected', 'textposition', 'textfont', 'r', 't', 'error_x', 'error_y', 'xcalendar', 'ycalendar', 'xaxis', 'yaxis', 'idssrc', 'customdatasrc', 'metasrc', 'hoverinfosrc', 'xsrc', 'ysrc', 'textsrc', 'texttemplatesrc', 'hovertextsrc', 'hovertemplatesrc', 'textpositionsrc', 'rsrc', 'tsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
