r - 如何使 x 轴限制之外的误差线环绕到 ggplot 中绘图的另一侧

Question

我对 R 相当陌生，并且已经广泛搜索了 StackOverflow 以寻找解决此问题的方法，但我很短。我目前正在绘制太阳熊的估计出生日期，我希望我的情节在 x 轴上只包含 2014 年 4 月 - 2015 年 3 月的月份。我的大部分数据都符合这个条件，但我有一个值，它有一个从 3 月开始到 5 月结束的误差条 (Figure 1) .当我绘制此图时，误差条要么消失，要么延伸到整个图 (Figure 2) .我想将它环绕起来，以便当误差条在图的右侧退出时，它会出现在 2014 年 4 月所在的左侧。特定的年份并不重要(这些值来自许多不同的年份)，但是我发现任意指定年份是最简单的方法，可以将它们全部放在一个在 x 轴上有一个年份的图上。任何帮助将不胜感激!
这就是我希望最终图形的样子 .
我的代码如下:

##Import Excel Data
require(xlsx)
require(modeest)
require(ggplot2)
require(ggpubr)
library(scales)

BirthDates300 <- read.xlsx("C:/Users/ZackA/OneDrive - Old Dominion University/frombox/ODU/Sun Bear Weight/Data/data_zd.xlsx", 7)

#Combine Day Month and Year into Date
BirthDates300$MinDate<-as.Date(with(BirthDates300,paste(MinYear,MinMonth,MinDay,sep="-")),"%Y-%m-%d")
BirthDates300$MeanDate<-as.Date(with(BirthDates300,paste(MeanYear,MeanMonth,MeanDay,sep="-")),"%Y-%m-%d")
BirthDates300$MaxDate<-as.Date(with(BirthDates300,paste(MaxYear,MaxMonth,MaxDay,sep="-")),"%Y-%m-%d")
BirthDates300$IndDate<-as.Date(with(BirthDates300,paste(IndYear,IndMonth,IndDay,sep="-")),"%Y-%m-%d")

#Remove unnecessary row 17
BirthDates300 <- BirthDates300[-c(17), ]

#Plotting Range of Birth Dates 300
BirthDatesRange300 <- ggplot()+
  geom_errorbar(data=BirthDates300, mapping=aes(x=MeanDate, xmin=MinDate, xmax=MaxDate, y=CRN), 
                width=0.4, size=1, color="black") +
  geom_point(data=BirthDates300, mapping=aes(x=MeanDate, y=CRN, shape=Sex,), size=4,) +
  geom_point(data=BirthDates300, mapping=aes(x=IndDate, y=CRN, shape=Sex), color="grey", size=4,)+
  labs(title="Sun Bear Estimated Birth Date", subtitle="Assuming 300g at birth")+
  scale_x_date(date_labels="%b",date_breaks  ="1 month",
               limits = as.Date(c('2014-03-25','2015-03-01')))+ 
  scale_y_discrete(limits= c("060-2004", "157-2012", "158-2012", "167-2012", "169-2013", 
                             "202-2017", "207-2019", " ", "002-1999", "058-2004", "073-2006", 
                             "076-2006", "077-2005", "080-2006", "081-2006", "083-2006",
                             "088-2006", "091-2006", "107-2007", "150-2010", "152-2011",
                             "159-2011", "161-2012", "163-2012", "171-2013", "172-2013",
                             "180-2014", "181-2014", "183-2014", "186-2015", "187-2015",
                             "193-2016", "196-2016", "204-2018"))+
  theme(plot.title = element_text(size=16, face="bold", hjust = 0.5),
        plot.subtitle=element_text(size=10, hjust=0.5),
        axis.ticks.y = element_blank(),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.x = element_text(face="bold", color="black", size=13, vjust=-0.01),
        axis.text.y = element_text(face="bold", color="black", size=10, angle=0),
        panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
        panel.background = element_blank(), axis.line = element_line(colour = "black"),
        panel.border = element_rect(colour = "black", fill=NA, size=0.5),
        legend.title = element_text(size=15),
        plot.margin = margin(10, 10, 15, 10))+
  geom_hline(yintercept=" ", linetype='dotted', col = 'grey', size=1.5)

