This post describes a method to create a two-line x-axis (year below months) on a time series plot. Unfortunately, the method that I use from this post (option 2) is not compatible with ggsave().
library(tidyverse)
library(lubridate)
df <- tibble(
date = as.Date(41000:42000, origin = "1899-12-30"),
value = c(rnorm(500, 5), rnorm(501, 10))
)
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(
xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60"
) +
scale_x_date(date_labels = "%b", date_breaks = "month", expand = c(0, 0)) +
theme_bw() +
theme(panel.grid.minor.x = element_blank()) +
labs(x = "")
# Get the grob
g <- ggplotGrob(p)
# Get the y axis
index <- which(g$layout$name == "axis-b") # which grob
xaxis <- g$grobs[[index]]
# Get the ticks (labels and marks)
ticks <- xaxis$children[[2]]
# Get the labels
ticksB <- ticks$grobs[[2]]
# Edit x-axis label grob
# Find every index of Jun in the x-axis labels and a year label
junes <- grep("Jun", ticksB$children[[1]]$label)
ticksB$children[[1]]$label[junes] <-
paste0(
ticksB$children[[1]]$label[junes],
"\n ", # adjust the amount of spaces to center the year
unique(year(df$date))
)
# Center the month labels between ticks
ticksB$children[[1]]$label <-
paste0(
paste(rep(" ", 12), collapse = ""), # adjust the integer to center month
ticksB$children[[1]]$label
)
# Put the edited labels back into the plot
ticks$grobs[[2]] <- ticksB
xaxis$children[[2]] <- ticks
g$grobs[[index]] <- xaxis
# Draw the plot
grid.newpage()
grid.draw(g)
# Save the plot
ggsave("plot.png", width = 11, height = 8.5, units = "in")
A plot is saved, but without the years. How do I ggsave() the final plot from grid.draw(g)? This grid.draw(g) plot is shown below, but the actual plot.png file is slightly different, with the three years 2012, 2013 and 2014 omitted.
library(tidyverse)
library(lubridate)
library(scales)
set.seed(123)
df <- tibble(
date = as.Date(41000:42000, origin = "1899-12-30"),
value = c(rnorm(500, 5), rnorm(501, 10))
)
# create year column for facet
df <- df %>%
mutate(year = as.factor(year(date)))
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") +
scale_x_date(date_labels = "%b",
breaks = pretty_breaks(),
expand = c(0, 0)) +
# switch the facet strip label to the bottom
facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
labs(x = "") +
theme_bw(base_size = 14, base_family = 'mono') +
theme(panel.grid.minor.x = element_blank()) +
# remove facet spacing on x-direction
theme(panel.spacing.x = unit(0,"line")) +
# switch the facet strip label to outside
# remove background color
theme(strip.placement = 'outside',
strip.background.x = element_blank())
p
ggsave("plot.png", plot = p,
type = "cairo",
width = 11, height = 8.5, units = "in",
dpi = 150)
Using theme_classic()
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") +
scale_x_date(date_labels = "%b",
breaks = pretty_breaks(),
expand = c(0, 0)) +
# switch the facet strip label to the bottom
facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
labs(x = "") +
theme_classic(base_size = 14, base_family = 'mono') +
theme(panel.grid.minor.x = element_blank()) +
# remove facet spacing on x-direction
theme(panel.spacing.x = unit(0,"line")) +
# switch the facet strip label to outside
# remove background color
theme(strip.placement = 'outside',
strip.background.x = element_blank())
p
Add the top and right most borders
ymax <- ceiling(1.1 * max(df$value, na.rm = TRUE))
xmax <- max(df$date, na.rm = TRUE)
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") +
scale_x_date(date_labels = "%b",
breaks = pretty_breaks(),
expand = c(0, 0)) +
# switch the facet strip label to the bottom
facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
labs(x = "") +
theme_classic(base_size = 14, base_family = 'mono') +
theme(panel.grid.minor.x = element_blank()) +
# remove facet spacing on x-direction
theme(panel.spacing.x = unit(0,"line")) +
# switch the facet strip label to outside
# remove background color
theme(strip.placement = 'outside',
strip.background.x = element_blank()) +
### add top and right most borders
scale_y_continuous(expand = c(0, 0), limits = c(0, ymax)) +
geom_hline(yintercept = ymax) +
geom_vline(xintercept = as.numeric(df$date[df$date == xmax])) +
theme(panel.grid.major = element_line())
p
Created on 2018-10-01 by the reprex package (v0.2.1.9000)
Taken from Tung comments above. Add the following at the end of the code chunk in the op's question.
ggsave(
"plot.png",
plot = g,
type = "cairo",
width = 11,
height = 8.5,
units = "in",
dpi = 150
)
Related
This post describes a method to create a two-line x-axis (year below months) on a time series plot. Unfortunately, the method that I use from this post (option 2) is not compatible with ggsave().
library(tidyverse)
library(lubridate)
df <- tibble(
date = as.Date(41000:42000, origin = "1899-12-30"),
value = c(rnorm(500, 5), rnorm(501, 10))
)
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(
xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60"
) +
scale_x_date(date_labels = "%b", date_breaks = "month", expand = c(0, 0)) +
theme_bw() +
theme(panel.grid.minor.x = element_blank()) +
labs(x = "")
# Get the grob
g <- ggplotGrob(p)
# Get the y axis
index <- which(g$layout$name == "axis-b") # which grob
xaxis <- g$grobs[[index]]
# Get the ticks (labels and marks)
ticks <- xaxis$children[[2]]
# Get the labels
ticksB <- ticks$grobs[[2]]
# Edit x-axis label grob
# Find every index of Jun in the x-axis labels and a year label
junes <- grep("Jun", ticksB$children[[1]]$label)
ticksB$children[[1]]$label[junes] <-
paste0(
ticksB$children[[1]]$label[junes],
"\n ", # adjust the amount of spaces to center the year
unique(year(df$date))
)
# Center the month labels between ticks
ticksB$children[[1]]$label <-
paste0(
paste(rep(" ", 12), collapse = ""), # adjust the integer to center month
ticksB$children[[1]]$label
)
# Put the edited labels back into the plot
ticks$grobs[[2]] <- ticksB
xaxis$children[[2]] <- ticks
g$grobs[[index]] <- xaxis
# Draw the plot
grid.newpage()
grid.draw(g)
# Save the plot
ggsave("plot.png", width = 11, height = 8.5, units = "in")
A plot is saved, but without the years. How do I ggsave() the final plot from grid.draw(g)? This grid.draw(g) plot is shown below, but the actual plot.png file is slightly different, with the three years 2012, 2013 and 2014 omitted.
library(tidyverse)
library(lubridate)
library(scales)
set.seed(123)
df <- tibble(
date = as.Date(41000:42000, origin = "1899-12-30"),
value = c(rnorm(500, 5), rnorm(501, 10))
)
# create year column for facet
df <- df %>%
mutate(year = as.factor(year(date)))
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") +
scale_x_date(date_labels = "%b",
breaks = pretty_breaks(),
expand = c(0, 0)) +
# switch the facet strip label to the bottom
facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
labs(x = "") +
theme_bw(base_size = 14, base_family = 'mono') +
theme(panel.grid.minor.x = element_blank()) +
# remove facet spacing on x-direction
theme(panel.spacing.x = unit(0,"line")) +
# switch the facet strip label to outside
# remove background color
theme(strip.placement = 'outside',
strip.background.x = element_blank())
p
ggsave("plot.png", plot = p,
type = "cairo",
width = 11, height = 8.5, units = "in",
dpi = 150)
Using theme_classic()
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") +
scale_x_date(date_labels = "%b",
breaks = pretty_breaks(),
expand = c(0, 0)) +
# switch the facet strip label to the bottom
facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
labs(x = "") +
theme_classic(base_size = 14, base_family = 'mono') +
theme(panel.grid.minor.x = element_blank()) +
# remove facet spacing on x-direction
theme(panel.spacing.x = unit(0,"line")) +
# switch the facet strip label to outside
# remove background color
theme(strip.placement = 'outside',
strip.background.x = element_blank())
p
Add the top and right most borders
ymax <- ceiling(1.1 * max(df$value, na.rm = TRUE))
xmax <- max(df$date, na.rm = TRUE)
p <- ggplot(df, aes(date, value)) +
geom_line() +
geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") +
scale_x_date(date_labels = "%b",
breaks = pretty_breaks(),
expand = c(0, 0)) +
# switch the facet strip label to the bottom
facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
labs(x = "") +
theme_classic(base_size = 14, base_family = 'mono') +
theme(panel.grid.minor.x = element_blank()) +
# remove facet spacing on x-direction
theme(panel.spacing.x = unit(0,"line")) +
# switch the facet strip label to outside
# remove background color
theme(strip.placement = 'outside',
strip.background.x = element_blank()) +
### add top and right most borders
scale_y_continuous(expand = c(0, 0), limits = c(0, ymax)) +
geom_hline(yintercept = ymax) +
geom_vline(xintercept = as.numeric(df$date[df$date == xmax])) +
theme(panel.grid.major = element_line())
p
Created on 2018-10-01 by the reprex package (v0.2.1.9000)
Taken from Tung comments above. Add the following at the end of the code chunk in the op's question.
ggsave(
"plot.png",
plot = g,
type = "cairo",
width = 11,
height = 8.5,
units = "in",
dpi = 150
)
I have this two data.frames
df1 <-
data.frame(unit = factor(1:20, levels = 20:1),
value = sample(1:10, 20, replace = T))
df2 <-
data.frame(unit =
factor(as.vector(sapply(1:20, FUN = function(x) rep(x, 10))).
levels = 1:20),
time = rep(1:10, 20),
value = sample(1:100, 10*20, replace = T))
Which I want to plot side by side like this:
library(ggplot2)
library(cowplot)
plot_grid(ggplot(df1, aes(x=value,y=unit)) +
geom_bar(stat = 'identity') +
scale_x_continuous(position = "top"),
ggplot(df2, aes(x=time,y=value)) +
geom_line() +
facet_grid(rows = vars(unit), scales = "free_y") +
scale_x_continuous(position = "top") +
theme(axis.text.y = element_text(size=6)),
ncol = 2)
which results in this output
Still, the rows from the two plots, mapping variables from the same unit are not perfectly aligned:
What's the easiest way to align them programmatically (so that it will also work with a different number of units)? The solution doesn't need to involve the cowplot package.
A simple solution to achieve this is by using facets for the bar plot, too. As long as the spacing between the panels is the same in both plots this should ensure that the bars and the line plots for each group are aligned. Try this:
df1 <-
data.frame(unit = factor(1:20, levels = 20:1),
value = sample(1:10, 20, replace = T))
df2 <-
data.frame(unit = factor(as.vector(sapply(1:20, FUN = function(x) rep(x, 10))), levels = 1:20),
time = rep(1:10, 20),
value = sample(1:100, 10*20, replace = T))
library(ggplot2)
library(cowplot)
plot_grid(ggplot(df1, aes(x=value,y=unit)) +
geom_bar(stat = 'identity') +
facet_grid(rows = vars(unit), scales = "free_y") +
scale_x_continuous(position = "top") +
theme(panel.spacing.y = unit(1, "pt"), strip.text = element_blank()),
ggplot(df2, aes(x=time,y=value)) +
geom_line() +
facet_grid(rows = vars(unit), scales = "free_y") +
scale_x_continuous(position = "top") +
theme(axis.text.y = element_text(size=6), panel.spacing.y = unit(1, "pt")),
ncol = 2)
If we look at the way the plots are aligned, it seems clear that to have the bars matching the corresponding facets, we have to get rid of the space at either end of the bars' y axis. We can do this with scale_y_discrete(expand = c(0, 0)). We can also scale the width of the bars so that it is equal to the proportion that each of the facet panels takes up in their allotted viewports. Unfortunately this is somewhat dependent on device dimensions. However, a width of 0.8 or 0.9 will get you pretty close.
plot_grid(ggplot(df1, aes(x=value,y=unit)) +
geom_bar(stat = 'identity', width = 0.8) +
scale_x_continuous(position = "top") +
scale_y_discrete(expand = c(0, 0)),
ggplot(df2, aes(x=time,y=value)) +
geom_line() +
facet_grid(rows = vars(unit), scales = "free_y") +
scale_x_continuous(position = "top") +
theme(axis.text.y = element_text(size=6)),
ncol = 2)
How do I plot one graph with lines that are ecdf_Q2<- 50,40,30,20, and 10 instead of just 50?? I need the ggplots to overlap each other. Thank you!
ecdf_Q2 <- **50** %>%
ecdf.shift(ratio_threshold, .) %>%
filter(nobs > 20) %>%
ggplot(aes( x = OUR_ratio_cutoff, y = prob)) +
geom_line() +
geom_point() +
theme_bw(base_size = 12) +
theme(panel.grid = element_blank()) +
scale_y_continuous(limits = c(0,100),
breaks = seq(0,300, by = 10),
expand = c(0,0)) +
scale_x_continuous(limits = c(0,2),
breaks = seq(0,3, by = 0.1),
expand = c(0,0))
By using ggplot and faced_grid functions I'm trying to make a heatmap. I have a categorical y axis, and I want y axis labels to be left aligned. When I use theme(axis.text.y.left = element_text(hjust = 0)), each panels' labels are aligned independently. Here is the code:
#data
set.seed(1)
gruplar <- NA
for(i in 1:20) gruplar[i] <- paste(LETTERS[sample(c(1:20),sample(c(1:20),1),replace = T) ],
sep="",collapse = "")
gruplar <- cbind(gruplar,anagruplar=rep(1:4,each=5))
tarih <- data.frame(yil= rep(2014:2019,each=12) ,ay =rep_len(1:12, length.out = 72))
gruplar <- gruplar[rep(1:nrow(gruplar),each=nrow(tarih)),]
tarih <- tarih[rep_len(1:nrow(tarih),length.out = nrow(gruplar)),]
grouped <- cbind(tarih,gruplar)
grouped$value <- rnorm(nrow(grouped))
#plot
p <- ggplot(grouped,aes(ay,gruplar,fill=value))
p <- p + facet_grid(anagruplar~yil,scales = "free",
space = "free",switch = "y")
p <- p + theme_minimal(base_size = 14) +labs(x="",y="") +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 90))
p <- p + geom_raster(aes(fill = value), na.rm = T)
p + theme(axis.text.y.left = element_text(hjust = 0, size=14))
I know that by putting spaces and using a mono-space font I can solve the problem, but I have to use the font 'Calibri Light'.
Digging into grobs isn't my favourite hack, but it can serve its purpose here:
# generate plot
# (I used a smaller base_size because my computer screen is small)
p <- ggplot(grouped,aes(ay,gruplar,fill=value)) +
geom_raster(aes(fill = value),na.rm = T) +
facet_grid(anagruplar~yil,scales = "free",space = "free",switch = "y") +
labs(x="", y="") +
theme_minimal(base_size = 10) +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 90),
axis.text.y.left = element_text(hjust = 0, size=10))
# examine ggplot object: alignment is off
p
# convert to grob object: alignment is unchanged (i.e. still off)
gp <- ggplotGrob(p)
dev.off(); grid::grid.draw(gp)
# change viewport parameters for left axis grobs
for(i in which(grepl("axis-l", gp$layout$name))){
gp$grobs[[i]]$vp$x <- unit(0, "npc") # originally 1npc
gp$grobs[[i]]$vp$valid.just <- c(0, 0.5) # originally c(1, 0.5)
}
# re-examine grob object: alignment has been corrected
dev.off(); grid::grid.draw(gp)
I guess one option is to draw the labels on the right-hand side, and move that column in the gtable,
p <-ggplot(grouped,aes(ay,gruplar,fill=value)) +
facet_grid(anagruplar~yil,scales = "free",space = "free",switch = "y") +
geom_raster(aes(fill = value),na.rm = T) +
theme_minimal(base_size = 12) + labs(x="",y="") +
scale_y_discrete(position='right') +
theme(strip.placement = "outside", strip.text.y = element_text(angle = 90))+
theme(axis.text.y.left = element_text(hjust = 0,size=14))
g <- ggplotGrob(p)
id1 <- unique(g$layout[grepl("axis-l", g$layout$name),"l"])
id2 <- unique(g$layout[grepl("axis-r", g$layout$name),"l"])
g2 <- gridExtra::gtable_cbind(g[,seq(1,id1-1)],g[,id2], g[,seq(id1+1, id2-1)], g[,seq(id2+1, ncol(g))])
library(grid)
grid.newpage()
grid.draw(g2)
This seems like a bug in ggplot2, or at least what I consider an undesirable / unexpected behavior. You may have seen the approach suggested here, which uses string padding on a mono-space font to achieve the alignment.
This is pretty hacky, but if you need to achieve alignment using a particular font, you might replace the axis labels altogether with geom_text. I have a mostly-working solution, but it is ugly, in that each step seems to break something else!
library(ggplot2); library(dplyr)
# To add a blank facet before 2014, I convert to character
grouped$yil = as.character(grouped$yil)
# I add some rows for the dummy facet, in year "", to use for labels
grouped <- grouped %>%
bind_rows(grouped %>%
group_by(gruplar) %>%
slice(1) %>%
mutate(yil = "",
value = NA_real_) %>%
ungroup())
p <- ggplot(grouped,
aes(ay,gruplar,fill=value)) +
geom_raster(aes(fill = value),na.rm = T) +
scale_x_continuous(breaks = 4*0:3) +
facet_grid(anagruplar~yil,
scales = "free",space = "free",switch = "y") +
theme_minimal(base_size = 14) +
labs(x="",y="") +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 90),
axis.text.y.left = element_blank(),
panel.grid = element_blank()) +
geom_text(data = grouped %>%
filter(yil == ""),
aes(x = -40, y = gruplar, label = gruplar), hjust = 0) +
scale_fill_continuous(na.value = "white")
p
(The last problem with this plot that I can see is that it shows an orphaned "0" on the x axis of the dummy facet. Need another hack to get rid of that!)
Below is some R code that generates a bar plot using ggplot, where the bars go off to the left and right, centered at x = 0. I would like to take the text on the y axis (the stage names), and place them in-between the left and the right bars. Here is the R code creating the graph:
library(dplyr)
libary(ggplot2)
# Read data
email_campaign_funnel <- read.csv("https://raw.githubusercontent.com/selva86/datasets/master/email_campaign_funnel.csv")
# X Axis Breaks and Labels
brks <- seq(-15000000, 15000000, 5000000)
lbls = paste0(as.character(c(seq(15, 0, -5), seq(5, 15, 5))), "m")
# Shorten Names
email_campaign_funnel <- email_campaign_funnel %>%
dplyr::mutate(Stage = gsub('Stage ', '', Stage)) %>%
dplyr::mutate(Stage = gsub(' Page', '', Stage)) %>%
dplyr::mutate(Stage = gsub('Campaign-', '', Stage))
# Plot
ggplot(email_campaign_funnel, aes(x = Stage, y = Users, fill = Gender)) + # Fill column
geom_bar(stat = "identity", width = .6) + # draw the bars
scale_y_continuous(breaks = brks, # Breaks
labels = lbls) + # Labels
coord_flip() + # Flip axes
labs(title="Email Campaign Funnel") +
theme(plot.title = element_text(hjust = .5),
axis.ticks = element_blank()) + # Centre plot title
scale_fill_brewer(palette = "Dark2") # Color palette
Below is a screenshot of a different graph that highlights sort of how I'd like the text to be split in between the bars (I prefer the vertical style of the ggplot() graph more so than the horizontal nature of the imaged graph below).
Any ideas on how to do this in R would be greatly appreciated, thanks!
How about something like this using ggarrange from the ggpubr package:
gg1 <- email_campaign_funnel %>%
mutate(Users = if_else(Gender == "Male", Users, 0)) %>%
ggplot(aes(Stage, Users, fill = Gender)) +
geom_col(width = 0.6) +
scale_y_continuous(breaks = brks, labels = lbls) +
coord_flip() +
labs(title="Email Campaign Funnel") +
theme_minimal() +
scale_fill_manual(values = c("Male" = "Red", "Female" = "Blue")) +
theme(
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank())
gg2 <- email_campaign_funnel %>%
filter(Gender == "Male") %>%
ggplot(aes(Stage, 0, label = Stage)) +
geom_text() +
coord_flip() +
theme_void()
gg3 <- email_campaign_funnel %>%
mutate(Users = if_else(Gender == "Female", Users, 0)) %>%
ggplot(aes(Stage, Users, fill = Gender)) +
geom_col(width = 0.6) +
scale_y_continuous(breaks = brks, labels = lbls) +
coord_flip() +
labs(title="Email Campaign Funnel") +
theme_minimal() +
scale_fill_manual(values = c("Male" = "Red", "Female" = "Blue")) +
theme(
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank())
library(ggpubr)
ggarrange(gg1, gg2, gg3, ncol = 3, common.legend = TRUE, align = "h")
Explanation: The idea is to build the plot separately from the left and right pyramid bar charts and the labels in the middle. We then use ggpubr::ggarrange to arrange all three ggplot2 plot objects in a single row and ensure that axes are properly aligned.
Split horizontal bar chart with labels in the middle
I was interested in seeing how close we can get to the horizontal pyramid bar chart plot you link to. Here is my attempt:
# Sample data
df <- read.table(text =
"Category Group Value
REB Red 39
REB Blue 35
OREB Red 8
OREB Blue 4
DREB Red 31
DREB Blue 31
AST Red 25
AST Blue 21
STL Red 5
STL Blue 5
BLK Red 1
BLK Blue 0
TOV Red 9
TOV Blue 11", header = T)
# Set factor order
df <- df %>% mutate(Category = factor(Category, unique(Category)))
# Build ggplot2 plot objects
library(tidyverse)
gg1 <- df %>%
filter(Group == "Red") %>%
ggplot(aes(Category, Value, fill = Group, label = Value)) +
geom_col() +
geom_text(colour = "red3", fontface = "bold", nudge_y = 10) +
theme_void() +
scale_fill_manual(values = c("Red" = "red3", "Blue" = "navyblue"), drop = FALSE) +
ylim(c(0, round(1.5 * max(df$Value))))
gg2 <- df %>%
filter(Group == "Red") %>%
ggplot(aes(Category, 0, label = Category)) +
geom_text(fontface = "bold") +
theme_void()
gg3 <- df %>%
filter(Group == "Blue") %>%
ggplot(aes(Category, -Value, fill = Group, label = Value)) +
geom_col() +
geom_text(colour = "navyblue", fontface = "bold", nudge_y = -10) +
theme_void() +
scale_fill_manual(values = c("Red" = "red3", "Blue" = "navyblue"), drop = FALSE) +
ylim(c(round(-1.5 * max(df$Value)), 0))
# Arrange plot objects in 1 column with horizontal scales aligned
library(ggpubr)
ggarrange(gg1, gg2, gg3, nrow = 3, common.legend = TRUE, align = "h", heights = c(1, 0.5, 1))