在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給我們

這接近我們想要的。