BirthDatesRange300

Answer 1

@Brian 推荐的一种有点老套的方法在评论中是将所有数据复制到另一年。
以下是您可以使用 tidyr::complete 执行此操作的方法和 fill :

library(tidyverse)
TargetMinDate <- as.Date("2014-03-25")
TargetMaxDate <- as.Date("2015-03-01")

BirthDates300 %>%
  group_by(CRN, MeanYear) %>% #Group by individual and year
  complete(MeanYear = c(2014,2015)) %>% #Complete the year
  group_by(CRN) %>% #go back to grouping only by individual
  fill(MeanYear:Sex, .direction = "updown") %>% #Fill the other variables from the original row
  mutate(across(contains("Date"), #Fill in the missing date variables
                ~ case_when(is.na(.) & #is NA from the complete operation
                            (MinDate[!is.na(MinDate)][1] < TargetMinDate | #MinDate is less than the target MinDate
                            MaxDate[!is.na(MaxDate)][1] > TargetMaxDate) #or MaxDate is greater than the target MaxDate
                            ~ as.Date(str_replace(.[!is.na(.)][1],"20\\d{2}",as.character(MeanYear))), #Then replace the year with the year we filled earlier
                            TRUE ~ .))) -> BirthDates300Duplicate #Otherwise, no change, then assign to variable

从这里我们只需要将 xlimit 移动到 coord_cartesian并设置 clip = off :

ggplot()+
  geom_errorbar(data=BirthDates300Duplicate, mapping=aes(x=MeanDate, xmin=MinDate, xmax=MaxDate, y=CRN), 
                width=0.4, size=1, color="black") +
  geom_point(data=BirthDates300Duplicate, mapping=aes(x=MeanDate, y=CRN, shape=Sex,), size=4,) +
  geom_point(data=BirthDates300Duplicate, mapping=aes(x=IndDate, y=CRN, shape=Sex), color="grey", size=4,)+
  labs(title="Sun Bear Estimated Birth Date", subtitle="Assuming 300g at birth")+
  coord_cartesian(xlim = as.Date(c(TargetMinDate,TargetMaxDate))) +
  scale_x_date(date_labels="%b",date_breaks  ="1 month")+ 
  scale_y_discrete(limits= c("060-2004", "157-2012", "158-2012", "167-2012", "169-2013", 
                             "202-2017", "207-2019", " ", "002-1999", "058-2004", "073-2006", 
                             "076-2006", "077-2005", "080-2006", "081-2006", "083-2006",
                             "088-2006", "091-2006", "107-2007", "150-2010", "152-2011",
                             "159-2011", "161-2012", "163-2012", "171-2013", "172-2013",
                             "180-2014", "181-2014", "183-2014", "186-2015", "187-2015",
                             "193-2016", "196-2016", "204-2018"))+
  theme(plot.title = element_text(size=16, face="bold", hjust = 0.5),
        plot.subtitle=element_text(size=10, hjust=0.5),
        axis.ticks.y = element_blank(),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.x = element_text(face="bold", color="black", size=13, vjust=-0.01),
        axis.text.y = element_text(face="bold", color="black", size=10, angle=0),
        panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
        panel.background = element_blank(), axis.line = element_line(colour = "black"),
        panel.border = element_rect(colour = "black", fill=NA, size=0.5),
        legend.title = element_text(size=15),
        plot.margin = margin(10, 10, 15, 10))+
  geom_hline(yintercept=" ", linetype='dotted', col = 'grey', size=1.5)  

就像我怀疑你会一样，我对更强大的方法感兴趣。