Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to make error bars outside of x-axis limit wrap around to the other side of the plot in ggplot

Tags:

r

ggplot2

I am fairly new to R, and have extensively searched StackOverflow for a solution to this problem but am coming up short. I am currently plotting estimated birth dates for sun bears, and I want my plot to only have the months April 2014 - March 2015 on the x-axis. Most of my data fits in this fine, but I have a value that has an error bar that starts in March and ends in May (Figure 1). When I plot this, the error bar either disappears, or stretches across the entire plot (Figure 2). I would like to wrap it around so that when the error bar exits on the right hand side of the plot, it appears on the left hand side where April 2014 is. The specific year doesn't matter (these values are from lots of different years), but specifying year arbitrarily has been the easiest way I've found to get them all on one plot that has a single year on the x-axis. Any help would be greatly appreciated!

This is what I would like the final figure to look like (Figure 3).

My code is the following:

##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
like image 418
ConfusedPhDStudent Avatar asked Jul 01 '21 14:07

ConfusedPhDStudent


Video Answer


1 Answers

A somewhat hacky approach recommended by @Brian in the comments is to duplicate all of the data into the other year.

Here's how you might do that with tidyr::complete and 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

From here we just need to move the xlimit into coord_cartesian and set 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)  

enter image description here

Like I suspect you would be, I am interested in a more robust approach.

like image 56
Ian Campbell Avatar answered Oct 13 '22 12:10

Ian Campbell