r - 使用 ggplot2 和 purrr 创建密度图；基于组的密度线颜色

Question

我在 R Studio 中使用 ggplot2 和 purrr 的组合来循环数据框并生成密度图。这是一个模拟数据框，类似于我正在使用的结构：-

#load relevant libraries

library(ggplot2)
library(dplyr)
library(purrr)
library(gridExtra)

#mock dataframe
set.seed(123)
Duration<-floor(rnorm(1000, mean=200, sd=50))
DateTime<-seq.POSIXt(from = as.POSIXct("2020-08-01 01:00:00", tz = Sys.timezone()), length.out = 1000, by = "hours")
df<-cbind(Duration,DateTime)
df<-as.data.frame(df)
df$Duration<-as.integer(df$Duration)
df$DateTime<-seq.POSIXt(from = as.POSIXct("2020-08-01 01:00:00", tz = Sys.timezone()), 
                        length.out = 1000, by = "hours")#re-doing this to stop the annoying change back to numeric
df$WeekNumber<-isoweek(df$DateTime)
#create a "period" column
setDT(df)[WeekNumber>=31 & WeekNumber <=32, Period:="Period 1"]
df[WeekNumber>=33 & WeekNumber <=35, Period:="Period 2"]
df[WeekNumber>=36 & WeekNumber <=37, Period:="Period 3"]
df$Period<-factor(df$Period, levels = c("Period 1", "Period 2", "Period 3"))

这是使用 purrr 循环遍历数据框以生成每周密度图的代码：-

densplot<-df %>%
  group_by(WeekNumber) %>%
  summarise() %>%
  pull() %>% 
  # run map() instead of for()
  map(~{
    df %>%
      # filter for each value 
      filter(WeekNumber == .x) %>%
            # run unique density plot
      ggplot(aes(group=WeekNumber)) +
      geom_density(aes(Duration))+
      ggtitle(paste0("Week ",.x," duration"), subtitle = "Log10")+
      scale_x_log10()
  })

#call grid.arrange to create a faceted version of the plot
do.call(grid.arrange,densplot)

这给出了这个： -

我想要做的是用“周期”为密度线着色以帮助解释。单独使用 ggplot2 会很容易，但我想在我的 purrr 管道中使用它。但是，如果我指定ggplot(aes(group=WeekNumber, colour=Period))or geom_density(aes(Duration))，我会得到：-

另外，每个单独的情节都有一个图例，看起来确实很不整洁。我希望能够为每个单独的时期和一个显示所有三个时期颜色的单个图例着色（可能放在右侧）。有没有办法做到这一点？

Answer 1

最好使用facet_wrap()以避免颜色问题。这里是您选择的代码：

library(ggplot2)
library(dplyr)
#Code
df %>% mutate(WeekNumber=paste0("Week ",WeekNumber," duration")) %>%
  ggplot(aes(x=Duration,group=WeekNumber,color=Period)) +
  geom_density()+
  scale_x_log10()+
  facet_wrap(.~WeekNumber,scales='free')

输出：

更新：如果您想迭代，您可以通过df按期间拆分来调整列表策略。然后使用绘图和patchwork包的函数，您可以获得预期的绘图。作为补充说明，如果您希望使用不同的颜色，您可以通过在拆分之前在数据框中定义颜色来破解管道。我以实用的方式进行了操作，但如果存在更多句点，您可以使用调色板。这里的代码：

library(patchwork)
#Add Colors to df
dfcol <- data.frame(Period=unique(df$Period),color=c('blue','red','green'),stringsAsFactors = F)
#Add to df
df$Colors <- dfcol[match(df$Period,dfcol$Period),"color"]
#Approach 2
#Create a list
List <- split(df,df$WeekNumber)
#Plot function
myplot <- function(x)
{
  #Extract color
  mycol <- unique(x$Colors)
  #Plots
  p1 <- ggplot(x,aes(x=Duration,group=WeekNumber,color=Period)) +
    geom_density()+
    scale_x_log10()+
    scale_color_manual(values = mycol)+
    ggtitle(paste0("Week ",unique(x$WeekNumber)," duration"), subtitle = "Log10")+
    theme(legend.title = element_blank())
  return(p1)
}
#Apply
L1 <- lapply(List,myplot)
#Wrap plots
combined <- wrap_plots(L1,ncol = 3)
combined + plot_layout(guides = "collect")

输出：