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

问题描述

我在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",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))或geom_density(aes(Duration))，则会得到以下信息：

此外，每个图块的图例看起来确实不整洁。我希望能够为每个单独的期间涂上颜色，并为单个图例显示所有三个期间的颜色（可能位于右侧）。有办法吗？

解决方法

最好使用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,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")

输出：