Second x axis in ggplotly with invisible second trace - r

Question

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'

Answer 1

I get it working by just adding:
add_markers(data = NULL, inherit = TRUE, xaxis = "x2")
And I did also set the tickfont size of your second axis to 11 to match the font size of your original axis.
Although it is working, sometimes changing the zoom (especially when clicking "autoscale") will mess up the scales of the x axes so that they are not in sync anymore. Probably the best option is to limit the available options in the icon bar.
Here is your edited code put into a running shiny app:
library(tidyverse)
library(plotly)
library(shiny)
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)
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,
tickfont = list(size = 11)) # I added this line
shinyApp(
ui = fluidPage(
plotlyOutput("plot")
),
server = function(input, output) {
output$plot <- renderPlotly({
ggplotly(p) %>%
add_markers(data = NULL, inherit = TRUE, xaxis = "x2") %>% # new line
layout(
xaxis = ax,
xaxis2 = ax2)
})
}
)
Update
Below is a running shiny app with the additional example code. Although it is showing a warning that
Warning: 'scatter' objects don't have these attributes: 'label'
the plot is displayed correctly with both x axes.
I assume that the plot not showing correctly is unrelated to the warning above.
library(boot)
library(tidyverse)
library(plotly)
library(shiny)
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))
shinyApp(
ui = fluidPage(
plotlyOutput("plot")
),
server = function(input, output) {
output$plot <- renderPlotly({
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)
)
})
}
)