与patchwork结合时，将geom_point数据与geom_col数据对齐

Question

我正在努力创建两个图形和合并成一个单一的图形使用补丁。X轴是日期，顶部的图形是geom_line/geom_point图形，底部的图形是使用geom_col创建的。当组合时，我想让顶部图形中的点与底部图形中的列的中心对齐。

我希望b/c x轴跨越相同的日期，点将与列的中心对齐。在几次尝试中，我都无法将列上方的点居中。生成的图形(和代码)如下所示。

​

​

library(patchwork)


nn<-15
p1data = tibble(date=ymd('2021-01-01') + days(0:(nn-1)), values=floor(runif(nn, 5.0, 75)))

p2data <- tibble(initdate = ymd('2021-01-01')+days(0:(nn-1)), data=runif(nn,4,10))

# set up a tibble to shade in every other day
shade <- tibble(min=ymd('2021-01-01 00:00')+days(0:20),max=lead(min))
# Remove every other row
toDelete <- seq(1,dim(shade)[1],by=2)
shade <- shade[-toDelete,]

plot_limits = c(ymd('2021-01-01'),ymd('2021-01-16'))

# Orginal Attempt 
p1 <- p1data %>% 
  ggplot() + 
  geom_rect(data=shade, aes(xmin=min,xmax=max,ymin=-Inf,ymax=Inf),fill='grey80' ) + 
  geom_line(aes(x=date,y=values)) + 
  geom_point(aes(x=date,y=values),color='red',size=3) +
  scale_x_date(expand=c(0,0),
                   date_breaks = '1 days',
                   date_labels = '%b-%d',
                   limits=plot_limits) +
  labs(title='two plots combined') + 
  theme_bw() + 
  theme(plot.title=element_text(hjust=0.5), 
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.x=element_blank())
  

p2 <- p2data %>%  
  ggplot() + 
  geom_col(aes(x=initdate,y=data, fill=data)) + 
  scale_x_date(expand=c(0,0),date_breaks = '1 days',date_labels = '%b-%d') +
  theme_bw() + 
  theme(plot.title=element_blank(),
        axis.title.x=element_blank(),
        axis.text.x=element_text(angle=0),
        legend.direction = "horizontal", 
        legend.position = "bottom",
        legend.key.width=unit(1.25,"cm"),
        legend.key.height=unit(.25,"cm"),
        legend.box = "vertical",
        legend.box.background = element_blank(),
        legend.title = element_text(face = "bold"),
        legend.spacing = unit(1,"cm"),
        legend.justification = "center",
        legend.margin = margin(0.,0.,0.,0., unit="cm"),
        legend.background = element_blank(),
        plot.margin = margin(0, 0, 0, 0, "cm")
  )

p1/p2

有没有其他方法可以在顶部图表中将每天的点居中，而在底部图表中将列居中？

Answer 1

在准备这个问题时，我能够开发出一个解决方案。解决方案是对顶部图形使用日期时间格式，而不仅仅是日期。然后，可以将与数据关联的日期时间设置为YYYY-MM-DD 12:00。然后在一天的中间绘制数据，而不是在每天开始的时候绘制。

生成的图形为：

​

实现它的代码是：

# The solution that works
# Specify the dates in datetime format and use the hours to center the data in the day. 

# The shade data for daily shades must be in datetime asd well.
# set up a tibble to shade in every other day
shade_dtm <- tibble(min=ymd_hm('2021-01-01 00:00')+days(0:20),max=as_datetime(lead(min)))
# Remove every other row
toDelete <- seq(1,dim(shade_dtm)[1],by=2)
shade_dtm <- shade_dtm[-toDelete,]

# create data
p1data_dtm = tibble(date=ymd_hm('2021-01-01 12:00') + days(0:(nn-1)), values=floor(runif(nn, 5.0, 75)))

plot_limits_dtm = c(ymd_hm('2021-01-01 00:00'),ymd_hm('2021-01-16 00:00'))

p1 <- p1data_dtm %>% 
      ggplot() + 
      geom_rect(data=shade_dtm, aes(xmin=min,xmax=max,ymin=-Inf,ymax=Inf),fill='grey80' ) + 
      geom_line(aes(x=date,y=values)) + 
      geom_point(aes(x=date,y=values),color='red',size=3) +
      scale_x_datetime(expand=c(0,0),
                       date_breaks = '1 days',
                       date_labels = '%b-%d',
                       limits=plot_limits_dtm) +
      labs(title='two plots combined: data aligned') + 
      theme_bw() + 
      theme(plot.title=element_text(hjust=0.5), 
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.x=element_blank())


p2 <- p2data %>%  
      ggplot() + 
      geom_col(aes(x=initdate,y=data, fill=data)) + 
      scale_x_date(expand=c(0,0),date_breaks = '1 days',date_labels = '%b-%d') +
      theme_bw() + 
      theme(plot.title=element_blank(),
        axis.title.x=element_blank(),
        axis.text.x=element_text(angle=0),
        legend.direction = "horizontal", 
        legend.position = "bottom",
        legend.key.width=unit(1.25,"cm"),
        legend.key.height=unit(.25,"cm"),
        legend.box = "vertical",
        legend.box.background = element_blank(),
        legend.title = element_text(face = "bold"),
        legend.spacing = unit(1,"cm"),
        legend.justification = "center",
        legend.margin = margin(0.,0.,0.,0., unit="cm"),
        legend.background = element_blank(),
        plot.margin = margin(0, 0, 0, 0, "cm")
  )

p1/p2