R: grid.arrange marginal plots to ggplot2 "heatmap" (geom_tile) - r

I want to add two bar charts to the top and right of a heatmap representing the marginal distributions along the two dimensions of the bivariate distribution that the heatmap represents.
Here is some code:
library(gridExtra)
library(ggExtra)
library(cowplot)
# generate some data
df_hm = cbind(
expand.grid(
rows = sample(letters, 10),
cols = sample(LETTERS, 10)
),
value = rnorm(100)
)
# plot the heatmap
gg_hm = df_hm %>%
ggplot(aes(x = rows, y = cols, fill = value)) +
geom_tile() +
theme(legend.position = "bottom")
gg_rows = df_hm %>%
group_by(rows) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = rows,y = value)) +
geom_bar(stat = "identity", position = "dodge")
gg_cols = df_hm %>%
group_by(cols) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = cols, y = value))+
geom_bar(stat = "identity", position = "dodge") +
coord_flip()
gg_empty = df_hm %>%
ggplot(aes(x = cols, y = value)) +
geom_blank() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
line = element_blank(),
panel.background = element_blank())
# try this with grid.arrange
grid.arrange(gg_rows, gg_empty, gg_hm, gg_cols,
ncol = 2, nrow = 2, widths = c(3, 1), heights = c(1, 3))
which produces this:
What I want to be able to do is to move the graphs to align as indicated by the red arrows:
- the y-axis of (1, 1) should line up with the y-axis of (2, 1)
- the x-axis of (2, 1) should line up with the x-axis of (2, 2)

I tried the accepted answer by renato vitolo and the alignments didn't work on my machine. But I subsequently discoverd a much easier solution: the egg package (available on CRAN). egg provides a version of grid.arrange called ggarrange which takes similar arguments but aligns the axes nicely. In the OP's code I just had to add library(egg), library(dplyr), and then replace grid.arrange with ggarrange (having installed egg with install.packages("egg")).
Full code:
library(gridExtra)
library(cowplot)
library(egg)
library(dplyr)
# generate some data
df_hm = cbind(
expand.grid(
rows = sample(letters, 10),
cols = sample(LETTERS, 10)
),
value = rnorm(100)
)
# plot the heatmap
gg_hm = df_hm %>%
ggplot(aes(x = rows, y = cols, fill = value)) +
geom_tile() +
theme(legend.position = "bottom")
gg_rows = df_hm %>%
group_by(rows) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = rows,y = value)) +
geom_bar(stat = "identity", position = "dodge")
gg_cols = df_hm %>%
group_by(cols) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = cols, y = value))+
geom_bar(stat = "identity", position = "dodge") +
coord_flip()
gg_empty = df_hm %>%
ggplot(aes(x = cols, y = value)) +
geom_blank() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
line = element_blank(),
panel.background = element_blank())
ggarrange(
gg_rows, gg_empty, gg_hm, gg_cols,
nrow = 2, ncol = 2, widths = c(3, 1), heights = c(1, 3)
)
Output:

