Question

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

我正在尝试使用R的{{1}}来绘制每个组的概率密度（按状态进行颜色编码），并向每个组中添加一些文本plotly这样的团体情节。最后，我尝试使用annotation组合所有这些组图。

以下是用于生成数据和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放置在其相应子图的顶部吗？

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中，添加与每个xref对应的yref和subplot自变量。在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给了我们

接近我们想要的。

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

1 个答案: