ggplot2: x axis breaks doesn't work with 7 days breaks - r

I'm trying to figure it out why this function for x axis breaks works perfectly for 2 to 6 days breaks, but gives me an error when I change to 7 days (Error: breaks and labels must have the same length). Thank you
Data Frame
library(tidyverse)
df <- data.frame(date = seq(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"))
df$counts <-sample(seq(from = 20, to = 50, by = 5), size = 365, replace = TRUE)
df<- df %>%
mutate(date = as.Date(date),
counts = as.numeric(counts))
Code
breaks_daily = seq(from = min(df$date), to = max(df$date), by = "1 day")
# Then make the 7 days interval labels
labels_7_days = format(seq(from = min(df$date), to = max(df$date), by = "7 days"), "%b-%d")
labels_final = c(sapply(labels_7_days, function(x) {
c(x, rep("", 6))
}))
#
if ((length(breaks_daily) %% 7) == 0) {
labels_final <- labels_final
} else {
labels_final<- labels_final[-length(labels_final)]
}
myplot <- ggplot(df,
aes(y = counts, x = date)) +
geom_bar(stat = "identity", position = "dodge", fill = "#99CCFF", width=1) +
labs(x="Date", y="Quantity of Fruits") +
scale_x_date(labels = labels_final, breaks = breaks_daily, expand=c(0,0)) +
scale_y_continuous(limits = c(0, 70),
breaks = seq(0, 70, 10),
expand = c(0, 0)) +
ggtitle(paste0("Figure 2: Fruits Example" )) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, size = 35),
axis.text.y = element_text(size = 35),
axis.text = element_text(size = 35),
axis.title = element_text(size = 40, face="bold"),
axis.title.y = element_text(vjust = -2),
axis.title.x = element_text(vjust = -1),
axis.ticks.length = unit(.5, "cm"))
myplot

