Related
I am doing a scatterplot with a facet_grid() like that:
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2)
I want the y axis title y to be in the middle of each row like this (paint solution):
The numbers of facet rows is two in this example because df$group2 has two different values. For my actual use case there may be more than two rows depending on the used facet variable; the y axis title is supposed to be in the middle of each facet row.
Best solution so far is adding spaces which is a mess since using y axis titles of different length shifts the text away from the middle of the rows. It must be with ggplot2, i.e. without the usage of additional packages. I make a package and do not want to rely on/ include too many packages.
Data used here:
df <- data.frame(x= rnorm(100), y= rnorm(100),
group1= rep(0:1, 50), group2= rep(2:3, each= 50))
Without using another package, I felt that the best method would be to build upon the spaces solution you linked in the original question. So I wrote a function to make the label spacing a little bit more robust.
ylabel <- function(label1,label2){
L1 <- nchar(label1)
L2 <- nchar(label2)
scaler <- ifelse(L1 + L2 > 8, 4, 0)
space1 = paste0(rep("",27 - (L1/2)),collapse = " ")
space2 = paste0(rep("",44 - (L1/2 + L2/2) - scaler), collapse = " ")
space3 = paste0(rep("",22 - (L2/2)), collapse = " ")
paste0(space1,label1,space2,label2,space3)
}
Application:
test <- ylabel("automobiles", "trucks")
ggplot(df, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2) +
ylab(test)
Still playing around with the scaler parameter, it's not perfect:
test2 <- ylabel("super long label", "a")
ggplot(df, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2) +
ylab(test2)
Will continue to refine the function/parameters, but am thinking this will get you close to what you're looking for.
You can copy the axis labels into new grobs in the gtable. Note that although this uses the grid and gtable packages, these are already imported by ggplot2, so this does not add any new dependencies that are not already available and used internally by ggplot.
library(grid)
library(gtable)
g = ggplot(df, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2)
gt = ggplot_gtable(ggplot_build(g))
which.ylab = grep('ylab-l', gt$layout$name)
gt = gtable_add_grob(gt, gt$grobs[which.ylab], 8, 3)
gt = gtable_add_grob(gt, gt$grobs[which.ylab], 10, 3)
gt = gtable_filter(gt, 'ylab-l', invert = TRUE) # remove the original axis title
grid.draw(gt)
The above works for OP's example with just two facets. If we want to generalise this for an arbitrary number of facets we can do that simply enough by searching the gtable to see which rows contain y-axes.
gt = ggplot_gtable(ggplot_build(g))
which.ylab = grep('ylab-l', gt$layout$name)
which.axes = grep('axis-l', gt$layout$name)
axis.rows = gt$layout$t[which.axes]
label.col = gt$layout$l[which.ylab]
gt = gtable::gtable_add_grob(gt, rep(gt$grobs[which.ylab], length(axis.rows)), axis.rows, label.col)
gt = gtable::gtable_filter (gt, 'ylab-l', invert = TRUE)
grid::grid.draw(gt)
In the version above, I also use :: to explicitly specify the namespace for the functions from the grid and gtable packages. This will allow the code to work without even loading the additional packages into the search path.
Demonstrating this code with another example with four facet rows:
df <- data.frame(x= rnorm(100), y= rnorm(100),
group1= rep(1:4, 25), group2= rep(1:2, each= 50))
You may consider switching to library(cowplot) for more control
The following code could be added to a function, but I left it long for clarity. Create 4 dataframes and feed them to four plots. Then arrange the plots
library(tidyverse)
df <- data.frame(x= rnorm(100), y= rnorm(100),
group1= rep(0:1, 50), group2= rep(2:3, each= 50))
library(cowplot)
df1 <- df %>%
filter(group2 == 2) %>%
filter(group1 == 0)
df2 <- df %>%
filter(group2 == 3) %>%
filter(group1 == 0)
df3 <- df %>%
filter(group2 == 2) %>%
filter(group1 == 1)
df4 <- df %>%
filter(group2 == 3) %>%
filter(group1 == 1)
plot1 <- ggplot(df1, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2)+
xlim(c(-3, 3))+
ylim(c(-3, 2))+
theme(strip.text.y = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
)
plot1
plot2 <- ggplot(df2, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2)+
xlim(c(-3, 3))+
ylim(c(-3, 2))+
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
)
plot2
plot3 <- ggplot(df3, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2)+
xlim(c(-3, 3))+
ylim(c(-3, 2))+
theme(strip.text.x = element_blank(),
strip.text.y = element_blank())
plot3
plot4 <- ggplot(df4, aes(x, y)) +
geom_point() +
facet_grid(group1 ~ group2)+
xlim(c(-3, 3))+
ylim(c(-3, 2))+
theme(axis.title.y = element_blank(),
strip.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
plot4
plot_grid(plot1, plot2, plot3, plot4)
Here is a version with annotation, using ggplot2 only. It should be scalable.
No messing with grobs. The disadvantage is that the x positioning and the plot margins need to be semi-manually defined and this might not be very robust.
library(ggplot2)
df <- data.frame(x= rnorm(100), y= rnorm(100),
group1= rep(0:1, 50), group2= rep(2:3, each= 50))
## define a new data frame based on your groups, so this is scalable
annotate_ylab <- function(df, x, y, group1, group2, label = "label") {
## make group2 a factor, so you know which column will be to the left
df[[group2]] <- factor(df[[group2]])
lab_df <- data.frame(
## x positioning is a bit tricky,
## I think a moderately robust method is to
## set it relativ to the range of your values
x = min(df[[x]]) - 0.2 * diff(range(df[[x]])),
y = mean(df[[y]]),
g1 = unique(df[[group1]]),
## draw only on the left column
g2 = levels(df[[group2]])[1],
label = label
)
names(lab_df) <- c(x, y, group1, group2, "label")
lab_df
}
y_df <- annotate_ylab(df, "x", "y", "group1", "group2", "y")
ggplot(df, aes(x, y)) +
geom_point() +
geom_text(data = y_df, aes(x, y, label = label), angle = 90) +
facet_grid(group1 ~ group2) +
coord_cartesian(xlim = range(df$x), clip = "off") +
theme(axis.title.y = element_blank(),
plot.margin = margin(5, 5, 5, 20))
y_df_mtcars <- annotate_ylab(mtcars, "mpg", "disp", "carb", "vs", "y")
ggplot(mtcars, aes(mpg, disp)) +
geom_point() +
geom_text(data = y_df_mtcars, aes(mpg, disp, label = label), angle = 90) +
facet_grid(carb ~ vs) +
coord_cartesian(xlim = range(mtcars$mpg), clip = "off") +
theme(axis.title.y = element_blank(),
plot.margin = margin(5, 5, 5, 20))
Created on 2021-11-24 by the reprex package (v2.0.1)
I am trying to recreate a geological cross section similar to the one below, which show various rock parameters (x axis) plotted against depth (y axis)
I can nicely recreate the individual plots in ggplot2 and grid together to create something very similar. To finish off i would really like to join lines between the plots which show regions of similar geology as in the picture.
Below is some code which plots the charts with the horizontal lines, what i would really to do is to join lines ( if possible in R) and if possible align the charts based on the line
library(ggplot2)
library(gridExtra)
df1 = data.frame(replicate(2,sample(0:200,100,rep=TRUE)))
df1$depth = seq.int(nrow(df1))
df2 = data.frame(replicate(2,sample(0:200,100,rep=TRUE)))
df2$depth = seq.int(nrow(df1))
top1 = 32
top2 = 50
plot1 = ggplot(df1, aes(y = depth, x = X1))+
scale_y_continuous(trans = "reverse")+
geom_path()+
geom_hline(yintercept=top1, colour = "red")+
annotate(geom="text", x=25, y=top1, label=top1, color="red")+
theme_bw()+
theme(panel.grid.major = element_line(colour = "grey"), panel.background = element_rect(colour = "black", size=0.5))+
ylab("Depth ft")+
ggtitle("plot1")
plot2 = ggplot(df2, aes(y = depth, x = X1))+
scale_y_continuous(trans = "reverse")+
geom_path()+
geom_hline(yintercept=top2, colour = "red")+
annotate(geom="text", x=25, y=top2, label=top2, color="red")+
theme_bw()+
theme(panel.grid.major = element_line(colour = "grey"), panel.background = element_rect(colour = "black", size=0.5))+
ylab("Depth ft")+
ggtitle("plot2")
grid.arrange (plot1, plot2, ncol=2)
This would be the desired result i would be looking for with the lines joined and if possible aligned.
Thanks for any help or advice given
Cheers
I can't help with the line-joining part, but the idea of the shifted scales sounded pretty interesting. This solution takes an arbitrary number of dataframes and an accompanying list of isolines, then shifts the y-scale so that each isoline is at 0.
Each dataframe is then plotted and the y-axes are renumbered appropriately.
library(purrr)
library(dplyr)
library(ggplot2)
# library(cowplot)
# I never load `cowplot` because it changes some settings onload.
# I just call the namespace with `cowplot::plot_grid(...)`
# You will need it installed though.
depth_plots <- function(..., isolines) {
dats <- list(...)
stopifnot(length(dats) == length(isolines))
scaled_dats <- map2(dats, isolines, ~.x %>% mutate(sc_depth = depth - .y))
new_range <-
map(scaled_dats, ~range(.x$sc_depth)) %>%
unlist() %>%
range() %>%
scales::expand_range(mul = 0.05)
plots <- map2(
scaled_dats, isolines,
~ggplot(.x, aes(y = sc_depth, x = X1)) +
scale_y_continuous(
trans = "reverse",
breaks = scales::extended_breaks()(.x$depth) - .y,
labels = scales::extended_breaks()(.x$depth)
) +
geom_path() +
geom_hline(yintercept=0, colour = "red") +
annotate(geom="text", x=25, y=0, label=.y, color="red") +
coord_cartesian(
ylim = new_range
) +
theme_bw()
)
cowplot::plot_grid(plotlist = plots, nrow = 1)
}
To test out the varying depth structures, I changed your sample data a bit:
df1 = data.frame(replicate(2,sample(0:200,100,rep=TRUE)))
df1$depth = seq.int(nrow(df1))
df2 = data.frame(replicate(2,sample(0:200,100,rep=TRUE)))
df2$depth = seq.int(nrow(df1))*0.75
df3 = data.frame(replicate(2,sample(0:200,100,rep=TRUE)))
df3$depth = seq.int(nrow(df1))*2
depth_plots(df1, df2, df3, isolines = c(32,50, 4))
Hope that gets you started!
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)
)
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.
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