Using text annotations with plotly::subplot - r

Question

I have data I'd like to plot the distribution density of. The data are from three groups, where for each there are three states, each with a probability, and these probabilities sum to 1.
I'm trying to use R's plotly to plot, for each group, the density of the probabilities, color coded by state, and add some text annotation to each such group plot. Finally I'm trying to combine all of these group plots using plotly::subplot.
Here's the code to generate the data and a list of group plots:
library(dplyr)
library(reshape2)
library(plotly)
set.seed(1)
plot.list <- lapply(1:3,function(g){
if(g == 1){
show.legend <- T
} else{
show.legend <- F
}
df <- data.frame(id=LETTERS,t(sapply(1:length(LETTERS),function(x){
probs <- runif(3,0,1)
return(probs/sum(probs))
}))) %>% dplyr::rename(S1=X1,S2=X2,S3=X3) %>%
reshape2::melt() %>% dplyr::rename(state=variable,probability=value)
df$state <- factor(df$state,levels=c("S1","S2","S3"))
density.df <- do.call(rbind,lapply(levels(df$state),function(s){
dens <- density(dplyr::filter(df,state == s)$probability)
return(data.frame(x=dens$x,y=dens$y,state=s,stringsAsFactors=F))
}))
density.df$state <- factor(density.df$state,levels=levels(df$state))
dens.plot <- plot_ly(x=~density.df$x,y=~density.df$y,type='scatter',mode='lines',color=~density.df$state,showlegend=show.legend) %>%
layout(xaxis=list(title="Probability",zeroline=F),yaxis=list(title="Count",zeroline=F)) %>%
add_annotations(x=0.75,y="top",text=paste0("text: ",g))
if(show.legend) dens.plot <- dens.plot %>% add_annotations(text="State",xref="paper",yref="paper",x=1.02,xanchor="left",y=1.02,yanchor="top",legendtitle=T,showarrow=F)
return(dens.plot)
})
Note that I'm only adding the legend to the first group so it appears only once in the final grouped plot (there's probably a more elegant way of achieving that).
And here's the plotly::subplot command I'm using:
subplot(plot.list,nrows=3,shareX=T,shareY=T,titleX=T,titleY=T)
Which gives:
As you can see the text annotation is stuck at "top" of the first plot rather than at the top of each individual plot.
Any idea how do I get each annotation to be located at the top of its corresponding sub-plot?

Answer 1

Preamble. For reasons that are not entirely obvious to me (but relating to how values for annotations are scaled when running subplot), annotations seem to go awry with vertically stacked subplots. To see this, run the MWE at https://plot.ly/r/text-and-annotations/#subplot-annotations, but change
subplot(p1, p2, titleX = TRUE, titleY = TRUE)
to
subplot(p1, p2, titleX = TRUE, titleY = TRUE, nrows = 2)
In the vertically stacked version, the annotations are not where we would expect them to be. To achieve your desired outcome would require some post-processing of the subplot output. Now, on to your main question.
First, in add_annotations, add xref and yref arguments that correspond to each subplot. In each element of plot.list, I also add an additional element y_anno to keep track of where we would like the annotation to go (at the maximum value of the densities in each subplot).
plot.list <- lapply(1:3,function(g){
if(g == 1){
show.legend <- T
} else{
show.legend <- F
}
df <- data.frame(id=LETTERS,t(sapply(1:length(LETTERS),function(x){
probs <- runif(3,0,1)
return(probs/sum(probs))
}))) %>% dplyr::rename(S1=X1,S2=X2,S3=X3) %>%
reshape2::melt() %>% dplyr::rename(state=variable,probability=value)
df$state <- factor(df$state,levels=c("S1","S2","S3"))
density.df <- do.call(rbind,lapply(levels(df$state),function(s){
dens <- density(dplyr::filter(df,state == s)$probability)
return(data.frame(x=dens$x,y=dens$y,state=s,stringsAsFactors=F))
}))
density.df$state <- factor(density.df$state,levels=levels(df$state))
dens.plot <- plot_ly(x=~density.df$x,
y=~density.df$y,
type='scatter',
mode='lines',
color=~density.df$state,
showlegend=show.legend) %>%
layout(xaxis=list(title="Probability",zeroline=F),yaxis=list(title="Count",zeroline=F)) %>%
add_annotations(x = 0.75,
y = max(density.df$y),
text = paste0("text: ", g),
xref = paste0("x", g), # add this
yref = paste0("y", g), # add this
ax = 0,
ay = 0)
if(show.legend) dens.plot <- dens.plot %>% add_annotations(text="State",xref="paper",yref="paper",x=1.02,xanchor="left",y=1.02,yanchor="top",legendtitle=T,showarrow=F)
dens.plot$y_anno <- max(density.df$y) # add this
return(dens.plot)
})
Now if we run subplot(plot.list,nrows=3,shareX=T,shareY=T,titleX=T,titleY=T), the text will be in each subplot, but not at the top (due to the phenomenon I described in the preamble). To fix this, we can post-process the subplot output:
p <- subplot(plot.list, nrows = 3,shareX = T,shareY = T,titleX = T,titleY = T)
for (i in seq_along(plot.list)) {
for (j in seq_along(p$x$layout$annotations)) {
if (p$x$layout$annotations[[j]]$yref == paste0("y", i))
p$x$layout$annotations[[j]]$y <- plot.list[[i]]$y_anno
}
}
Now p gives us
which is close to what we want.