Not a direct answer to your question, but why don't you just use the inbuilt functionality? Sometimes it is not necessary to reinvent the wheel... ?
library(tidyverse)
df <- data.frame(date = seq(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"))
df$counts <-sample(seq(from = 20, to = 50, by = 5), size = 365, replace = TRUE)
ggplot(df, aes(y = counts, x = date)) +
geom_col() +
scale_x_date(date_breaks = "1 week",date_labels = "%b %d")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
update
Here how to keep the ticks in-between (although I don't think your visualisation gains a lot with it)
You need to bring the two vectors to the same length. When using your label creator, you are creating six empty spaces for each week until the maximum (and including it!), then of course making "too many labels". Just subset the vector by using only the length of your breaks.
P.S. geom_col is identical to geom_bar(stat = "identity") , and in your example you don't need position = position_dodge, as you have no group defined. This argument only makes sense when you are dodging by a group.
library(tidyverse)
df <- data.frame(date = seq(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"))
df$counts <-sample(seq(from = 20, to = 50, by = 5), size = 365, replace = TRUE)
breaks_daily <- seq(from = min(df$date), to = max(df$date), by = "1 day")
labels_7_days <- format(seq(from = min(df$date), to = max(df$date), by = "7 days"), "%b-%d")
labels_final <- c(sapply(labels_7_days, function(x) {
c(x, rep("", 6))
})) [1:length(breaks_daily)] #that is the crucial bit
ggplot(df, aes(y = counts, x = date)) +
geom_col(fill = "#99CCFF", width=1) +
labs(x="Date", y="Quantity of Fruits") +
scale_x_date(labels = labels_final, breaks = breaks_daily, expand=c(0,0)) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
Created on 2020-05-30 by the reprex package (v0.3.0)

Related

Add extra tick where vertical line crosses x-axis

I have below ggplot
library(ggplot2)
library(quantmod)
dat = data.frame(val = 1:20, qtr = as.yearqtr(seq(as.Date('2000-01-01'), length.out = 20, by = '3 months')))
ggplot(data = dat) +
geom_line(aes(x = qtr, y = val)) +
geom_vline(xintercept = as.yearqtr(as.Date('2003-04-01')))
I want to add one extra tick in x-axis where my vertical line crosses the x-axis. The corresponding tick label will also be manual i.e. 'Sep : 2003-04-01'. Is there any function available in ggplot to achieve this?
Thanks for your help.
You could define your bespoke date breaks as a separate vector.
And the labels as a matching text vector including the bespoke text for the x intercept tick.
Adjustments to the axis text for legibility.
library(ggplot2)
library(quantmod)
intercept_date <- as.yearqtr(as.Date('2003-04-01'))
x_breaks <- c(as.yearqtr(seq(as.Date('2000-01-01'), length.out = 5, by = '12 months')), intercept_date)
x_labels <- c(as.character(as.yearqtr(seq(as.Date('2000-01-01'), length.out = 5, by = '12 months'))), "Sep : 2003-04-01")
ggplot(data = dat) +
geom_line(aes(x = qtr, y = val)) +
geom_vline(xintercept = intercept_date)+
scale_x_yearqtr(breaks = x_breaks,
labels = x_labels)+
theme(axis.text.x = element_text(angle = 30, hjust = 1))
Created on 2022-10-16 with reprex v2.0.2
Option 2
In response to comment: intercept breaks and labels defined within scale_x_yearqtr:
ggplot(data = dat) +
geom_line(aes(x = qtr, y = val)) +
geom_vline(xintercept = as.yearqtr(as.Date('2003-04-01')))+
scale_x_yearqtr(breaks = c(as.yearqtr(seq(as.Date('2000-01-01'), length.out = 5, by = '12 months')), as.yearqtr(as.Date('2003-04-01'))),
labels = c(as.character(as.yearqtr(seq(as.Date('2000-01-01'), length.out = 5, by = '12 months'))), "Sep : 2003-04-01"))+
theme(axis.text.x = element_text(angle = 30, hjust = 1))

where to pass argument to radiate margin labels of a polar heatmap

This question builds on from here:
Drawing a polar heatmap
> dput(names.d)
c("0050773", "0050774", "0050775", "0050776", "0050777", "0050778",
"0050779", "0050780", "0050781", "0050782", "0050783", "0050784",
"0050785", "0050786", "0050787", "0050788", "0050789", "0050790",
"0050808", "0050809", "0050810", "0050811", "0050812", "0050813",
"0050814", "0050818", "0050819", "0050820", "0050821", "0050822"
)
Based on this, I have come up with the following code:
set.seed(20220913)
arr <- matrix(runif(15*30), nrow = 30)
dff <- as.data.frame(arr)
names(dff) <- paste(sample(letters, replace = F), sample(letters, replace = F), sep = " ")[1:15]
library(tidyverse)
dff %>%
mutate(Site = seq(nrow(.))) %>%
pivot_longer(-Site, names_to = 'Species', values_to = 'Abundance') %>%
mutate(yval = match(Species, colnames(dff))) %>%
ggplot(aes(Site, yval, fill = Abundance)) +
geom_tile(color = "black") +
geom_text(aes(label = colnames(dff)), hjust = 1.1, size = 3,
data = data.frame(Site = 31.5, yval = 1:15, Abundance = 1)) +
coord_polar() +
scale_y_continuous(limits = c(-5, 15.5)) +
scale_x_continuous(limits = c(0.5, 31.5), breaks = 1:30, labels = names.d,
name = 'Breeding site') +
scale_fill_gradientn(colors = colorRampPalette(RColorBrewer::brewer.pal(name = "YlOrRd", n = 9))(25), values = 0:1, labels = scales::percent)+
theme_void(base_size = 16) +
theme(axis.text.x = element_text(size = 12),
axis.title.x = element_text())
which gives me the following figure:
Which is great, but I would like the labels on the rim of the figure to radiate out (or be tangent, for that matter). So, I wrote the angles as:
ang <- 1:30/31.5*360
However, I can not see where to pass this argument. Looking around, it would normally be in the aes function, but there the labels are for the y-axis in the figure (before being changed to the polar coordinates), and what I am wanting rotated should be in the x-axis. So, how do I do this? Thanks for any suggestions!
You can add this in the axis.text.x = element_text() :
ang <- 90 - (1:30/31.5*360)
dff %>%
mutate(Site = seq(nrow(.))) %>%
pivot_longer(-Site, names_to = 'Species', values_to = 'Abundance') %>%
mutate(yval = match(Species, colnames(dff))) %>%
ggplot(aes(Site, yval, fill = Abundance)) +
geom_tile(color = "black") +
geom_text(aes(label = colnames(dff)), hjust = 1.1, size = 3,
data = data.frame(Site = 31.5, yval = 1:15, Abundance = 1)) +
coord_polar() +
scale_y_continuous(limits = c(-5, 15.5)) +
scale_x_continuous(limits = c(0.5, 31.5), breaks = 1:30, labels = names.d,
name = 'Breeding site') +
scale_fill_gradientn(colors = colorRampPalette(RColorBrewer::brewer.pal(name = "YlOrRd", n = 9))(25), values = 0:1, labels = scales::percent)+
theme_void(base_size = 16) +
theme(axis.text.x = element_text(size = 12, angle = ang),
axis.title.x = element_text())

label end of lines outside of plot area

I am trying to replicate this figure from the Financial Times.
Here is a gist with the data. I'm struggling to label the end of the lines because I run out of room in the plot. I found a few ways to expand the limits of the plot area, but this is not ideal because the gridlines extend as well.
library(tidyverse)
library(ggrepel)
covid %>%
ggplot(aes(x = date, y = deaths_roll7_100k, color = Province_State)) +
geom_line() +
scale_y_continuous(breaks = seq(0, 2.4, .2)) +
scale_x_date(breaks = seq.Date(from=as.Date('2020-09-01'),
to=as.Date('2021-07-12'),
by="month"),
labels = function(x) if_else(month(x) == 9 | month(x) == 1,
paste(month(x, label = TRUE),
"\n", year(x)),
paste(month(x, label = TRUE))),
limits = as.Date(c("2020-09-01", "2021-11-01"))) +
geom_text_repel(aes(label = label),
segment.alpha = 0,
hjust = 0,
direction="y",
na.rm = TRUE,
xlim = as.Date(c("2021-08-01", "2021-11-01")))
An alternative to ggrepel is to use geom_text and turn "clipping" off (similar to this question/answer), e.g.
covid %>%
ggplot(aes(x = date, y = deaths_roll7_100k, color = Province_State)) +
geom_line() +
scale_y_continuous(breaks = seq(0, 2.4, .2)) +
scale_x_date(breaks = seq.Date(from=as.Date('2020-09-01'),
to=as.Date('2021-07-12'),
by="month"),
date_labels = "%b\n%Y",
limits = as.Date(c("2020-09-01", "2021-07-01"))) +
geom_text(data = . %>% filter(date == max(date)),
aes(color = Province_State, x = as.Date(Inf),
y = deaths_roll7_100k),
hjust = 0, size = 4, vjust = 0.7,
label = c("Arizona\n", "North Carolina")) +
coord_cartesian(expand = FALSE, clip = "off")
--
With some more tweaks and the Financial-Times/ftplottools R theme you can get the plot looking pretty similar to the Financial Times figure, e.g.
library(tidyverse)
#remotes::install_github("Financial-Times/ftplottools")
library(ftplottools)
library(extrafont)
#font_import()
#fonts()
covid %>%
ggplot() +
geom_line(aes(x = date, y = deaths_roll7_100k,
group = Province_State, color = Province_State)) +
geom_text(data = . %>% filter(date == max(date)),
aes(color = Province_State, x = as.Date(Inf),
y = deaths_roll7_100k),
hjust = 0, size = 4, vjust = 0.7,
label = c("Arizona\n", "North Carolina")) +
coord_cartesian(expand = FALSE, clip = "off") +
ft_theme(base_family = "Arimo for Powerline") +
theme(plot.margin = unit(c(1,6,1,1), "lines"),
legend.position = "none",
plot.background = element_rect(fill = "#FFF1E6"),
axis.title = element_blank(),
panel.grid.major.x = element_line(colour = "gray75"),
plot.caption = element_text(size = 8, color = "gray50")) +
scale_color_manual(values = c("#E85D8C", "#0D5696")) +
scale_x_date(breaks = seq.Date(from = as.Date('2020-09-01'),
to = as.Date('2021-07-01'),
by = "1 month"),
limits = as.Date(c("2020-09-01", "2021-07-01")),
date_labels = "%b\n%Y") +
scale_y_continuous(breaks = seq(from = 0, to = 2.4, by = 0.2)) +
labs(title = "New deaths attributed to Covid-19 in North Carolina and Arizona",
subtitle = "Seven-day rolling average of new deaths (per 100k)\n",
caption = "Source: Analysis of data from John Hopkins SSE\nUpdated: 12th July 2021 | CCBY4.0")

Combine geom_bar, geom_segment and facet_grid on time series visualization

I'm trying to do a nice graph with ggplot but I'm still faces a barrier.
When I use facet_grid at the end of my code, somethings wrong happen. A helping hand would be great!
This is my code :
# Package
library(ggplot2)
# Function
firstup <- function(x) {
x <- tolower(x)
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
Create data
data_F = data.frame(DATE = seq(as.Date('2020-01-21'), as.Date('2020-03-06'), by = 'days'),
NB = sample(1:20, 46, replace=TRUE))
Manage the data
data_F = data.frame(DATE = data_F$DATE,
year = as.numeric(format(data_F$DATE, format = "%Y")),
month = as.factor(format(data_F$DATE, format = "%B")),
days = as.numeric(format(data_F$DATE, format = "%d")),
NB = data_F$NB)
Relevel month with the right order
data_F$month = as.factor(firstup(data_F$month))
data_F$month = factor(data_F$month,unique(data_F$month))
month = factor(data_F$month,unique(data_F$month))
month = unique(month)
month = as.factor(month)
The main plot
plot1 = ggplot(data_F,aes(x=DATE,y=NB)) +
geom_bar(stat = "identity", colour="black", fill = "dodgerblue3", width=0.5) +
scale_x_date(breaks = data_F$DATE, labels = data_F$days, minor_breaks = NULL,
expand = expansion(add = 0.3))+
scale_y_continuous(limits = c(0, 65), breaks = seq(0, 65, by = 5), minor_breaks = seq(0, 65, by = 1))
plot1
Creating the segment data
data.segm = data.frame(x=data_F$DATE,y=Inf, xend = data_F$DATE, yend=-Inf,
month=data_F$month)
Show two days, for example at the row 6 and 35
i = 6
plot1 = plot1 + geom_segment(data = data.segm, aes_string(x=data.segm$x[[i]],y=data.segm$y[[i]],
xend=data.segm$xend[[i]],yend=data.segm$yend[[i]]),
colour = alpha("gray90",0.5),size=8,inherit.aes = F)
i = 35
plot1 = plot1 + geom_segment(data = data.segm, aes_string(x=data.segm$x[[i]],y=data.segm$y[[i]],
xend=data.segm$xend[[i]],yend=data.segm$yend[[i]]),
colour = alpha("gray90",0.5),size=8,inherit.aes = F)
plot1
And know my problem with facet_grid
plot2 = plot1 + facet_grid(.~month, space="free_x", scales="free_x", switch="x")
plot2
Jonas

How to create a timeseries plot using facet_wrap of ggplot2

This is a follow up question on How to format the x-axis of the hard coded plotting function of SPEI package in R?. in my previous question, I had a single location dataset that needed to be plotted, however, in my current situation, I have dataset for multiple location (11 in total) that in needed to plot in a single figure. I tried to replicate same code with minor adjustment, however, the code do not produce the right plot. also I do not see dates break on the x-axis. Any help would be appreciated.
library(SPEI)
library(tidyverse)
library(zoo)
data("balance")
SPEI_12=spei(balance,12)
SpeiData=SPEI_12$fitted
myDate=as.data.frame(seq(as.Date("1901-01-01"), to=as.Date("2008-12-31"),by="months"))
names(myDate)= "Dates"
myDate$year=as.numeric(format(myDate$Dates, "%Y"))
myDate$month=as.numeric(format(myDate$Dates, "%m"))
myDate=myDate[,-1]
newDates = as.character(paste(month.abb[myDate$month], myDate$year, sep = "_" ))
DataWithDate = data.frame(newDates,SpeiData)
df_spei12 = melt(DataWithDate, id.vars = "newDates" )
SPEI12 = df_spei12 %>%
na.omit() %>%
mutate(sign = ifelse(value >= 0, "pos", "neg"))
SPEI12 = SPEI12%>%
spread(sign,value) %>%
replace(is.na(.), 0)
ggplot(SPEI12) +
geom_area(aes(x = newDates, y = pos), col = "blue") +
geom_area(aes(x = newDates, y = neg), col = "red") +
facet_wrap(~variable)+
scale_y_continuous(limits = c(-2.5, 2.5), breaks = -2.5:2.5) +
scale_x_discrete(breaks=c(1901,1925,1950,1975,2000,2008))+
ylab("SPEI") + ggtitle("12-Month SPEI") +
theme_bw() + theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"))+
theme(axis.text = element_text(size=12, colour = "black"), axis.title = element_text(size = 12,face = "bold"))
Here is what the code produces- instead of area plot it is producing bar plots.
With geom_area I was returning an error in the fill of the plot (a superposition), so I used geom_bar.
library(SPEI)
library(tidyverse)
library(zoo)
library(reshape2)
library(scales)
data("balance")
SPEI_12=spei(balance,12)
SpeiData=SPEI_12$fitted
myDate=as.data.frame(seq(as.Date("1901-01-01"), to=as.Date("2008-12-31"),by="months"))
names(myDate)= "Dates"
myDate$year=as.numeric(format(myDate$Dates, "%Y"))
myDate$month=as.numeric(format(myDate$Dates, "%m"))
myDate=myDate[,-1]
newDates = as.character(paste(month.abb[myDate$month], myDate$year, sep = "_" ))
DataWithDate = data.frame(newDates,SpeiData)
df_spei12 = melt(DataWithDate, id.vars = "newDates" )
SPEI12 = df_spei12 %>%
na.omit() %>%
mutate(sign = ifelse(value >= 0, "pos", "neg"))
###
SPEI12_md <- SPEI12 %>%
dplyr::mutate(Date = lubridate::parse_date_time(newDates, "m_y"),
Date = lubridate::ymd(Date),
variable = as.factor(variable))
levels(SPEI12_md$variable) <- c("Indore", "Kimberley", "Albuquerque", "Valencia",
"Viena", " Abashiri", "Tampa", "São Paulo",
"Lahore", "Punta Arenas", "Helsinki")
v <- 0.1 # 0.1 it is a gap
v1 <- min(SPEI12_md$value) - v
v2 <- max(SPEI12_md$value) + v
vv <- signif(max(abs(v1), abs(v2)), 2)
ggplot2::ggplot(SPEI12_md) +
geom_bar(aes(x = Date, y = value, col = sign, fill = sign),
show.legend = F, stat = "identity") +
scale_color_manual(values = c("pos" = "darkblue", "neg" = "red")) +
scale_fill_manual(values = c("pos" = "darkblue", "neg" = "red")) +
facet_wrap(~variable) +
scale_x_date(date_breaks = "10 years",
labels = scales::date_format("%Y-%m")) + #
scale_y_continuous(limits = c(-vv, vv), breaks = c(seq(-vv-v, 0, length.out = 3),
seq(0, vv+v, length.out = 3))) +
ylab("SPEI") + ggtitle("12-Month SPEI") +
theme_bw() + theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.text = element_text(size=12, colour = "black"),
axis.title = element_text(size = 12,face = "bold"),
axis.text.x = element_text(angle = 90, size = 10))
You use scale_x_discrete() but your variable on the x-axis, newDates, seems to be a character. It could explain why nothing is print on x-axis.
If you transform newDates as numeric (as you proposed in comments)
SPEI12$newDates= as.numeric(as.character(gsub(".*_","",SPEI12$newDates)))
and use scale_x_continuous() instead of discrete, you obtain this:

Resources