在plotly :: subplot中使用文本注释

Question

我有想要绘制分布密度的数据。 数据来自三组，每组都有三个状态，每个状态都有一个概率，这些概率之和为1。

我正在尝试使用R的plotly来为每个组绘制概率的密度，按状态进行颜色编码，并为每个此类plotly添加一些文本annotation 。 最后，我尝试使用plotly::subplot组合所有这些plotly::subplot 。

这是生成数据和组图list的代码：

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)
})

请注意，我只是将legend添加到第一组中，因此它在最终分组图中仅出现一次（可能有一种更优雅的实现方式）。

这是我正在使用的plotly::subplot命令：

subplot(plot.list,nrows=3,shareX=T,shareY=T,titleX=T,titleY=T)

这使：

如您所见，文本annotation停留在第一个图的“顶部”，而不是每个单独图的顶部。

知道如何将每个annotation放置在其相应子图的顶部吗？

Answer 1

前言。 出于我不完全清楚的原因（但与运行subplot时批注的值如何缩放有关），批注似乎与垂直堆叠的子图不符。 要查看此信息，请在https://plot.ly/r/text-and-annotations/#subplot-annotations上运行MWE，但要进行更改

subplot(p1, p2, titleX = TRUE, titleY = TRUE)

至

subplot(p1, p2, titleX = TRUE, titleY = TRUE, nrows = 2)

在垂直堆叠的版本中，注释不在我们期望的位置。 为了获得所需的结果，需要subplot输出进行一些后处理。 现在，到您的主要问题。

---

首先，在add_annotations ，添加与每个subplot相对应的xref和yref参数。 在plot.list每个元素中，我还添加了一个附加元素y_anno来跟踪我们希望注解的位置（每个子图中密度的最大值）。

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)
})

现在，如果我们运行subplot(plot.list,nrows=3,shareX=T,shareY=T,titleX=T,titleY=T) ，则文本将出现在每个子图中，但不在顶部（由于这种现象在序言中描述）。 为了解决这个问题，我们可以subplot输出进行后处理：

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
  }
}

现在p给我们

这接近我们想要的。