gtable is extremely useful. scales provides tools to format the axis ticks, to achieve alignment between the text y.ticks of the heatmap (X, F, ...) and the numeric y.ticks of the barplot on top, by formatting the former to a fixed width of 5 chars (to be adapted for your specific barplot).
require(ggplot2)
require(gtable)
require(grid)
library(dplyr)
library(scales)
## To format heatmap y.ticks with appropriate width (5 chars),
## to align with gg_rows y.tics
ytickform <- function(x){
lab <- sprintf("%05s",x)
}
set.seed(123)
## generate some data
df_hm = cbind(
expand.grid(
rows = sample(letters, 10),
cols = sample(LETTERS, 10)
),
value = rnorm(100)
)
# plot the heatmap
gg_hm = df_hm %>%
ggplot(aes(x = rows, y = cols, fill = value)) +
geom_tile() +
scale_y_discrete(label=ytickform) +
theme(legend.position = "bottom",
plot.margin = unit(c(3,3,3,3), "mm"))
gg_rows = df_hm %>%
group_by(rows) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = rows,y = value)) +
geom_bar(stat = "identity", position = "dodge") +
theme(plot.margin = unit(c(3,3,3,3), "mm"))
gg_cols = df_hm %>%
group_by(cols) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = cols, y = value))+
geom_bar(stat = "identity", position = "dodge") +
coord_flip() +
theme(plot.margin = unit(c(3,3,3,3), "mm"))
## extract legend from heatmap
g <- ggplotGrob(gg_hm)$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
## plot heatmap without legend
g <- ggplotGrob(gg_hm + theme(legend.position="none"))
## add column and put column barplot within
g <- gtable_add_cols(g, unit(5,"cm"))
g <- gtable_add_grob(g, ggplotGrob(gg_cols),
t = 1, l=ncol(g), b=nrow(g), r=ncol(g))
## add row and put legend within
g <- gtable_add_rows(g, unit(1,"cm"))
g <- gtable_add_grob(g, legend,
t = nrow(g), l=1, b=nrow(g), r=ncol(g)-1)
## add row on top and put row barplot within
g <- gtable_add_rows(g, unit(5,"cm"), 0)
g <- gtable_add_grob(g, ggplotGrob(gg_rows),
t = 1, l=1, b=1, r=5)
grid.newpage()
grid.draw(g)
References:
Align ggplot2 plots vertically
http://www.cookbook-r.com/Graphs/Axes_(ggplot2)/#tick-mark-label-text-formatters
https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs

Related

R ggplot label number of observations per ordered violin with facet wrap

I've got a plot that looks like the output of the following code using the iris data
require(tidyverse)
require(purrr)
require(forcats) # Useful for ordering facets found at [here][1]
# Make some long data and set a custom sorting order using some of t
tbl <- iris %>%
pivot_longer(., cols = 1:4, names_to = "Msr", values_to = "Vls") %>%
mutate(Msr = factor(Msr)) %>%
mutate(plot_fct = fct_cross(Species, Msr)) %>%
mutate(plot_fct = fct_reorder(plot_fct, Vls))
# A functioning factory for minor log breaks found [here][1] (very helpful)
minor_breaks_log <- function(base) {
# Prevents lazy evaluation
force(base)
# Wrap calculation in a function that the outer function returns
function(limits) {
ggplot2:::calc_logticks(
base = base,
minpow = floor(log(limits[1], base = base)),
maxpow = ceiling(log(limits[2], base = base))
)$value
}
}
# Plot the images
ggplot(data = tbl, aes(x =plot_fct, y = Vls, fill = Species)) +
geom_violin() +
coord_flip() + # swap coords
scale_y_log10(labels = function(x) sprintf("%g", x),
minor_breaks = minor_breaks_log(10)) + # format for labels # box fills
theme_bw(base_size = 12) +
annotation_logticks(base = 10, sides = "b") +
facet_wrap(~Species, nrow = 1, scales = "free")
I would now like to list the number of observations per violin on the right side of each facet just inside the maximum border, which I'm sure is possible but cannot seem to find an example that does this sort of labeling, with violins and facets.
ggplot(data = tbl, aes(y = plot_fct, fill = Species)) +
geom_violin(aes(x = Vls)) +
geom_text(aes(label = after_stat(count)), hjust = 1,
stat = "count", position = "fill") +
scale_x_log10(labels = function(x) sprintf("%g", x),
minor_breaks = minor_breaks_log(10)) + # format for labels # box fills
theme_bw(base_size = 12) +
annotation_logticks(base = 10, sides = "b") +
facet_wrap(~Species, nrow = 1, scales = "free")

Align x axis with grid.arrange

