I plan to build a customized ACF and PACF plot for a simulated time series
ts <- arima.sim(n=5300,list(order=c(2,0,1), ar=c(0.4,0.3), ma=-0.2))
Below are the codes I wrote to produce the plot through ggplot2:
library(gridExtra)
theme_setting <- theme(
panel.background = element_blank(),
panel.grid.major.y = element_line(color="grey90", size=0.5),
panel.grid.major.x = element_blank(),
panel.border = element_rect(fill=NA, color="grey20"),
axis.text = element_text(family="Times"),
axis.title = element_text(family="Times"),
plot.title = element_text(size=10, hjust=0.5, family="Times"))
acf_ver_conf <- acf(ts, plot=FALSE)$acf %>%
as_tibble() %>% mutate(lags = 1:n()) %>%
ggplot(aes(x=lags, y = V1)) + scale_x_continuous(breaks=seq(0,41,4)) +
labs(y="Autocorrelations", x="Lag", title= "Time Series, ACF") +
geom_segment(aes(xend=lags, yend=0)) +geom_point() + theme_setting
pacf_ver_conf <- pacf(ts, main=NULL,plot=FALSE)$acf %>%
as_tibble() %>% mutate(lags = 1:n()) %>%
ggplot(aes(x=lags, y = V1)) +
geom_segment(aes(xend=lags, yend=0)) +geom_point() + theme_setting +
scale_x_continuous(breaks=seq(0,41,4))+
labs(y="Partial Autocorrelations", x="Lag", title= "Time Series, PACF")
grid.arrange(acf_ver_conf, pacf_ver_conf, ncol=2)
While this is exactly what I want, I am not sure how to produce the confidence intervals in acf(ts) and pacf(ts):
So, my question has two parts:
How to statistically derive the upper and lower bound of the confidence intervals for Autocorrelated Functions and Partial Autocorrelations in R?
How would you plot it onto the first graph? I was thinking about geom_ribbon but any additional idea will be appreciated!
This may work (the formula for the confidence limits are taken from here https://stats.stackexchange.com/questions/211628/how-is-the-confidence-interval-calculated-for-the-acf-function, may need some tweaking):
ts.acf <- acf(ts, plot=TRUE)
alpha <- 0.95
conf.lims <- c(-1,1)*qnorm((1 + alpha)/2)/sqrt(ts.acf$n.used)
ts.acf$acf %>%
as_tibble() %>% mutate(lags = 1:n()) %>%
ggplot(aes(x=lags, y = V1)) + scale_x_continuous(breaks=seq(0,41,4)) +
geom_hline(yintercept=conf.lims, lty=2, col='blue') +
labs(y="Autocorrelations", x="Lag", title= "Time Series, ACF") +
geom_segment(aes(xend=lags, yend=0)) +geom_point() + theme_setting
ts.pacf <- pacf(ts, main=NULL,plot=TRUE)
alpha <- 0.95
conf.lims <- c(-1,1)*qnorm((1 + alpha)/2)/sqrt(ts.pacf$n.used)
ts.pacf$acf %>%
as_tibble() %>% mutate(lags = 1:n()) %>%
ggplot(aes(x=lags, y = V1)) +
geom_segment(aes(xend=lags, yend=0)) +geom_point() + theme_setting +
scale_x_continuous(breaks=seq(0,41,4))+
geom_hline(yintercept=conf.lims, lty=2, col='blue') +
labs(y="Partial Autocorrelations", x="Lag", title= "Time Series, PACF")
Related
I have a plot of depth of fish individuals over time. The background represents the temperature, the grey dots is the raw depth data, and the black line is the geom_smooth line of raw data (image of plot is attached here). I used ggplot to make the graphs, but my x-axis (= date/time) is slightly moved to the right. I need the axis to be adjusted in the middle (standardized). This is my very long code for the plot:
tibble(y=c(-7:0)) %>%
expand_grid(TBRtemperature %>% select(`Date and Time (UTC)`, Temperature)) %>%
rename(dt="Date and Time (UTC)") %>%
filter(yday(dt)>136&yday(dt)<147) %>%
mutate(dt=with_tz(dt, "Europe/Oslo")) %>%
ggplot(aes(dt, y, fill=Temperature)) +
geom_tile() +
scale_fill_gradientn(colours = c("lightblue", "white", "red")) +
scale_x_datetime(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
geom_point(data=fbd_TBR %>% filter(yday(dt)>136&yday(dt)<147, n()>100), aes(dt, -Data/10, group=paste0(ID, Trial)), colour="grey50", alpha=0.2) +
geom_smooth(data=fbd_TBR %>% filter(yday(dt)>136&yday(dt)<147, n()>100), aes(dt, -Data/10, group=paste0(ID, Trial), colour=paste0(ID, sep=" - ", Weight)), colour="black") +
labs(y="Depth (m)", x=("Time (days)"), title = "Trial 2") +
facet_wrap(~paste(ID, sep = " - ", Weight)) +
theme_classic() +
theme(plot.title = element_text(face="bold"), strip.text = element_text(face = "bold"))
Anyone who knows how the axis can be adjusted?
I think specifying the range you want by adding this argument into the ggplot section should solve it
+coord_cartesian(xlim = c(1, 10),ylim = c(10,40))
I am making a plot for likeability of different ice cream flavours by school. I already have the code for making the plot, but I'm stuck on calculating and adding the error bars to the plot. I know summarise and geom_errorbar works, but I'm not sure how to calculate standard error with a long data format.
Here's reproducible code:
IDs <- seq(1,50)
IDs <- data.frame(rep(IDs, each = 5))
names(IDs)[1] <- "ID"
tastes <- c("Strawberry", "Vanilla", "Chocolate", "Matcha", "Sesame")
tastes <- data.frame(rep(tastes, times = 50))
#random numbers for schools
A <- runif(250, 1,5)
B <- runif(250, 1,5)
C <- runif(250, 1,5)
#merge
test <- cbind(IDs, tastes)
test <- cbind(test, A)
test <- cbind(test, B)
test <- cbind(test, C)
names(test)[2] <- "Flavour"
#make long
test_long <- melt(test,
id.vars = c("ID", "Flavour"))
#plot
plot <- ggplot(test_long) +
geom_bar(aes(x = Flavour,
y = value), stat="summary", fun=mean) +
scale_x_discrete(labels=c("C","M","S","S","V")) +
coord_cartesian(ylim=c(1,5)) +
facet_grid(. ~ variable) +
labs(title = "Likeability of Different Flavours by School") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
plot
Any ideas on how to calculate and add error bars for each bar in the plot? Thank you!
One possible solution could be using a new data.frame generated with summarise
library(dplyr)
summary_test <-
test_long %>%
group_by(Flavour, variable) %>%
summarise(mean = mean(value),
SE = sd(value) / sqrt(n()))
#plot
plot <- ggplot(summary_test, aes(x = Flavour, y = mean)) +
geom_errorbar(aes(ymin = mean - SE, ymax = mean + SE)) +
geom_bar(stat = "identity") +
scale_x_discrete(labels=c("C","M","S","S","V")) +
coord_cartesian(ylim=c(1,5)) +
facet_grid(. ~ variable) +
labs(title = "Likeability of Different Flavours by School") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
plot
I'm trying two combine to plots created with ggplot2 that have the same x axis into one figure. I basically followed the instructions found here: https://gist.github.com/tomhopper/faa24797bb44addeba79.
I modified the code to be as follows:
library(ggplot2)
library(grid)
library(dplyr)
library(lubridate)
df <- data.frame(DateTime = ymd("2010-07-01") + c(0:8760) * hours(2), series1 = rnorm(8761), series2 = rnorm(8761, 100))
df_1<- df %>% select(DateTime, series1) %>% na.omit()
df_2 <- df %>% select(DateTime, series2) %>% na.omit()
plot1 <- ggplot(df_1) +
geom_point(aes(x = DateTime, y = series1), size = 0.5, alpha = 0.75) +
labs(x="", y="Red dots / m") +
theme(axis.title.x = element_blank(), axis.text.x=element_blank())
plot2 <- ggplot(df_2) +
geom_point(aes(x = DateTime, y = series2), size = 0.5, alpha = 0.75) +
labs(x="", y="Blue drops / L") +
theme(axis.title.x = element_blank())
grid.newpage()
grid.draw(rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last"))
This gives me the following picture:
How can I remove the space between the plots? I tried to change the margins in each separate plot with theme(plot.margin = unit(c(-1,1.2,0,0), "cm")), but this gets lost when combining the plots in grid.draw.
I know that there are similar posts, but I cannot find any solution which works for my case. I would appreciate any hints on this!
You can follow the approach from this question to set the bottom margin of plot.margin as negative in the first/upper plot and the top margin of the plot.margin argument as negative in the second/lower plot. It might take some finessing of what negative values to use, but you should be able to find something that works for you!
library(ggplot2)
library(grid)
library(dplyr)
library(lubridate)
df <- data.frame(DateTime = ymd("2010-07-01") + c(0:8760) * hours(2), series1 = rnorm(8761), series2 = rnorm(8761, 100))
df_1<- df %>% select(DateTime, series1) %>% na.omit()
df_2 <- df %>% select(DateTime, series2) %>% na.omit()
plot1 <- ggplot(df_1) +
geom_point(aes(x = DateTime, y = series1), size = 0.5, alpha = 0.75) +
labs(x="", y="Red dots / m") +
theme(axis.title.x = element_blank(), axis.text.x=element_blank(),
plot.margin=unit(c(0.9,1,-0.175,1), "cm"))
plot2 <- ggplot(df_2) +
geom_point(aes(x = DateTime, y = series2), size = 0.5, alpha = 0.75) +
labs(x="", y="Blue drops / L") +
theme(axis.title.x = element_blank(),
plot.margin=unit(c(-0.175,1,0.9,1), "cm")
)
grid.newpage()
grid.draw(rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last"))
With the output:
For some reason I am getting two legends in my dot-whisker plot.
Plot produced by the below code:
The data are available here.
#first importing data
Q2a<-read.table("~/Q2a.txt", header=T)
# Optionally, read in data directly from figshare.
# Q2a <- read.table("https://ndownloader.figshare.com/files/13283882?private_link=ace5b44bc12394a7c46d", header=TRUE)
library(dplyr)
#splitting into female and male
F2female<-Q2a %>%
filter(sex=="F")
F2male<-Q2a %>%
filter(sex=="M")
library(lme4)
#Female models
ab_f2_f_LBS = lmer(LBS ~ ft + grid + (1|byear), data = subset(F2female))
ab_f2_f_surv = glmer.nb(age ~ ft + grid + (1|byear), data = subset(F2female), control=glmerControl(tol=1e-6,optimizer="bobyqa",optCtrl=list(maxfun=1e19)))
#Male models
ab_f2_m_LBS = lmer(LBS ~ ft + grid + (1|byear), data = subset(F2male))
ab_f2_m_surv = glmer.nb(age ~ ft + grid + (1|byear), data = subset(F2male), control=glmerControl(tol=1e-6,optimizer="bobyqa",optCtrl=list(maxfun=1e19)))
I only plot two of the variables (ft2 and gridSU) from each model.
ab_f2_f_LBS <- tidy(ab_f2_f_LBS) %>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_f_LBS")
ab_f2_m_LBS <- tidy(ab_f2_m_LBS) %>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_m_LBS")
ab_f2_f_surv <- tidy(ab_f2_f_surv)%>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_f_surv")
ab_f2_m_surv <- tidy(ab_f2_m_surv) %>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_m_surv")
tidy_mods <- bind_rows(ab_f2_f_LBS, ab_f2_m_LBS, ab_f2_f_surv, ab_f2_m_surv)
I am then ready to make a dot-whisker plot.
#required packages
library(dotwhisker)
library(broom)
dwplot(tidy_mods,
vline = geom_vline(xintercept = 0, colour = "black", linetype = 2),
conf.int=TRUE,
dodge_size=0.2, #space between the CI's
dot_args = list(aes(shape = model), size = 3), #changes shape of points and the size of the points
style="dotwhisker") %>% # plot line at zero _behind_ coefs
relabel_predictors(c(DamDisFate2= "Immigrant mothers",
gridSU = "Grid (SU)")) +
theme_classic() +
xlab("Coefficient estimate (+/- CI)") +
ylab("") +
scale_color_manual(values=c("#000000", "#666666", "#999999", "#CCCCCC"),
labels = c("Daughter LBS", "Son LBS", "Daughter longevity", "Son longevity"),
name = "First generation models, maternity known") +
theme(axis.title=element_text(size=15),
axis.text.x = element_text(size=15),
axis.text.y = element_text(size=15, angle=90, hjust=.5),
legend.position = c(0.7, 0.7),
legend.justification = c(0, 0),
legend.title=element_text(size=15),
legend.text=element_text(size=13),
legend.key = element_rect(size = 0),
legend.key.size = unit(0.5, "cm"))+
guides(colour = guide_legend(override.aes=list(shape=c(16,17,15,3)))) #changes shape of points in legend
I am encountering this problem:
As is obvious from the plot, I have two legends. One that is unmodified and one that is modified.
I can't find any short cut within the theme() function and the dwplot() package doesn't offer any solutions either.
How can I suppress the unmodified legend (bottom one) and only keep my modified legend (top one)?
Assuming this function uses ggplot, try adding shape="none" to your guides():
guides(colour = guide_legend(override.aes=list(shape=c(16,17,15,3))), shape="none")
I am trying to use facet_wrap to plot indvidual plots.
library(lme4)
library(dplyr)
library(tibble)
# Convert to tibble for better printing. Convert factors to strings
sleepstudy <- sleepstudy %>%
as_tibble() %>%
mutate(Subject = as.character(Subject))
xlab <- "Days of sleep deprivation"
ylab <- "Average reaction time (ms)"
ggplot(df_sleep) +
aes(x = Days, y = Reaction) +
stat_smooth(method = "lm", se = FALSE) +
# Put the points on top of lines
geom_point() +
facet_wrap("Subject") +
labs(x = xlab, y = ylab) +
theme(axis.text=element_text(size=0.02),
axis.title=element_text(size=0.02,face="bold"),
plot.title = element_text(size=0.02)) +
theme(strip.text.x = element_text(size = 8),
strip.background = element_rect(fill="lightblue", colour="black",size=0.2)) +
theme(strip.text.x = element_text(margin = margin(0.02, 0, 0.02, 0, "cm")))
What I want to do is to only visualise selected Subject using facet_wrap? At the moment,
it is plotting plots of all the Subject. How do I plot only for say subject 308`` and352`?
Thanks
You just want to filter your data before plotting
library(lme4)
library(dplyr)
library(tibble)
library(ggplot2)
# Convert to tibble for better printing. Convert factors to strings
sleepstudy <- sleepstudy %>%
as_tibble() %>%
mutate(Subject = as.character(Subject))
xlab <- "Days of sleep deprivation"
ylab <- "Average reaction time (ms)"
sleepstudy %>%
filter(Subject %in% c("308", "352")) %>%
ggplot(.) +
aes(x = Days, y = Reaction) +
stat_smooth(method = "lm", se = FALSE) +
# Put the points on top of lines
geom_point() +
facet_wrap("Subject") +
labs(x = xlab, y = ylab) +
theme(axis.text=element_text(size=0.02),
axis.title=element_text(size=0.02,face="bold"),
plot.title = element_text(size=0.02)) +
theme(strip.text.x = element_text(size = 8),
strip.background = element_rect(fill="lightblue", colour="black",size=0.2)) +
theme(strip.text.x = element_text(margin = margin(0.02, 0, 0.02, 0, "cm")))