I'm trying to draw a border around two plots that have been aligned with plot_grid from the cowplot package. Please see the following example (modified from the "Changing the axis positions" vignette):
require(gtable)
require(cowplot)
# top plot
p1 <- ggplot(mtcars, aes(mpg, disp)) + geom_line(colour = 'blue') +
background_grid(minor = 'none')
g1 <- switch_axis_position(p1, 'xy') # switch both axes
g1 <- gtable_squash_rows(g1, length(g1$height)) # set bottom row to 0 height
# bottom plot
p2 <- ggplot(mtcars, aes(mpg, qsec)) + geom_line(colour = 'green') + ylim(14, 25) +
background_grid(minor = 'none')
g2 <- ggplotGrob(p2)
g2 <- gtable_add_cols(g2, g1$widths[5:6], 4) # add the two additional columns that g1 has
g2 <- gtable_squash_rows(g2, 1:2) # set top two rows to 0 height
plot_grid(g1, g2, ncol = 1, align = 'v') +
annotate("rect", xmin = 0.1, xmax = 0.9, ymin = 0.1, ymax = 0.9,
color = "red", fill = NA)
Now, instead of the arbitrarily chosen coordinates for the red box, I'd like to have it aligned with the axis lines. I assume these coordinates can be extracted from the plot_grid output, but I have no idea how.
Based on my understanding of grobs, I'd say it's easier to get the coordinates for each plot & add the border segments before combining the plots using plot_grid.
Example data:
library(gtable)
library(cowplot)
# sample plots
# (note: the cowplot function switch_axis_position has been deprecated, as its
# creator notes ggplot2 now natively supports axes on either side of the plot.)
p1 <- ggplot(mtcars, aes(mpg, disp)) +
geom_line(colour = 'blue') +
scale_x_continuous(position = "top") +
scale_y_continuous(position = "right") +
background_grid(minor = 'none'); p1
p2 <- ggplot(mtcars, aes(mpg, qsec)) +
geom_line(colour = 'green') +
ylim(14, 25) +
background_grid(minor = 'none'); p2
# convert to grob objects
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
Function to add appropriate border segments for each plot grob, where:
grob is the grob object created via ggplotGrob;
sides is a character string containing any combination of "t" / "l" / "b" / "r" in any order to indicate the desired sides for border placement;
col is the desired border colour (defaults to red);
... is for any other parameters to be passed to gpar() in segmentsGrob()
.
library(grid)
add.segments <- function(grob, sides = "tlbr", col = "red", ...){
# get extent of gtable cells to be surrounded by border
panel.coords <- g1[["layout"]][g1[["layout"]][["name"]] == "panel", ]
t <- if(grepl("t", sides)) panel.coords[["t"]] else 1
b <- if(grepl("b", sides)) panel.coords[["b"]] else length(grob[["heights"]])
l <- if(grepl("l", sides)) panel.coords[["l"]] else 1
r <- if(grepl("r", sides)) panel.coords[["r"]] else length(grob[["widths"]])
# define border coordinates, & filter for the desired border sides
coords <- data.frame(direction = c("t", "b", "l", "r"),
x0 = c(0, 0, 0, 1), y0 = c(1, 0, 0, 0),
x1 = c(1, 1, 0, 1), y1 = c(1, 0, 1, 1),
stringsAsFactors = FALSE)
coords <- coords[sapply(coords$direction, grepl, sides), ]
# add desired border sides as segments to the grob at specific gtable cells
grob <- gtable_add_grob(x = grob,
grobs = segmentsGrob(
x0 = coords[["x0"]], y0 = coords[["y0"]],
x1 = coords[["x1"]], y1 = coords[["y1"]],
gp = gpar(col = col, ...)
),
t = t, l = l, b = b, r = r,
clip = "off", name = "segments")
return(grob)
}
Usage:
plot_grid(add.segments(g1, "tlr"),
add.segments(g2, "lbr"),
ncol = 1, align = "v")
Another example, for aligning two plots horizontally (okay, there's no point to align these particular plots side by side, but you get the idea):
plot_grid(add.segments(g2, "tlb", col = "gold2", lty = 2, lwd = 5),
add.segments(g1, "trb", col = "gold2", lty = 2, lwd = 5),
nrow = 1, align = "h")
Related
I am using plot_grid and cowplot to arrange plots in a grid. I need to have some "empty" plots in the grid. Using NULL works fine - but the space still gets labelled. Is there a way to make NULL plots have no label automatically? I know I can do all plot labels manually.
MWE (adapted from this page)
library(ggplot2)
df <- data.frame(
x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3, y4 = (1:10)^4
)
p1 <- ggplot(df, aes(x, y1)) + geom_point()
p2 <- ggplot(df, aes(x, y2)) + geom_point()
p3 <- ggplot(df, aes(x, y3)) + geom_point()
p4 <- ggplot(df, aes(x, y4)) + geom_point()
p5 <- ggplot(mpg, aes(as.factor(year), hwy)) +
geom_boxplot() +
facet_wrap(~class, scales = "free_y")
# simple grid
plot_grid(p1, NULL, p3, p4, labels = "AUTO")
I'm looking for the behaviour you could get with plot_grid(p1, NULL, p3, p4, labels = c("A","","B","C"), but I don't want to have to set up each plot individually
Here is a potential solution using a modified cowplot::plot_grid():
plot_grid_modified <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"),
axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"),
nrow = NULL, ncol = NULL, rel_widths = 1,
rel_heights = 1, labels = NULL, label_size = 14,
label_fontfamily = NULL, label_fontface = "bold", label_colour = NULL,
label_x = 0, label_y = 1,
hjust = -0.5, vjust = 1.5, scale = 1., greedy = TRUE,
byrow = TRUE, cols = NULL, rows = NULL) {
# Make a list from the ... arguments and plotlist
plots <- c(list(...), plotlist)
num_plots <- length(plots)
if (!is.null(cols)){
warning("Argument 'cols' is deprecated. Use 'ncol' instead.")
}
if (!is.null(rows)){
warning("Argument 'rows' is deprecated. Use 'nrow' instead.")
}
scale <- rep_len(scale, num_plots)
if (sum(scale <= 0) > 1){
stop("Argument 'scale' needs to be greater than 0.")
}
# internally, this function operates with variables cols and rows instead of ncol and nrow
if (!is.null(ncol)){
cols <- ncol
}
if (!is.null(nrow)){
rows <- nrow
}
# calculate grid dimensions
if (is.null(cols) && is.null(rows)){
# if neither rows nor cols are given, we make a square grid
cols <- ceiling(sqrt(num_plots))
rows <- ceiling(num_plots/cols)
}
# alternatively, we know at least how many rows or how many columns we need
if (is.null(cols)) cols <- ceiling(num_plots/rows)
if (is.null(rows)) rows <- ceiling(num_plots/cols)
# if the user wants to layout the plots by column, we use the calculated rows to reorder plots
if (!isTRUE(byrow)) plots <- plots[c(t(matrix(c(1:num_plots, rep(NA, (rows * cols) - num_plots)), nrow = rows, byrow = FALSE)))]
# Align the plots (if specified)
grobs <- align_plots(plotlist = plots, align = align, axis = axis, greedy = greedy)
if ("AUTO" %in% labels) {
count <- 0
labels <- c()
for (idx in seq_along(plots)) {
if (!is.null(unlist(plots[idx]))) {
count <- count + 1
labels <- c(labels, LETTERS[count])
} else {
labels <- c(labels, "")
}
}
} else if ("auto" %in% labels) {
count <- 0
labels <- c()
for (idx in seq_along(plots)) {
if (!is.null(unlist(plots[idx]))) {
count <- count + 1
labels <- c(labels, letters[count])
} else {
labels <- c(labels, "")
}
}
}
# label adjustments can be provided globally for all labels
# or individually for each label
hjust <- rep_len(hjust, length(labels))
vjust <- rep_len(vjust, length(labels))
label_x <- rep_len(label_x, length(labels))
label_y <- rep_len(label_y, length(labels))
# calculate appropriate vectors of rel. heights and widths
rel_heights <- rep(rel_heights, length.out = rows)
rel_widths <- rep(rel_widths, length.out = cols)
# calculate the appropriate coordinates and deltas for each row and column
x_deltas <- rel_widths/sum(rel_widths)
y_deltas <- rel_heights/sum(rel_heights)
xs <- cumsum(rel_widths)/sum(rel_widths) - x_deltas
ys <- 1 - cumsum(rel_heights)/sum(rel_heights)
# now place all the plots
p <- ggdraw() # start with nothing
col_count <- 0
row_count <- 1
for (i in 1:(rows*cols)){
if (i > num_plots) break
x_delta <- x_deltas[col_count+1]
y_delta <- y_deltas[row_count]
x <- xs[col_count+1]
y <- ys[row_count]
# place the plot
p_next <- grobs[[i]]
if (!is.null(p_next)){
p <- p + draw_grob(p_next, x, y, x_delta, y_delta, scale[i])
}
# place a label if we have one
if (i <= length(labels)){
p <- p + draw_plot_label(labels[i], x + label_x[i]*x_delta, y + label_y[i]*y_delta, size = label_size,
family = label_fontfamily, fontface = label_fontface, colour = label_colour,
hjust = hjust[i], vjust = vjust[i])
}
# move on to next grid position
col_count <- col_count + 1
if (col_count >= cols){
col_count <- 0
row_count <- row_count + 1
}
}
p
}
library(ggplot2)
library(cowplot)
df <- data.frame(
x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3, y4 = (1:10)^4
)
p1 <- ggplot(df, aes(x, y1)) + geom_point()
p2 <- ggplot(df, aes(x, y2)) + geom_point()
p3 <- ggplot(df, aes(x, y3)) + geom_point()
p4 <- ggplot(df, aes(x, y4)) + geom_point()
p5 <- ggplot(mpg, aes(as.factor(year), hwy)) +
geom_boxplot() +
facet_wrap(~class, scales = "free_y")
# simple grid
plot_grid_modified(p1, NULL, p3, p4, labels = "AUTO")
I am trying to align three plots (with different scales on the y-axis) on the left y-axis. In other words, I would like the red axis to be aligned:
However, the y-axis of the first plot does not align with the y-axis of the bottom left plot.
Code
# Libraries
library(tidyverse)
library(cowplot)
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
combi_p2 <- plot_grid(p2, p2, nrow = 1)
plot_grid(p1, combi_p2, ncol = 1, axis = "l", align = "v")
Attempt to fix it
Using the information provided here, I rewrote the last part of the code:
require(grid) # for unit.pmax()
p1 <- ggplotGrob(p1) # convert to gtable
combi_p2 <- ggplotGrob(combi_p2) # convert to gtable
p1.widths <- p1$widths[1:3] # extract the first three widths,
# corresponding to left margin, y lab, and y axis
combi_p2.widths <- combi_p2$widths[1:3] # same for combi_p2 plot
max.widths <- unit.pmax(p1.widths, combi_p2.widths) # calculate maximum widths
p1$widths[1:3] <- max.widths # assign max. widths to p1 gtable
combi_p2$widths[1:3] <- max.widths # assign max widths to combi_p2 gtable
# plot_grid() can work directly with gtables, so this works
plot_grid(p1, combi_p2, labels = "AUTO", ncol = 1)
Sadly, I was not able to fix the alignment:
Question
How do I align the y-axis of the top plot with the left bottom plot using cowplot in R?
I think you can use ggplotGrob and put them together with gtable_rbind and gtable_cbind. Finally, you can draw the plot with grid.draw()
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
frame_g2 <- gtable_frame(g2 , debug = TRUE)
frame_combi <- gtable_frame(gtable_cbind(frame_g2,frame_g2),
width = unit(2, "null"),
height = unit(1, "null"))
frame_g1 <-
gtable_frame(
g1,
width = unit(1, "null"),
height = unit(1, "null"),
debug = TRUE
)
grid.newpage()
all_frames <- gtable_rbind(frame_g1, frame_combi)
grid.draw(all_frames)
And this is how the plot looks.
A cowplot solution by Claus O. Wilke is presented here.
It is based on the align_plot function, which first aligns the top plot with the left bottom plot along the y-axis. Then the aligned plots are passed to the plot_grid function.
# Libraries
library(tidyverse)
library(cowplot)
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
plots <- align_plots(p1, p2, align = 'v', axis = 'l')
bottom_row <- plot_grid(plots[[2]], p2, nrow = 1)
plot_grid(plots[[1]], bottom_row, ncol = 1)
I need to reproduce plots generated in InDesign in ggplot for reproducibility.
In this particular example, I have two plots that are combined into one composite plot (I have used the package {patchwork} for this).
I then need to overlay lines joining key points on one plot with the corresponding points on the bottom plot.
The two plots are generated from the same data, have the same x-axis values, but different y-axis values.
I have seen these examples on Stack Overflow, but these deal with drawing lines across facets, which doesn't work here as I'm attempting to draw lines across separate plots:
ggplot, drawing multiple lines across facets
ggplot, drawing line between points across facets
I've tried several approaches, and my closest so far has been to:
Add the lines with grobs using {grid} package
Convert the second plot to a gtable using {gtable} and set the clip of the panel to off so that I can extend the lines upwards beyond the panel of the plot.
Combine the plots again into a single image with {patchwork}.
The problem comes in the last step as the x-axes now do not line up anymore as they did before adding the lines and setting the clip to off (see example in code).
I have also tried combining the plots with ggarrange, {cowplot} and {egg} and {patchwork} comes the closest.
Following is my attempt at the best minimal reprex I can create, but still capturing the nuances of what it is I want to achieve.
library(ggplot2)
library(dplyr)
library(tidyr)
library(patchwork)
library(gtable)
library(grid)
# DATA
x <- 1:20
data <- data.frame(
quantity = x,
curve1 = 10 + 50*exp(-0.2 * x),
curve2 = 5 + 50*exp(-0.5 * x),
profit = c(seq(10, 100, by = 10),
seq(120, -240, by = -40))
)
data_long <- data %>%
gather(key = "variable", value = "value", -quantity)
# POINTS AND LINES
POINTS <- data.frame(
label = c("B", "C"),
quantity = c(5, 10),
value = c(28.39397, 16.76676),
profit = c(50, 100)
)
GROB <- linesGrob()
# Set maximum y-value to extend lines to outside of plot area
GROB_MAX <- 200
# BASE PLOTS
# Plot 1
p1 <- data_long %>%
filter(variable != "profit") %>%
ggplot(aes(x = quantity, y = value)) +
geom_line(aes(color = variable)) +
labs(x = "") +
coord_cartesian(xlim = c(0, 20), ylim = c(0, 30), expand = FALSE) +
theme(legend.justification = "top")
p1
# Plot 2
p2 <- data_long %>%
filter(variable == "profit") %>%
ggplot(aes(x = quantity, y = value)) +
geom_line(color = "darkgreen") +
coord_cartesian(xlim = c(0, 20), ylim = c(-100, 120), expand = FALSE) +
theme(legend.position = "none")
p2
# PANEL A
panel_A <- p1 + p2 + plot_layout(ncol = 1)
panel_A
# PANEL B
# ATTEMPT - adding grobs to plot 1 that end at x-axis of p1
p1 <- p1 +
annotation_custom(GROB,
xmin = 0,
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = POINTS$value[POINTS$label == "B"],
ymax = POINTS$value[POINTS$label == "B"]) +
annotation_custom(GROB,
xmin = POINTS$quantity[POINTS$label == "B"],
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = 0,
ymax = POINTS$value[POINTS$label == "B"]) +
geom_point(data = POINTS %>% filter(label == "B"), size = 1)
# ATTEMPT - adding grobs to plot 2 that extend up to meet plot 1
p2 <- p2 + annotation_custom(GROB,
xmin = POINTS$quantity[POINTS$label == "B"],
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = POINTS$profit[POINTS$label == "B"],
ymax = GROB_MAX)
# Create gtable from ggplot
g2 <- ggplotGrob(p2)
# Turn clip off for panel so that line can extend above
g2$layout$clip[g2$layout$name == "panel"] <- "off"
panel_B <- p1 + g2 + plot_layout(ncol = 1)
panel_B
# Problems:
# 1. Note the shift in axes when turning the clip off so now they do not line up anymore.
# 2. Turning the clip off mean plot 2 extends below the axis. Tried experimenting with various clips.
The expectation is that the plots in panel_B should still appear as they do in panel_A but have the joining lines linking points between the plots.
I am looking for help with solving the above, or else, alternative approaches to try out.
As a reference without running the code above - links to images as I can't post them.
Panel A
Panel B: What it currently looks like
Panel B: What I want it to look like!
My solution is a little ad hoc, but it seems to work. I based it on the following previous answer Left align two graph edges (ggplot).
I will break the solution in three parts to address some of the issues you were facing separately.
The solution that matches what you want is the third one!
First trial
Here I get the axis aligned using the same approach as this answer Left align two graph edges (ggplot).
# first trial
# plots are aligned but line in bottom plot extends to the bottom
#
p1_1 <- p1 +
annotation_custom(GROB,
xmin = 0,
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = POINTS$value[POINTS$label == "B"],
ymax = POINTS$value[POINTS$label == "B"]) +
annotation_custom(GROB,
xmin = POINTS$quantity[POINTS$label == "B"],
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = 0,
ymax = POINTS$value[POINTS$label == "B"]) +
geom_point(data = POINTS %>% filter(label == "B"), size = 1)
p2_1 <- p2 + annotation_custom(GROB,
xmin = POINTS$quantity[POINTS$label == "B"],
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = POINTS$profit[POINTS$label == "B"],
ymax = GROB_MAX)
# Create gtable from ggplot
gA <- ggplotGrob(p1_1)
gB <- ggplotGrob(p2_1)
# Turn clip off for panel so that line can extend above
gB$layout$clip[gB$layout$name == "panel"] <- "off"
# get max width of left axis between both plots
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])
# set maxWidth to both plots (to align left axis)
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
# now apply all widths from plot A to plot B
# (this is specific to your case because we know plot A is the one with the legend)
gB$widths <- gA$widths
grid.arrange(gA, gB, ncol=1)
Second trial
The problem now is that the line in the bottom plot extends beyond the plot area. One way to deal with this is to change coord_cartesian() to scale_y_continuous() and scale_x_continuous() because this will remove data that falls out of the plot area.
# second trial
# using scale_y_continuous and scale_x_continuous to remove data out of plot limits
# (this could resolve the problem of the bottom plot, but creates another problem)
#
p1_2 <- p1_1
p2_2 <- data_long %>%
filter(variable == "profit") %>%
ggplot(aes(x = quantity, y = value)) +
geom_line(color = "darkgreen") +
scale_x_continuous(limits = c(0, 20), expand = c(0, 0)) +
scale_y_continuous(limits=c(-100, 120), expand=c(0,0)) +
theme(legend.position = "none") +
annotation_custom(GROB,
xmin = POINTS$quantity[POINTS$label == "B"],
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = POINTS$profit[POINTS$label == "B"],
ymax = GROB_MAX)
# Create gtable from ggplot
gA <- ggplotGrob(p1_2)
gB <- ggplotGrob(p2_2)
# Turn clip off for panel so that line can extend above
gB$layout$clip[gB$layout$name == "panel"] <- "off"
# get max width of left axis between both plots
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])
# set maxWidth to both plots (to align left axis)
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
# now apply all widths from plot A to plot B
# (this is specific to your case because we know plot A is the one with the legend)
gB$widths <- gA$widths
# but now the line does not go all the way to the bottom y axis
grid.arrange(gA, gB, ncol=1)
Third trial
The problem now is that the line does not extend all the way to the bottom of the y-axis (because the point below y=-100 was removed). The way I solved this (very ad hoc) was to interpolate the point at y=-100 and add this to the data frame.
# third trial
# modify the data set so value data stops at bottom of plot
#
p1_3 <- p1_1
# use approx() function to interpolate value of x when y value == -100
xvalue <- approx(x=data_long$value, y=data_long$quantity, xout=-100)$y
p2_3 <- data_long %>%
filter(variable == "profit") %>%
# add row with interpolated point!
rbind(data.frame(quantity=xvalue, variable = "profit", value=-100)) %>%
ggplot(aes(x = quantity, y = value)) +
geom_line(color = "darkgreen") +
scale_x_continuous(limits = c(0, 20), expand = c(0, 0)) +
scale_y_continuous(limits=c(-100, 120), expand=c(0,0)) +
theme(legend.position = "none") +
annotation_custom(GROB,
xmin = POINTS$quantity[POINTS$label == "B"],
xmax = POINTS$quantity[POINTS$label == "B"],
ymin = POINTS$profit[POINTS$label == "B"],
ymax = GROB_MAX)
# Create gtable from ggplot
gA <- ggplotGrob(p1_3)
gB <- ggplotGrob(p2_3)
# Turn clip off for panel so that line can extend above
gB$layout$clip[gB$layout$name == "panel"] <- "off"
# get max width of left axis between both plots
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])
# set maxWidth to both plots (to align left axis)
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
# now apply all widths from plot A to plot B
# (this is specific to your case because we know plot A is the one with the legend)
gB$widths <- gA$widths
# Now line goes all the way to the bottom y axis
grid.arrange(gA, gB, ncol=1)
This makes use of facet_grid to force the x-axis to match.
grobbing_lines <- tribble(
~facet, ~x, ~xend, ~y, ~yend,
'profit', 5, 5, 50, Inf,
# 'curve', 5, 5, -Inf, 28.39397
'curve', -Inf, 5, 28.39397, 28.39397
)
grobbing_points <- tribble(
~facet, ~x, ~y,
'curve', 5, 28.39397
)
data_long_facet <- data_long%>%
mutate(facet = if_else(variable == 'profit', 'profit', 'curve'))
p <- ggplot(data_long_facet, aes(x = quantity, y = value)) +
geom_line(aes(color = variable))+
facet_grid(rows = vars(facet), scales = 'free_y')+
geom_segment(data = grobbing_lines, aes(x = x, xend = xend, y = y, yend = yend),inherit.aes = F)+
geom_point(data = grobbing_points, aes(x = x, y = y), size = 3, inherit.aes = F)
pb <- ggplot_build(p)
pg <- ggplot_gtable(pb)
#formulas to determine points in x and y locations
data2npc <- function(x, panel = 1L, axis = "x") {
range <- pb$layout$panel_params[[panel]][[paste0(axis,".range")]]
scales::rescale(c(range, x), c(0,1))[-c(1,2)]
}
data_y_2npc <- function(y, panel, axis = 'y') {
range <- pb$layout$panel_params[[panel]][[paste0(axis,".range")]]
scales::rescale(c(range, y), c(0,1))[-c(1,2)]
}
# add the new grob
pg <- gtable_add_grob(pg,
segmentsGrob(x0 = data2npc(5),
x1 = data2npc(5),
y0=data_y_2npc(50, panel = 2)/2,
y1 = data_y_2npc(28.39397, panel = 1L)+ 0.25) ,
t = 7, b = 9, l = 5)
#print to page
grid.newpage()
grid.draw(pg)
The legend and the scales are what do not match your intended output.
I have a z-scores matrix:
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
which are the result of some biological experimental data, and a corresponding p-value matrix:
p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)
Both have identical dimnames:
rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")
I'm plotting a hierarchically clustered heatmap of the z-scores like this:
hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))
require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]
require(ggplot2)
ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend,high="darkred",low="darkblue")+
theme_bw()+
theme(legend.key=element_blank(),
legend.position="right",
panel.border=element_blank(),
strip.background=element_blank(),
axis.text.x=element_text(angle=45,vjust=0.5)
)
My question is if it is possible, and how, to have on one side of the legend bar the z-score range (which is currently on the right hand) and on the other side the corresponding p-value range?
This is quite fiddly when the plot dimensions change, but you do get the required result:
br <- seq(-3, 3, 1)
lab <- round(pnorm(abs(br),lower.tail = F), 3)
p <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score), show.legend = FALSE)+
scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br)
p1 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br) +
guides(fill = guide_colorbar(title = '', label.position = 'right', barheight = 10))
p2 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br, labels = lab) +
guides(fill = guide_colorbar('', label.position = 'left', barheight = 10))
library(cowplot)
l1 <- get_legend(p1)
l2 <- get_legend(p2)
ggdraw() +
draw_plot(p, width = 0.85) +
draw_grob(l1, 0.89, 0, 0.1, 1) +
draw_grob(l2, 0.85, 0, 0.1, 1) +
draw_label('p z', 0.88, 0.675, hjust = 0)
This approach uses gtable and grid functions. It takes the legend from your plot, edits the legend so that the p values appear on the left side, then puts the edited legend back into the plot.
# Your data
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
# which are the result of some biological experimental data, and a corresponding p-value matrix:
p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)
rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")
hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))
require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]
# Your plot
require(ggplot2)
p = ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend,high="darkred",low="darkblue") +
theme_bw()+
theme(legend.key=element_blank(),
legend.position="right",
panel.border=element_blank(),
strip.background=element_blank(),
axis.text.x=element_text(angle=45,vjust=0.5))
library(gtable)
library(grid)
# Get the ggplot grob
g = ggplotGrob(p)
# Get the legend
index = which(g$layout$name == "guide-box")
leg = g$grobs[[index]]
# Get the legend labels
# and calculate corresponding p values
z.breaks = as.numeric(leg$grobs[[1]]$grobs[[3]]$label)
p.breaks = as.character(round(pnorm(abs(z.breaks), lower.tail = F), 3))
# Get the width of the longest p.break string, taking account of font and font size
w = lapply(na.omit(p.breaks), function(x) grobWidth(textGrob(x,
gp = gpar(fontsize = leg$grobs[[1]]$grobs[[3]]$gp$fontsize,
fontfamily = leg$grobs[[1]]$grobs[[3]]$gp$fontfamily))))
w = do.call(unit.pmax, w)
w = convertX(w, "mm")
# Add columns to the legend gtable to take p.breaks,
# setting the width of relevant column to w
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], leg$grobs[[1]]$widths[3], 1)
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], w, 1)
# Construct grob containing p.breaks
# Begin with the z.score grob, then make relevant changes
p.values = leg$grobs[[1]]$grobs[[3]]
p.values[c("label", "x", "hjust")] = list(p.breaks, unit(1, "npc"), 1)
# Put the p.values grob into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], p.values, t=4, l=2,
name = "p.values", clip = "off")
# Put 'p' and 'z' labels into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], list(textGrob("p"), textGrob("z")),
t=2, l=c(2,6), clip = "off")
# Drop the current legend title
leg$grobs[[1]]$grobs[[4]] = nullGrob()
# Put the legend back into the plot,
# and make sure the relevant column is wide enough to take the new legend
g$grobs[[index]] = leg
g$widths[8] = g$widths[8] + sum(leg$grobs[[1]]$widths[2:3])
# Draw the plot
grid.newpage()
grid.draw(g)
Not precisely what you described, but you could put both p values and z values into the same labels on one side of the legend:
z.breaks = c(-2,0,2)
p.breaks = pnorm(abs(z.breaks),lower.tail = F)
ggplot(clustered.mat.df,aes(x=condition,y=process)) +
geom_tile(aes(fill = z.score)) +
scale_fill_gradient2("z score (p value)", high="darkred",low="darkblue",
breaks = z.breaks,
labels = paste0(z.breaks, ' (p = ', round(p.breaks,2), ')') ) +
theme_bw() +
theme(legend.key = element_blank(),
legend.position = 'right',
panel.border = element_blank(),
strip.background = element_blank(),
axis.text.x=element_text(angle=45,vjust=0.5))
I am using the following code to make a map with proportional points to an outter characteristic (Total), but i would like to change the width of the marker.
p <- ggplot()
p <- p + geom_polygon( data=all_states, aes(x=LONG*-1, y=LAT, group = ID),colour="black", fill="white" )
p <- p + geom_point( data=mydata, aes(x=long*-1, y=lat, size = Total),color="mediumblue", shape=1) +
scale_size(range = c(1,11), name="Sells Volume")+
labs(title="Reglone SL")+
xlab(" ")+
ylab(" ")
p
Is it the thickness of the boundary of a hollow point that you want to change? It can be done with grid.edit from the grid package.
library(ggplot2)
library(grid)
ggplot(data = data.frame(x = 1:10, y = 1:10), aes(x=x, y=y)) +
geom_point(size = 10, shape = 1)
grid.force() # To make the grobs visible to grid editing tools
grid.edit("geom_point.points", grep = TRUE, gp = gpar(lwd = seq(1, 5.5, .5)))
EDIT To get legend keys to match the points
library(ggplot2)
library(grid)
library(gtable)
p = ggplot(data = data.frame(x = 1:10, y = 1:10, c = c(rep("a", 5), rep("b", 5))),
aes(x=x, y=y, colour = c)) +
geom_point(shape = 1, size = 10)
lwd = 8 # Set line width
g = ggplotGrob(p); dev.off() # Get the plot grob
# Get the indices for the legend: t = top, r = right, ...
indices <- c(subset(g$layout, name == "guide-box", select = t:r))
# Get the row number of the legend in the layout
rn <- which(g$layout$name == "guide-box")
# Extract the legend
legend <- g$grobs[[rn]]
# Get the legend keys
pointGrobs = which(grepl("points", legend$grobs[[1]]$grobs))
# Check them out - no line width set
# for (i in pointGrobs) str(legend$grobs[[1]]$grobs[[i]])
# Set line width
for (i in pointGrobs) legend$grobs[[1]]$grobs[[i]]$gp$lwd = lwd
# Check them out - line width set
# for (i in pointGrobs) str(legend$grobs[[1]]$grobs[[i]])
# Put the modified legend back into the plot grob
g = gtable_add_grob(g, legend, t=indices$t, l=indices$l)
# g$grobs[[4]]$children[[2]]$gp$lwd = lwd # Alternative for setting lwd for points in the plot
grid.newpage()
grid.draw(g)
grid.force() # To make the grobs visible to grid editing tools
grid.edit("geom_point.points", grep = TRUE, gp = gpar(lwd = lwd))