Fitting heatmap with dendrograms [duplicate] - r

With the code found at https://gist.github.com/low-decarie/5886616
A dual dendodogram tile plot can be produced:
dual_dendogram_tile_plot(as.matrix(USArrests), main="USA Arrests")
The problem: Align the vertical dendogram with the tile plot area.
(and/or improve the alignment of the horizontal dendogram)
This question relates to:
left align two graph edges (ggplot)
Specifying ggplot2 panel width
Plot correlation matrix into a graph

Here's an example to align more basic grobs,
library(ggplot2)
library(grid)
library(gtable)
p <- qplot(1,1)
g <- ggplotGrob(p)
panel_id <- g$layout[g$layout$name == "panel",c("t","l")]
g <- gtable_add_cols(g, unit(1,"cm"))
g <- gtable_add_grob(g, rectGrob(gp=gpar(fill="red")),
t = panel_id$t, l = ncol(g))
g <- gtable_add_rows(g, unit(1,"in"), 0)
g <- gtable_add_grob(g, rectGrob(gp=gpar(fill="blue")),
t = 1, l = panel_id$l)
grid.newpage()
grid.draw(g)
and with your grobs

The answer from #baptiste helped me get a better understanding of the gtable structure and how to modify it. Below I post just my modified variant as code snippet for (my own) reuse.
It is using find_panel() to get the panel extent, and pipes %>% the modifications directly into grid.draw. The piping considerably simplified playing around with the gtable_* functions, as it allows to easily uncomment single lines and check the effect on the final plot.
library(ggplot2)
library(grid)
library(gtable)
library(dplyr)
p <- ggplot(tribble(~x,~y,~a,~b,
1, 1, "a1","b1",
1, 1, "a2","b1",
1, 1, "a2","b2"),
aes(x=x,y=y)) +
geom_point() +
facet_grid(vars(a),vars(b))
g <- ggplotGrob(p)
panels_extent <- g %>% find_panel()
g %>%
# Add red box to the very right, by appending a column and then filling it
gtable_add_cols(widths = unit(1,"cm"), pos = -1) %>%
gtable_add_grob(rectGrob(gp=gpar(fill="red")),
t = panels_extent$t, b = panels_extent$b,
l = -1, r = -1) %>%
# Add green box to the top, by prepending a row and then filling it
# Note the green box extends horizontally over the first panel as well
# as the space in between.
gtable_add_rows(heights = unit(1,"cm"), pos = 0) %>%
gtable_add_grob(rectGrob(gp=gpar(fill="green")),
t = 1, b = 1,
l = panels_extent$l, r = panels_extent$l+1) %>%
{grid.newpage();grid.draw(.)}

Related

Extend axis limits without plotting (in order to align two plots by x-unit)