I'm trying to plot two aligned graphics, but one of them has a label and of them doesn't.
Example:
library(dplyr)
library(ggplot2)
df <-
seq(as.Date("2019-01-01"), as.Date("2019-01-31"), by = 1) %>%
as_tibble() %>%
rename(day = value) %>%
mutate(
x = seq(1, 31, by = 1),
y = x * 2 - 20
)
p1 <-
df %>%
gather(key, value, c(x, y)) %>%
ggplot(aes(x = day, y = value, color = key)) +
geom_line(size = 1)
p2 <-
df %>%
ggplot(aes(x = day, y = y / x)) +
geom_line(size = 1)
grid.arrange(
p1, p2
)
Result:
Is there a way to align the axis without using facet_wrap? (I want to add specific label formatters for each plot because they are in different units and facet_wrap doesn't allow me to do that as far as I know)
You can manage them as different plots, with same legend, using cowplot package:
library(cowplot)
legend <- get_legend(p1) # get the legend of the first one plot
# here the plots in a grid
prow <- plot_grid( p1 + theme(legend.position="none"),
# here you add the percentage
p2 + theme(legend.position="none")+ scale_y_continuous(labels = scales::percent),
align = 'v',
labels = c("A", "B"),
hjust = -1,
nrow = 2)
# here you add the legend
p <- plot_grid( prow, legend, rel_widths = c(3, .3))
p

Bar charts connected by lines / How to connect two graphs arranged with grid.arrange in R / ggplot2

At Facebook research, I found these beautiful bar charts which are connected by lines to indicate rank changes:
https://research.fb.com/do-jobs-run-in-families/
I would like to create them using ggplot2. The bar-chart-part was easy:
library(ggplot2)
library(ggpubr)
state1 <- data.frame(state=c(rep("ALABAMA",3), rep("CALIFORNIA",3)),
value=c(61,94,27,10,30,77),
type=rep(c("state","local","fed"),2),
cumSum=c(rep(182,3), rep(117,3)))
state2 <- data.frame(state=c(rep("ALABAMA",3), rep("CALIFORNIA",3)),
value=c(10,30,7,61,94,27),
type=rep(c("state","local","fed"),2),
cumSum=c(rep(117,3), rep(182,3)))
fill <- c("#40b8d0", "#b2d183", "#F9756D")
p1 <- ggplot(data = state1) +
geom_bar(aes(x = reorder(state, value), y = value, fill = type), stat="identity") +
theme_bw() +
scale_fill_manual(values=fill) +
labs(x="", y="Total budget in 1M$") +
theme(legend.position="none",
legend.direction="horizontal",
legend.title = element_blank(),
axis.line = element_line(size=1, colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(), panel.background = element_blank()) +
coord_flip()
p2 <- ggplot(data = state2) +
geom_bar(aes(x = reorder(state, value), y = value, fill = type), stat="identity") +
theme_bw() +
scale_fill_manual(values=fill) + labs(x="", y="Total budget in 1M$") +
theme(legend.position="none",
legend.direction="horizontal",
legend.title = element_blank(),
axis.line = element_line(size=1, colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank()) +
scale_x_discrete(position = "top") +
scale_y_reverse() +
coord_flip()
p3 <- ggarrange(p1, p2, common.legend = TRUE, legend = "bottom")
But I couldn't come up with a solution to the line-part. When adding lines e.g. to the left side by
p3 + geom_segment(aes(x = rep(1:2, each=3), xend = rep(1:10, each=3),
y = cumSum[order(cumSum)], yend=cumSum[order(cumSum)]+10), size = 1.2)
The problem is that the lines will not be able to cross over to the right side.
It looks like this:
Basically, I would like to connect the 'California' bar on the left with the Caifornia bar on the right.
To do that, I think, I have to get access to the superordinate level of the graph somehow. I've looked into viewports and was able to overlay the two bar charts with a chart made out of geom_segment but then I couldn't figure out the right layout for the lines:
subplot <- ggplot(data = state1) +
geom_segment(aes(x = rep(1:2, each=3), xend = rep(1:2, each=3),
y = cumSum[order(cumSum)], yend =cumSum[order(cumSum)]+10),
size = 1.2)
vp <- viewport(width = 1, height = 1, x = 1, y = unit(0.7, "lines"),
just ="right", "bottom"))
print(p3)
print(subplot, vp = vp)
Help or pointers are greatly appreciated.
This is a really interesting problem. I approximated it using the patchwork library, which lets you add ggplots together and gives you an easy way to control their layout—I much prefer it to doing anything grid.arrange-based, and for some things it works better than cowplot.
I expanded on the dataset just to get some more values in the two data frames.
library(tidyverse)
library(patchwork)
set.seed(1017)
state1 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
state2 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
Then I made a data frame that assigns ranks to each state based on other values in their original data frame (state1 or state2).
ranks <- bind_rows(
state1 %>% mutate(position = 1),
state2 %>% mutate(position = 2)
) %>%
group_by(position, state) %>%
summarise(state_total = sum(value)) %>%
mutate(rank = dense_rank(state_total)) %>%
ungroup()
I made a quick theme to keep things very minimal and drop axis marks:
theme_min <- function(...) theme_minimal(...) +
theme(panel.grid = element_blank(), legend.position = "none", axis.title = element_blank())
The bump chart (the middle one) is based on the ranks data frame, and has no labels. Using factors instead of numeric variables for position and rank gave me a little more control over spacing, and lets the ranks line up with discrete 1 through 5 values in a way that will match the state names in the bar charts.
p_ranks <- ggplot(ranks, aes(x = as.factor(position), y = as.factor(rank), group = state)) +
geom_path() +
scale_x_discrete(breaks = NULL, expand = expand_scale(add = 0.1)) +
scale_y_discrete(breaks = NULL) +
theme_min()
p_ranks
For the left bar chart, I sort the states by value and turn the values negative to point to the left, then give it the same minimal theme:
p_left <- state1 %>%
mutate(state = as.factor(state) %>% fct_reorder(value, sum)) %>%
arrange(state) %>%
mutate(value = value * -1) %>%
ggplot(aes(x = state, y = value, fill = type)) +
geom_col(position = "stack") +
coord_flip() +
scale_y_continuous(breaks = NULL) +
theme_min() +
scale_fill_brewer()
p_left
The right bar chart is pretty much the same, except the values stay positive and I moved the x-axis to the top (becomes right when I flip the coordinates):
p_right <- state2 %>%
mutate(state = as.factor(state) %>% fct_reorder(value, sum)) %>%
arrange(state) %>%
ggplot(aes(x = state, y = value, fill = type)) +
geom_col(position = "stack") +
coord_flip() +
scale_x_discrete(position = "top") +
scale_y_continuous(breaks = NULL) +
theme_min() +
scale_fill_brewer()
Then because I've loaded patchwork, I can add the plots together and specify the layout.
p_left + p_ranks + p_right +
plot_layout(nrow = 1)
You may want to adjust spacing and margins some more, such as with the expand_scale call with the bump chart. I haven't tried this with axis marks along the y-axes (i.e. bottoms after flipping), but I have a feeling things might get thrown out of whack if you don't add a dummy axis to the ranks. Plenty still to mess around with, but it's a cool visualization project you posed!
Here's a pure ggplot2 solution, which combines the underlying data frames into one & plots everything in a single plot:
Data manipulation:
library(dplyr)
bar.width <- 0.9
# combine the two data sources
df <- rbind(state1 %>% mutate(source = "state1"),
state2 %>% mutate(source = "state2")) %>%
# calculate each state's rank within each data source
group_by(source, state) %>%
mutate(state.sum = sum(value)) %>%
ungroup() %>%
group_by(source) %>%
mutate(source.rank = as.integer(factor(state.sum))) %>%
ungroup() %>%
# calculate the dimensions for each bar
group_by(source, state) %>%
arrange(type) %>%
mutate(xmin = lag(cumsum(value), default = 0),
xmax = cumsum(value),
ymin = source.rank - bar.width / 2,
ymax = source.rank + bar.width / 2) %>%
ungroup() %>%
# shift each data source's coordinates away from point of origin,
# in order to create space for plotting lines
mutate(x = ifelse(source == "state1", -max(xmax) / 2, max(xmax) / 2)) %>%
mutate(xmin = ifelse(source == "state1", x - xmin, x + xmin),
xmax = ifelse(source == "state1", x - xmax, x + xmax)) %>%
# calculate label position for each data source
group_by(source) %>%
mutate(label.x = max(abs(xmax))) %>%
ungroup() %>%
mutate(label.x = ifelse(source == "state1", -label.x, label.x),
hjust = ifelse(source == "state1", 1.1, -0.1))
Plot:
ggplot(df,
aes(x = x, y = source.rank,
xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax,
fill = type)) +
geom_rect() +
geom_line(aes(group = state)) +
geom_text(aes(x = label.x, label = state, hjust = hjust),
check_overlap = TRUE) +
# allow some space for the labels; this may be changed
# depending on plot dimensions
scale_x_continuous(expand = c(0.2, 0)) +
scale_fill_manual(values = fill) +
theme_void() +
theme(legend.position = "top")
Data source (same as #camille's):
set.seed(1017)
state1 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
state2 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)

How to create such a figure using ggplot2 in R?

I have a matrix with many zero elements. The column names are labeled on the horizontal axis. I'd like to show explictly the nonzero elements as the bias from the vertical line for each column.
So how should construct a figure such as the example using ggplot2?
An example data can be generated as follow:
set.seed(2018)
N <- 5
p <- 40
dat <- matrix(0.0, nrow=p, ncol=N)
dat[2:7, 1] <- 4*rnorm(6)
dat[4:12, 2] <- 2.6*rnorm(9)
dat[25:33, 3] <- 2.1*rnorm(9)
dat[19:26, 4] <- 3.3*rnorm(8)
dat[33:38, 5] <- 2.9*rnorm(6)
colnames(dat) <- letters[1:5]
print(dat)
Here is another option using facet_wrap and geom_col with theme_minimal.
library(tidyverse)
dat %>%
as.data.frame() %>%
rowid_to_column("row") %>%
gather(key, value, -row) %>%
ggplot(aes(x = row, y = value, fill = key)) +
geom_col() +
facet_wrap(~ key, ncol = ncol(dat)) +
coord_flip() +
theme_minimal()
To further increase the aesthetic similarity to the plot in your original post we can
move the facet strips to the bottom,
rotate strip labels,
add "zero lines" in matching colours,
remove the fill legend, and
get rid of the x & y axis ticks/labels/title.
library(tidyverse)
dat %>%
as.data.frame() %>%
rowid_to_column("row") %>%
gather(key, value, -row) %>%
ggplot(aes(x = row, y = value, fill = key)) +
geom_col() +
geom_hline(data = dat %>%
as.data.frame() %>%
gather(key, value) %>%
count(key) %>%
mutate(y = 0),
aes(yintercept = y, colour = key), show.legend = F) +
facet_wrap(~ key, ncol = ncol(dat), strip.position = "bottom") +
coord_flip() +
guides(fill = FALSE) +
theme_minimal() +
theme(
strip.text.x = element_text(angle = 45),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank())
It would be much easier if you can provide some sample data. Thus I needed to create them and there is no guarantee that this will work for your purpose.
set.seed(123)
# creating some random sample data
df <- data.frame(id = rep(1:100, each = 3),
x = rnorm(300),
group = rep(letters[1:3], each = 100),
bias = sample(0:1, 300, replace = T, prob = c(0.7, 0.3)))
# introducing bias
df$bias <- df$bias*rnorm(nrow(df))
# calculate lower/upper bias for errorbar
df$biaslow <- apply(data.frame(df$bias), 1, function(x){min(0, x)})
df$biasupp <- apply(data.frame(df$bias), 1, function(x){max(0, x)})
Then I used kind of hack to be able to print groups in sufficient distance to make them not overlapped. Based on group I shifted bias variable and also lower and upper bias.
# I want to print groups in sufficient distance
df$bias <- as.numeric(df$group)*5 + df$bias
df$biaslow <- as.numeric(df$group)*5 + df$biaslow
df$biasupp <- as.numeric(df$group)*5 + df$biasupp
And now it is possible to plot it:
library(ggplot2)
ggplot(df, aes(x = x, col = group)) +
geom_errorbar(aes(ymin = biaslow, ymax = biasupp), width = 0) +
coord_flip() +
geom_hline(aes(yintercept = 5, col = "a")) +
geom_hline(aes(yintercept = 10, col = "b")) +
geom_hline(aes(yintercept = 15, col = "c")) +
theme(legend.position = "none") +
scale_y_continuous(breaks = c(5, 10, 15), labels = letters[1:3])
EDIT:
To incorporate special design you can add
theme_bw() +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
to your plot.
EDIT2:
To incorporate several horizontal lines, you can create different dataset:
df2 <- data.frame(int = unique(as.numeric(df$group)*5),
gr = levels(df$group))
And use
geom_hline(data = df2, aes(yintercept = int, col = gr))
instead of copy/pasting geom_hline for each group level.

Automate tick max and min in faceted ggplot

I am trying to just mark the max and min of each x-axis in a faceted ggplot. I have several facets with different x scales and the same y scale, and the x axis tick labels overlap each other. Rather than having to manually determine the limits and breaks for each facet x axis, I am looking for a way to just label the min and max values for each.
Code using example data of the CO2 dataset (see ?CO2):
CO2$num <- 1:nrow(CO2)
library(reshape2)
CO2.melt <- melt(CO2,
id.var=c("Type",
"Plant",
"Treatment",
"num"))
CO2.melt <- CO2.melt[order(CO2.melt$num),]
library(ggplot2)
ggplot(CO2.melt,
aes(x = value,
y = num)) +
geom_path(aes(color = Treatment)) +
facet_wrap( ~ variable, scales = "free_x",nrow=1)
Purpose is to replicate well log displays such as this one.
When you want to implemented this for the tick-labels, the use of scales = "free_x" in a faceted plot makes this hard to automate this. However, with a bit of tinkering and the help of several other packages, you could also use the following approach:
1) Summarise the data in order to get an idea which tick-labels / breaks you need on the x-axis:
library(data.table)
minmax <- melt(setDT(CO2.melt)[, .(min.val = min(value), max.val = max(value),
floor.end = 10*ceiling(min(value)/10),
ceil.end = 10*floor((max(value)-1)/10)),
variable][],
measure.vars = patterns('.val','.end'),
variable.name = 'var',
value.name = c('minmax','ends'))
which gives:
> minmax
variable var minmax ends
1: conc 1 95.0 100
2: uptake 1 7.7 10
3: conc 2 1000.0 990
4: uptake 2 45.5 40
2) Create break vecors for each facet:
brks1 <- c(95,250,500,750,1000)
brks2 <- c(7.7,10,20,30,40,45.5)
3) Create the facets:
p1 <- ggplot(CO2.melt[CO2.melt$variable=="conc",],
aes(x = value, y = num, colour = Treatment)) +
geom_path() +
scale_x_continuous(breaks = brks1) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(colour = c('red','black')[c(1,2,2,2,1)],
face = c('bold','plain')[c(1,2,2,2,1)]),
axis.title = element_blank(),
panel.grid.major = element_line(colour = "grey60"),
panel.grid.minor = element_blank())
p2 <- ggplot(CO2.melt[CO2.melt$variable=="uptake",],
aes(x = value, y = num, colour = Treatment)) +
geom_path() +
scale_x_continuous(breaks = brks2) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(colour = c('red','black')[c(1,2,2,2,2,1)],
face = c('bold','plain')[c(1,2,2,2,2,1)]),
axis.title = element_blank(),
panel.grid.major = element_line(colour = "grey60"),
panel.grid.minor = element_blank())
4) Extract the legend into a separate object:
library(grid)
library(gtable)
fill.legend <- gtable_filter(ggplot_gtable(ggplot_build(p2)), "guide-box")
legGrob <- grobTree(fill.legend)
5) Create the final plot:
library(gridExtra)
grid.arrange(p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
legGrob, ncol=3, widths = c(4,4,1))
which results in:
A possible alternative solution to do this automatically, is either use geom_text or geom_label. An example to show how you can achieve this:
# create a summary
library(dplyr)
library(tidyr)
minmax <- CO2.melt %>%
group_by(variable) %>%
summarise(minx = min(value), maxx = max(value)) %>%
gather(lbl, val, -1)
# create the plot
ggplot(CO2.melt, aes(x = value, y = num, color = Treatment)) +
geom_path() +
geom_text(data = minmax,
aes(x = val, y = -3, label = val),
colour = "red", fontface = "bold", size = 5) +
facet_wrap( ~ variable, scales = "free_x", nrow=1) +
theme_minimal()
which gives:
You can also get the minimum and maximum values on the fly inside ggplot (credit to #eipi10). Another example using geom_label:
ggplot(CO2.melt, aes(x = value, y = num, color = Treatment)) +
geom_path() +
geom_label(data = CO2.melt %>%
group_by(variable) %>%
summarise(minx = min(value), maxx = max(value)) %>%
gather(lbl, val, -1),
aes(x = val, y = -3, label = val),
colour = "red", fontface = "bold", size = 5) +
facet_wrap( ~ variable, scales = "free_x", nrow=1) +
theme_minimal()
which gives:
Edit Updating to ggplot2 ver 3.0.0
This approach modifies the labels in the ggplot build data (i.e., ggplot_build(plot)). I've removed the x-axis expansions so that the maximum and minimum values fall on the panel boundaries.
# Packages
library(grid)
library(ggplot2)
library(reshape2)
# Data
CO2$num <- 1:nrow(CO2)
library(reshape2)
CO2.melt <- melt(CO2,
id.var=c("Type",
"Plant",
"Treatment",
"num"))
CO2.melt <- CO2.melt[order(CO2.melt$num),]
# Plot
(p <- ggplot(CO2.melt,
aes(x = value,
y = num)) +
scale_x_continuous(expand = c(0, 0)) +
geom_path(aes(color = Treatment)) +
facet_wrap( ~ variable, scales = "free_x", nrow=1))
# Get the build data
gb <- ggplot_build(p)
# Get number of panels
panels = length(gb$layout$panel_params)
# Get x tick mark labels
x.labels = lapply(1:panels, function(N) gb$layout$panel_params[[N]]$x.labels)
# Get range of x values
x.range = lapply(1:panels, function(N) gb$layout$panel_params[[N]]$x.range)
# Get position of x tick mark labels
x.pos = lapply(1:panels, function(N) gb$layout$panel_params[[N]]$x.major)
# Get new x tick mark labels - includes max and min
new.labels = lapply(1:panels, function(N) as.character(sort(unique(c(as.numeric(x.labels[[N]]), x.range[[N]])))))
# Tag min and max values with "min" and "max"
new.labelsC = new.labels
minmax = c("min", "max")
new.labelsC = lapply(1:panels, function(N) {
x = c(new.labelsC[[N]][1], new.labelsC[[N]][length(new.labels[[N]])])
x = paste0(x, "\n", minmax)
c(x[1], new.labelsC[[N]][2:(length(new.labels[[N]])-1)], x[2])
} )
# # Get position of new labels
new.pos = lapply(1:panels, function(N) (as.numeric(new.labels[[N]]) - x.range[[N]][1])/(x.range[[N]][2] - x.range[[N]][1]))
# Put them back into the build data
for(i in 1:panels) {
gb$layout$panel_params[[i]]$x.labels = new.labelsC[[i]]
gb$layout$panel_params[[i]]$x.major_source = as.numeric(new.labels[[i]])
gb$layout$panel_params[[i]]$x.major = new.pos[[i]]
}
# Get the ggplot grob
gp = ggplot_gtable(gb)
# Add some additional space between the panels
pos = gp$layout$l[grep("panel", gp$layout$name)] # Positions of the panels
for(i in 1:(panels-1)) gp$widths[[pos[i]+1]] = unit(1, "cm")
# Colour the min and max labels using `grid` editing functions
for(i in 1:panels) {
gp = editGrob(grid.force(gp), gPath(paste0("axis-b-", i), "axis", "axis", "GRID.text"),
grep = TRUE, gp = gpar(col = c("red", rep("black", length(new.labels[[i]])-2), "red")))
}
# Draw it
grid.newpage()
grid.draw(gp)

Resources