如何使x轴限制之外的误差线环绕到ggplot中绘图的另一侧
我对 R 相当陌生,并且已经广泛搜索了 StackOverflow 以寻找解决此问题的方法,但我很短。我目前正在绘制太阳熊的估计出生日期,并且我希望我的情节在 x 轴上仅包含 2014 年 4 月至 2015 年 3 月的月份。我的大部分数据都符合这个条件,但我有一个值,它有一个从 3 月开始到 5 月结束的误差条(图 1)。当我绘制此图时,误差条要么消失,要么延伸到整个图(图 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
回答
@Brian在评论中推荐的一种有点老套的方法是将所有数据复制到另一年。
以下是您可以如何使用tidyr::completeand做到这一点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],"20d{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)
就像我怀疑你会一样,我对更强大的方法感兴趣。