СustomizeR以子图的形式绘制颜色

问题描述

我有一个数据框，可以通过以下代码获得：

x = data.frame(metrics=c("type1","type1","orders","mean","mean"),hr=c(6,7,8,6,8),actual=c(14,20,34,22,24,27,56,12,11,15,45,78,89,111,123,156),time_pos=c("today","yesterday","today","yesterday"))

基于previous question，我得出以下结论：

plot <- function(df) {

  subplotList <- list()
  for(metric in unique(df$metrics)){
    subplotList[[metric]] <- df[df$metrics == metric,] %>%
      plot_ly(
        x = ~ hr,y = ~ actual,name = ~ paste(metrics," - ",time_pos),colors = ~ time_pos,hoverinfo = "text",hovertemplate = paste(
          "<b>%{text}</b><br>","%{xaxis.title.text}: %{x:+.1f}<br>","%{yaxis.title.text}: %{y:+.1f}<br>","<extra></extra>"
        ),type = "scatter",mode = "lines+markers",marker = list(
          size = 7,color = "white",line = list(width = 1.5)
        ),width = 700,height = 620
      ) %>% layout(autosize = T,legend = list(font = list(size = 8)))
  }
  subplot(subplotList,nrows = length(subplotList),margin = 0.05)
}

和

plot(x)

给我这个：

如您所见，它为“度量”列中的每种类型的值构建了子图，并且在每个子图上，也为“时间”列（今天，昨天）中的每种值类型创建了两个散点图。但是它们是不同的颜色。如何使每个子图中的“今天”和“昨天”值具有相同的颜色？因此，图例中只有两种类型：“今天”和“昨天”，每个子图的标题分别为“ type1”，“ orders”，“ mean”

解决方法

可以这样实现：

1. 要在所有图中获得相同的颜色，请在time_pos上映射color而不是colors，即color = ~time_pos。使用colors，将调色板设置为默认颜色（否则会收到一堆警告）。

2. 棘手的部分是仅获取today和yesterday的两个图例条目。首先在time_pos上映射legendgroup，以便链接所有子图中的迹线。第二次使用showlegend仅显示其中一个图例，例如第一个指标。

3. 要在子图上添加标题，请在此post之后使用add_annotations

   library(plotly)
   
   plot <- function(df) {
     .pal <- RColorBrewer::brewer.pal(3,"Set2")[c(1,3)]
     subplotList <- list()
     for(metric in unique(df$metrics)){
       showlegend <- metric == unique(df$metrics)[1]
       subplotList[[metric]] <- df[df$metrics == metric,] %>%
         plot_ly(
           x = ~ hr,y = ~ actual,color = ~ time_pos,colors = .pal,legendgroup = ~time_pos,showlegend = showlegend,hoverinfo = "text",hovertemplate = paste(
             "<b>%{text}</b><br>","%{xaxis.title.text}: %{x:+.1f}<br>","%{yaxis.title.text}: %{y:+.1f}<br>","<extra></extra>"
           ),type = "scatter",mode = "lines+markers",marker = list(
             size = 7,color = "white",line = list(width = 1.5)
           ),width = 700,height = 620
         ) %>% 
         add_annotations(
           text = ~metrics,x = 0.5,y = 1,yref = "paper",xref = "paper",xanchor = "center",yanchor = "bottom",showarrow = FALSE,font = list(size = 15)
         ) %>% 
         layout(autosize = T,legend = list(font = list(size = 8)))
     }
     subplot(subplotList,nrows = length(subplotList),margin = 0.05)
   }
   
   plot(x)