I am trying to combine two ggplot objects with patchwork - two plots with different subsets of data, but the same x variable (and therefore same unit). I would like to align the plots according to the x values - Each x unit should have the same physical width in the final plot.
This is very easy when actually plotting the entire width of the larger data set (see plot below) - but I struggle to plot only parts of the data and keeping the same alignment.
library(ggplot2)
library(patchwork)
library(dplyr)
p1 <-
ggplot(mtcars, aes(mpg)) +
geom_density(trim = TRUE) +
scale_x_continuous(limits = c(10,35))
p2 <-
ggplot(filter(mtcars, mpg < 20), aes(mpg)) +
geom_histogram(binwidth = 1, boundary = 1) +
scale_x_continuous(limits = c(10,35))
p1/p2
Created on 2019-08-07 by the reprex package (v0.3.0)
The desired output
That's photoshopped
adding coord_cartesian(xlim = c(10,(20 or 35)), clip = 'off'), and/or changing scale_x limits to c(0,(20 or 35)) doesn't work.
patchwork also won't let me set the widths of both plots when they are in two rows, which makes sense in a way. So I could create an empty plot for the second row and set the widths for those, but this seems a terrible hack and I feel there must be a much easier solution.
I am not restricted to patchwork, but any solution allowing to use it would be very welcome.
I modified the align_plots function from the cowplot package for this, so that its plot_grid function can now support adjustments to the dimensions of each plot.
(The main reason I went with cowplot rather than patchwork is that I haven't had much tinkering experience with the latter, and overloading common operators like + makes me slightly nervous.)
Demonstration of results
# x / y axis range of p1 / p2 have been changed for illustration purpose
p1 <- ggplot(mtcars, aes(mpg, 1 + stat(count))) +
geom_density(trim = TRUE) +
scale_x_continuous(limits = c(10,35)) +
coord_cartesian(ylim = c(1, 3.5))
p2 <- ggplot(filter(mtcars, mpg >= 15 & mpg < 30), aes(mpg)) +
geom_histogram(binwidth = 1, boundary = 1)
plot_grid(p1, p2, ncol = 1, align = "v") # plots in 1 column, x-axes aligned
plot_grid(p1, p2, nrow = 1, align = "h") # plots in 1 row, y-axes aligned
Plots in 1 column (x-axes aligned for 15-28 range):
Plots in 1 row (y-axes aligned for 1 - 3.5 range):
Caveats
This hack assumes the plots that the user intends to align (either horizontally or vertically) have reasonably similar axes of comparable magnitude. I haven't tested it on more extreme cases.
This hack expects simple non-faceted plots in Cartesian coordinates. I'm not sure what one could expect from aligning faceted plots. Similarly, I'm not considering polar coordinates (what's there to align?) or map projections (haven't looked into this, but they feel rather complicated).
This hack expects the gtable cell containing the plot panel to be in the 7th row / 5th column of the gtable object, which is based on my understanding of how ggplot objects are typically converted to gtables, and may not survive changes to the underlying code.
Code
Modified version of cowplot::align_plots:
align_plots_modified <- function (..., plotlist = NULL, align = c("none", "h", "v", "hv"),
axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"),
greedy = TRUE) {
plots <- c(list(...), plotlist)
num_plots <- length(plots)
grobs <- lapply(plots, function(x) {
if (!is.null(x)) as_gtable(x)
else NULL
})
halign <- switch(align[1], h = TRUE, vh = TRUE, hv = TRUE, FALSE)
valign <- switch(align[1], v = TRUE, vh = TRUE, hv = TRUE, FALSE)
vcomplex_align <- hcomplex_align <- FALSE
if (valign) {
# modification: get x-axis value range associated with each plot, create union of
# value ranges across all plots, & calculate the proportional width of each plot
# (with white space on either side) required in order for the plots to align
plot.x.range <- lapply(plots, function(x) ggplot_build(x)$layout$panel_params[[1]]$x.range)
full.range <- range(plot.x.range)
plot.x.range <- lapply(plot.x.range,
function(x) c(diff(c(full.range[1], x[1]))/ diff(full.range),
diff(x)/ diff(full.range),
diff(c(x[2], full.range[2]))/ diff(full.range)))
num_widths <- unique(lapply(grobs, function(x) {
length(x$widths)
}))
num_widths[num_widths == 0] <- NULL
if (length(num_widths) > 1 || length(grep("l|r", axis[1])) > 0) {
vcomplex_align = TRUE
warning("Method not implemented for faceted plots. Placing unaligned.")
valign <- FALSE
}
else {
max_widths <- list(do.call(grid::unit.pmax,
lapply(grobs, function(x) {x$widths})))
}
}
if (halign) {
# modification: get y-axis value range associated with each plot, create union of
# value ranges across all plots, & calculate the proportional width of each plot
# (with white space on either side) required in order for the plots to align
plot.y.range <- lapply(plots, function(x) ggplot_build(x)$layout$panel_params[[1]]$y.range)
full.range <- range(plot.y.range)
plot.y.range <- lapply(plot.y.range,
function(x) c(diff(c(full.range[1], x[1]))/ diff(full.range),
diff(x)/ diff(full.range),
diff(c(x[2], full.range[2]))/ diff(full.range)))
num_heights <- unique(lapply(grobs, function(x) {
length(x$heights)
}))
num_heights[num_heights == 0] <- NULL
if (length(num_heights) > 1 || length(grep("t|b", axis[1])) > 0) {
hcomplex_align = TRUE
warning("Method not implemented for faceted plots. Placing unaligned.")
halign <- FALSE
}
else {
max_heights <- list(do.call(grid::unit.pmax,
lapply(grobs, function(x) {x$heights})))
}
}
for (i in 1:num_plots) {
if (!is.null(grobs[[i]])) {
if (valign) {
grobs[[i]]$widths <- max_widths[[1]]
# modification: change panel cell's width to a proportion of unit(1, "null"),
# then add whitespace to the left / right of the plot's existing gtable
grobs[[i]]$widths[[5]] <- unit(plot.x.range[[i]][2], "null")
grobs[[i]] <- gtable::gtable_add_cols(grobs[[i]],
widths = unit(plot.x.range[[i]][1], "null"),
pos = 0)
grobs[[i]] <- gtable::gtable_add_cols(grobs[[i]],
widths = unit(plot.x.range[[i]][3], "null"),
pos = -1)
}
if (halign) {
grobs[[i]]$heights <- max_heights[[1]]
# modification: change panel cell's height to a proportion of unit(1, "null"),
# then add whitespace to the bottom / top of the plot's existing gtable
grobs[[i]]$heights[[7]] <- unit(plot.y.range[[i]][2], "null")
grobs[[i]] <- gtable::gtable_add_rows(grobs[[i]],
heights = unit(plot.y.range[[i]][1], "null"),
pos = -1)
grobs[[i]] <- gtable::gtable_add_rows(grobs[[i]],
heights = unit(plot.y.range[[i]][3], "null"),
pos = 0)
}
}
}
grobs
}
Utilising the above modified function with cowplot package's plot_grid:
# To start using (in current R session only; effect will not carry over to subsequent session)
trace(cowplot::plot_grid, edit = TRUE)
# In the pop-up window, change `grobs <- align_plots(...)` (at around line 27) to
# `grobs <- align_plots_modified(...)`
# To stop using
untrace(cowplot::plot_grid)
(Alternatively, we can define a modified version of plot_grid function that uses align_plots_modified instead of cowplot::align_plots. Results would be the same either way.)
Here is an option with grid.arrange that does not use a blank plot, but requires a manual of adjustment of:
plot margin
x axis expansion
number of decimal places in y axis labels
library(ggplot2)
library(dplyr)
library(gridExtra)
p1 <-
ggplot(mtcars, aes(mpg)) +
geom_density(trim = TRUE) +
scale_x_continuous(limits = c(10,35), breaks=seq(10,35,5), expand = expand_scale(add=c(0,0)))
p2 <-
ggplot(filter(mtcars, mpg < 20), aes(mpg)) +
geom_histogram(binwidth = 1, boundary = 1) +
scale_x_continuous(limits = c(10,20), breaks=seq(10,20,5), expand = expand_scale(add=c(0,0))) +
scale_y_continuous(labels = scales::number_format(accuracy = 0.01)) +
theme(plot.margin = unit(c(0,1,0,0), "cm"))
grid.arrange(p1, p2,
layout_matrix = rbind(c(1, 1), c(2, NA))
)
Should make this plot:

y-axis for each subplot using facet_grid

I can't get the answer to this question to work.
What both me and that user want is to add axis ticks and labels to all columns when using facet_grid().
Display y-axis for each subplot when faceting
When I run the reproducable example and the solution (after adding abc=as.data.frame(abc) to fix the initial error) I receive an error message
Error in gtable_add_grob(g, grobs = list(segmentsGrob(1, 0, 1, 1),
segmentsGrob(1, : Not all inputs have either length 1 or same
length same as 'grobs
I made my own reproducible example because the original one is ehhm, a bit odd :-). It results in the same error message
require(ggplot2)
require(reshape)
require(grid)
require(gtable)
data(iris)
iris$category=rep(letters[1:4],length.out=150)
plot1=ggplot(data=iris,aes(x=1,y=Sepal.Width))+geom_boxplot()+facet_grid(Species~category)
The answer should be this:
g <- ggplotGrob(plot1)
require(gtable)
axis <- gtable_filter(g, "axis-l")[["grobs"]][[1]][["children"]][["axis"]][,2]
segment <- segmentsGrob(1,0,1,1)
panels <- subset(g$layout, name == "panel")
g <- gtable_add_grob(g, grobs=list(axis, axis), name="ticks",
t = unique(panels$t), l=tail(panels$l, -1)-1)
g <- gtable_add_grob(g, grobs=list(segmentsGrob(1,0,1,1),
segmentsGrob(1,0,1,1)),
t = unique(panels$t), l=tail(panels$l, -1)-1,
name="segments")
The answer you refer to does not apply to your situation.
To get nice placement of the tick marks and tick mark labels, I would add columns to the gtable to take the axis material. The new columns have the same width as the original y axis.
You might want to add more margin space between the panels. Do so with theme(panel.margin.x = unit(1, "lines")).
require(ggplot2)
require(grid)
require(gtable)
data(iris)
iris$category = rep(letters[1:4], length.out = 150)
plot1 = ggplot(data = iris, aes(x = 1, y = Sepal.Width))+
geom_boxplot()+
facet_grid(Species~category)
# Get the ggplot grob
g <- ggplotGrob(plot1)
# Get the yaxis
yaxis <- gtable_filter(g, "axis-l")
# Get the width of the y axis
Widths = yaxis$widths
# Add columns to the gtable to the left of the panels,
# with a width equal to yaxis width
panels <- g$layout[grepl("panel", g$layout$name), ]
pos = rev(unique(panels$l)[-1] - 1)
for(i in pos) g = gtable_add_cols(g, Widths, i)
# Add y axes to the new columns
panels <- g$layout[grepl("panel", g$layout$name), ]
posx = rev(unique(panels$l)[-1] - 1)
posy = unique(panels$t)
g = gtable_add_grob(g, rep(list(yaxis), length(posx)),
t = rep(min(posy), length(posx)), b = rep(max(posy), length(posx)), l = posx)
# Draw it
grid.newpage()
grid.draw(g)
Alternatively, place the axis in a viewport of the same width as the original y axis, but with right justification. Then, add the resulting grob to the existing margin columns between the panels, adjusting the width of those columns to suit.
require(ggplot2)
require(grid)
require(gtable)
data(iris)
iris$category = rep(letters[1:4], length.out = 150)
plot1 = ggplot(data = iris, aes(x = 1, y = Sepal.Width))+
geom_boxplot() +
facet_grid(Species ~ category )
# Get the ggplot grob
g <- ggplotGrob(plot1)
# Get the yaxis
axis <- gtable_filter(g, "axis-l")
# Get the width of the y axis
Widths = axis$width
# Place the axis into a viewport,
# of width equal to the original yaxis material,
# and positioned to be right justified
axis$vp = viewport(x = unit(1, "npc"), width = Widths, just = "right")
# Add y axes to the existing margin columns between the panels
panels <- g$layout[grepl("panel", g$layout$name), ]
posx = unique(panels$l)[-1] - 1
posy = unique(panels$t)
g = gtable_add_grob(g, rep(list(axis), length(posx)),
t = rep(min(posy), length(posx)), b = rep(max(posy), length(posx)), l = posx)
# Increase the width of the margin columns
g$widths[posx] <- unit(25, "pt")
# Or increase width of the panel margins in the original construction of plot1
# Draw it
grid.newpage()
grid.draw(g)
This is what I came up (using ggplot2_2.1.0):
g <- ggplotGrob(plot1)
axis <- gtable_filter(g, "axis-l")
newG <- gtable_add_grob(g, list(axis, axis, axis),
t = rep(4, 3), b = rep(8, 3), l = c(5, 7, 9))
grid.draw(newG)
..Which looks like this:
This is the process I went through:
g <- ggplotGrob(plot1) Create a gtable.
print(g) Look over the elements of the gtable...I'm looking for the names of the grobs that I want to mess around with. Here, it is the three grobs called "axis-l".
axis <- gtable_filter(g, "axis-l") I select my three grobs from the larger gtable object, g, and save them in a gtable called axis. Note that gtable_filter is actually selecting the grobs, not filtering them from g.
gtable_show_layout(g) Look over the layout of g so I can figure out where I want to put axis in relationship to the overall plot.
gtable_add_grob, etc. Now that I know where I'm going with it, I can append the original plot with axis.
I think that those steps are a pretty common workflow when it comes to gtable. Of course you'll have other stuff that you may what to mess around with. For example, the space that is given for all but the left-most y axis labels is not sufficient in this case. So maybe just:
newG$widths[c(5, 7, 9)] <- grid:::unit.list(axis$widths) # you won't need to wrap this in grid
grid.draw(newG)

Figure caption scientific names + symbols in textGrob gtable

First of all I would like to thank Sir Baptiste for helping me improve my R script by adding a caption at the bottom left the of the combined plots using gtable/textGrob as shown below:
library(grid)
library(gridExtra)
library(ggplot2)
p1 <- p2 <- ggplot()
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
g <- rbind(g1, g2)
caption <- textGrob("Figure 1. This is a caption", hjust=0, x=0)
g <- gtable::gtable_add_rows(g, unit(2,"mm") + grobHeight(caption), -1)
g <- gtable::gtable_add_grob(g, caption, nrow(g), l = 4, r = ncol(g))
grid.newpage()
grid.draw(g)
However, I want to add two more things:
(1) Insert a scientific name to the caption, which should be written in italics.
- For example, based on the caption mentioned above, I want to italize only the word "is" while the rest are in plain text.
(2) I will also add symbols in the caption, e.g. point shapes=c(1,22); colours=c("black", "red"); fill=c("red", "black").
How am I going to do these? I am a novice user of R program, hence your help is much appreciated. Thank you.
UPDATE:
I have already addressed query 1 with the help of #Docconcoct, #user20650 and #baptiste using this script:
library(grid)
library(gridExtra)
library(ggplot2)
g1 <- ggplotGrob(pl)
g2 <- ggplotGrob(pl1)
g <- rbind(g1, g2)
caption <- textGrob(expression(paste("Figure 1. This", italic(" is"), " a caption")), hjust=0, x=0)
g <- gtable::gtable_add_rows(g, unit(2,"mm") + grobHeight(caption), -1)
g <- gtable::gtable_add_grob(g, caption, nrow(g), l = 4, r = ncol(g))
grid.newpage()
grid.draw(g)
For query 2, as stated by Sir #baptiste, in my original email to him, I already have a legend on the combined plots. However, in the figure caption, I need to state what are those symbols in the legend mean, and some other details of the plot. Based on the example given by Sir baptiste, I need to include what supp means, as well as the symbols of OJ (dark circle) and VC (dark triangle) in the caption.
Again, many thanks!
Based on the comments, I suggest the following strategy: create a dummy plot with your figure caption (text) as legend title, extract its legend, and place it at the bottom of your gtable.
library(grid)
library(gridExtra)
library(ggplot2)
library(gtable)
p1 <- ggplot()
p2 <- ggplot(ToothGrowth, aes(len, dose, shape=supp)) + geom_point() +
theme(legend.position="bottom",
legend.background=element_rect(colour="black"))
title <- expression("Figure 1. This "*italic(is)*" now a legendary caption")
dummy <- ggplotGrob(p2 + guides(shape = guide_legend(title = title)))
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
caption <- gtable_filter(dummy,"guide")[["grobs"]][[1]]
caption$widths <- grid:::unit.list(caption$widths)
caption$widths <- unit.c(unit(0,"mm"), caption$widths[2], unit(1,"null"))
g <- rbind(g1, g2)
g <- gtable::gtable_add_rows(g, unit(2,"mm") + grobHeight(caption), -1)
g <- gtable::gtable_add_grob(g, caption, nrow(g), l = 4, r = ncol(g))
grid.newpage()
grid.draw(legend)
grid.draw(g)
I think a good solution would rely on LaTeX or similar for the text rendering and particularly the tricky issue of line-wrapping, but something could be designed at R level to facilitate the inclusion of plotting symbols that correspond to a given graphic. Something along those lines,
gl = extract_legend_grobs(p)
caption = caption_plot("Figure 1. We are referring to the points {{gl$points[supp == OG'']}}.
The theoretical model is shown as {{gl$lines[type == 'theory']}}.", gl)
print(caption, output="latex")
## "Figure 1. We are referring to the points \includegraphics{gl_p_1.png}.
## The theoretical model is shown as \includegraphics{gl_l_1.png}."
Interesting thought, but probably a lot of work to get it right.
A quick-and-dirty R graphics output could also be devised, though it's uncommon to want captions to be part of the figure (and R graphics isn't particularly good with text).
Here's a weak attempt at making a caption grob mixing symbols and text. Ideally the text would be split into individual words first (to offer more options for line breaks), but plotmath expressions make it inconvenient.
Next step would be to add a few convenient wrappers to generate common symbols, and to interleave the two lists of grobs.
library(grid)
library(gridExtra)
inwidth <- function(x, margin=unit(1,"mm")) {
if(inherits(x, "text"))
convertWidth(grobWidth(x)+margin, "in", valueOnly = TRUE) else
convertWidth(unit(1,"line")+margin, "in", valueOnly = TRUE)
}
captionGrob <- function(..., width = unit(4, "in"), debug = FALSE){
maxw <- convertWidth(width, "in", valueOnly = TRUE)
lg <- list(...)
lw <- lapply(lg, inwidth)
stopifnot(all(lw < maxw))
# find breaks
cw <- cumsum(lw)
bks <- which(c(0, diff(cw %% maxw)) < 0 )
# list of lines
tg <- list()
starts <- c(1, bks)
ends <- c(bks -1, length(lg))
for(line in seq_along(starts)){
ids <- seq(starts[line], ends[line])
sumw <- do.call(sum,lw[ids])
neww <- maxw - sumw # missing width to fill
filler <- rectGrob(gp=gpar(col=NA, fill=NA),
width=unit(neww, "in"),
height=unit(1, "line"))
grobs <- c(lg[ids], list(filler))
# store current line
tg[[line]] <- arrangeGrob(grobs=grobs, nrow = 1,
widths = unit(c(lw[ids], neww), "in"))
}
# arrange all lines in one column
grid.arrange(grobs=tg, ncol=1,
heights = unit(rep(1, length(tg)), "line"))
if(debug) grid.rect(width=width, gp=gpar(fill=NA, lty=2))
}
tg <- lapply(c(expression(bold(Figure~1.)~italic(Those)~points),
"are important, ", "nonetheless", "and", "have value too."),
textGrob)
pGrob <- function(fill, size=1, ...){
rectGrob(..., width=unit(size,"line"), height=unit(size,"line"), gp=gpar(fill=fill))
}
pg <- mapply(pGrob, fill=1:5, size=0.5, SIMPLIFY = FALSE)
grid.newpage()
captionGrob(tg[[1]], pg[[1]], pg[[2]], pg[[3]], tg[[2]], tg[[3]], pg[[4]], tg[[4]], pg[[5]], tg[[5]])

how to make the biplot name more clear using ggbiplot

I have a data which can be download from here
https://gist.github.com/anonymous/5f1135e4f750a39b0255
I try to plot a PCA with ggbiplot using the following function
data <- read.delim("path to the data.txt")
data.pca <- prcomp (data, center = TRUE, scale =TRUE)
library(ggbiplot)
g <- ggbiplot(data.pca, obs.scale =1, var.scale=1, ellipse = TRUE, circle=TRUE)
g <- g + scale_color_discrete(name='')
g <- g + theme(legend.direction = 'horizontal', legend.position = 'top')
print(g)
however, it is very difficult to see the biplot lines names,
is there any way to make it more clear or show it better ?
I think a way to make it clearer is to adjust the size and position of the labels using the varname.sizeand varname.adjust arguments. However, with a lot of variables it still looks crowded. By increasing the length of the arrows (similar to stats::biplot()), makes it look somewhat better (imo)
# install ggbiplot
#require(devtools)
#install_github('ggbiplot','vqv')
library(httr)
library(ggbiplot)
# read data
url <- "https://gist.githubusercontent.com/anonymous/5f1135e4f750a39b0255/raw/data.txt"
dat <- read.table(text=content(GET(url), as="text"), header=TRUE)
# pca
data.pca <- prcomp (dat, center = TRUE, scale =TRUE)
# original plot + increase labels size and space from line
p <- ggbiplot(data.pca, obs.scale=1,
var.scale=1, circle=F,
varname.size=4, varname.adjust=2)
p
# use coord_equal() to change size ratio of plot (excludes use of circle)
p <- p + coord_equal(1.5) + theme_classic()
p
To extend the arrows, the x and y coordinates need to be recalculated. You can then use these to edit the relevant grobs, and change any other parameter (colour, size, rotation etc). (you could go the whole ggplotGrob(p) approach, but just use grid.edit() below.)
# function to rescale the x & y positions of the lines and labels
f <- function(a0, a1, M=M)
{
l <- lapply(as.list(environment()), as.numeric)
out <- M* (l$a1 - l$a0) + l$a0
grid::unit(out, "native")
}
# get list of grobs in current graphics window
grobs <- grid.ls(print=FALSE)
# find segments grob for the arrows
s_id <- grobs$name[grep("segments", grobs$name)]
# edit length and colour of lines
seg <- grid.get(gPath(s_id[2]))
grid.edit(gPath(s_id[2]),
x1=f(seg$x0, seg$x1, 2),
y1=f(seg$y0, seg$y1, 2),
gp=gpar(col="red"))
# find text grob for the arrow labels
lab_id <- grobs$name[grep("text", grobs$name)]
# edit position of text, and rotate and colour labels
seg2 <- grid.get(gPath(lab_id))
grid.edit(gPath(lab_id),
x=f(seg$x0, seg2$x, 2),
y=f(seg$y0, seg2$y, 2),
rot=0,
gp=gpar(col="red"))
Subjective if this makes it better, and perhaps it is easier just to use biplot() or even define a new function

Juxtapose tableGrob with ggplot2 y-axis

Is there an elegant way to align the tableGrob rows with the axis breaks?
I would like to juxtapose a tableGrob and ggplot chart in R (I need to reproduce some SAS output used in previous versions of a public report). Like this minimal reproducible example:
This post got me pretty far --- the tableGrob is in the same gtable row as the body of the chart; however, it requires lots of manual fiddling to get the rows in the tableGrob to line up with the axis labels.
I also found this post. Since I'm Sweaving a public report, I would prefer not to use code that isn't readily available in a package on CRAN. That being said, the experimental version of tableGrob appears to accept heights as an argument. If this code will do the trick, and I do choose to use this experimental version, how would I calculate the appropriate row heights?
If there is not an elegant way of doing this, I found these tricks to be helpful:
set fontsize AND cex in tableGrob to match ggplot2
set padding.v to space table rows in tableGrob
modify coordinate limits to accomodate column labels and align with bottom of last row
My MRE code:
library(ggplot2)
library(gridExtra)
library(gtable)
theme_set(theme_bw(base_size = 8))
df <- head(mtcars,10)
df$cars <- row.names(df)
df$cars <- factor(df$cars, levels=df$cars[order(df$disp, decreasing=TRUE)], ordered=TRUE)
p <- ggplot(data=df, aes(x=hp, y=cars)) +
geom_point(aes(x=hp, y=cars)) +
scale_y_discrete(limits=levels(df$cars))+
theme(axis.title.y = element_blank()) +
coord_cartesian(ylim=c(0.5,length(df$cars)+1.5))
t <- tableGrob(df[,c("mpg","cyl","disp","cars")],
cols=c("mpg","cyl","disp","cars"),
gpar.coretext = gpar(fontsize = 8, lineheight = 1, cex = 0.8),
gpar.coltext = gpar(fontsize = 8, lineheight = 1, cex = 0.8),
show.rownames = FALSE,
show.colnames = TRUE,
equal.height = TRUE,
padding.v = unit(1.65, "mm"))
g <- NULL
g <- ggplotGrob(p)
g <- gtable_add_cols(g, unit(2,"in"), 0)
g <- gtable_add_grob(g, t, t=3, b=3, l=1, r=1)
png('./a.png', width = 5, height = 2, units = "in", res = 100)
grid.draw(g)
dev.off()
I have left the car names on the y-axis breaks for troubleshooting purposes, but ultimately I will remove them.
There's now this experimental version of gtable_table
table <- gtable_table(df[,c("mpg","cyl","disp","cars")],
heights = unit(rep(1,nrow(df)), "null"))
g <- ggplotGrob(p)
g <- gtable_add_cols(g, sum(table$widths), 0)
g <- gtable_add_grob(g, table, t=3, b=3, l=1, r=1)
grid.newpage()
grid.draw(g)
#Baptiste's answer expanded to demonstrate column labels and cell parameters:
library(ggplot2)
library(gridExtra)
## I manually changed the dependency on
install.packages(".//gtable_0.2.tar.gz", repos = NULL, type="source")
## The forked version of gtable requires R version 3.2.0
## which is currently in development (as of 9/17/2014) due to change in grid
## (https://github.com/wch/r-source/commit/850a82c30e91feb47a0b6385adcbd82988d90413)
## I have not installed the development version.
## However, I was able, in limited testing, to get this to work with R 3.1.0
## and ggplot2_1.0.0
## YRMV
## The following code, commented out, may be more useful with release of R 3.2.0
## library(devtools)
## devtools::install_github("baptiste/gtable")
library(gtable)
theme_set(theme_bw(base_size = 10))
df <- mtcars
df$cars <- row.names(df)
df <- head(df[,c("mpg","cyl","disp","cars")],10)
df$cars <- factor(df$cars, levels=df$cars[order(df$disp, decreasing=TRUE)], ordered=TRUE)
p <- ggplot(data=df, aes(x=disp, y=cars)) +
geom_point(aes(x=disp, y=cars)) +
scale_y_discrete(limits=levels(df$cars))+
theme(axis.title.y = element_blank()) +
coord_cartesian(ylim = c(0.5,nrow(df)+1))
core <- gtable_table(df[order(df$disp, decreasing=FALSE),],
fg.par = list(fontsize=c(8)),
bg.par = list(fill=c(rep("lightblue",4),rep("white",4)), alpha=0.5),
heights = unit(rep(1,nrow(df)), "null"))
colHead <- gtable_table(t(colnames(df)),
fg.par = list(fontsize=c(8)),
bg.par = list(fill=c(1), alpha=0.2),
heights = unit(0.5, "null"))
table1 <- rbind(colHead, core)
g <- ggplotGrob(p)
g <- gtable_add_cols(g, sum(table1$widths), 0)
g <- gtable_add_grob(g, table1, t=3, b=3, l=1, r=1)
grid.newpage()
grid.draw(g)

Resources