I am having a problem to increase the size and add a label for x axis when I use grid.arrange.
I asked a question here how can I make my data side by side barplot with dots which the answer is sufficient and I accepted it.
At the end of the code, I should glue three parts together like this
library(gridExtra)
gg1 <- ggplot_gtable(ggplot_build(g1))
gg2 <- ggplot_gtable(ggplot_build(g2))
gg.mid <- ggplot_gtable(ggplot_build(g.mid))
grid.arrange(gg1,gg.mid,gg2,ncol=3,widths=c(4/9,1/9,4/9))
I want to add a Label for it but I could not find a way to do this. I also searched and I found only one related post
Universal x axis label and legend at bottom using grid.arrange
and I tried to assigned my grid.arrangeto a variable and then
p <- grid.arrange(gg1,gg.mid,gg2,ncol=3,widths=c(4/9,1/9,4/9))
p <- arrangeGrob(p, textGrob("my label", gp=gpar(fontsize=12)))
print(p)
but the problem is not solved. Any idea how to add such a label for it?
g1 <- g.mid <- g2 <- ggplot()
grid.arrange(g1,g.mid,g2,ncol=3,widths=c(4/9,1/9,4/9),
bottom=textGrob("x axis title", gp=gpar(fontsize=22)))
Edit: perhaps the easiest way to control margins is to wrap the grob in a 3x3 gtable,
titleGrob <- function(label, margin=unit(c(b=5, l=0, t=2, r=0), "line"), ..., debug=FALSE){
library(gtable)
tg <- textGrob(label, ...)
w <- grobWidth(tg)
h <- grobHeight(tg)
g <- gtable("title",
widths = unit.c(margin[2], w, margin[4]),
heights = unit.c(margin[3], h, margin[1]), respect = FALSE)
if(debug){
rg <- rectGrob()
pos <- expand.grid(x=1:3, y=1:3)[-5,]
g <- gtable_add_grob(g, list(rg, rg, rg, rg, rg, rg, rg, rg), t=pos$y, l=pos$x)
}
gtable_add_grob(g, tg, t=2, l = 2)
}
grid.arrange(g1,g.mid,g2,ncol=3,widths=c(4/9,1/9,4/9),
bottom=titleGrob("x axis title", gp=gpar(fontsize=22), debug=FALSE))
Related
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)
tl;dr can't get a standalone legend (describing common colours across the whole plot) in ggpairs to my satisfaction.
Sorry for length.
I'm trying to draw a (lower-triangular) pairs plot using GGally::ggpairs (an extension package for drawing various kinds of plot matrices with ggplot2). This is essentially the same question as How to add an external legend to ggpairs()? , but I'm not satisfied with the answer to that question aesthetically, so I'm posting this as an extension (if suggested/recommended by commenters, I will delete this question and offer a bounty on that question instead). In particular, I would like the legend to appear outside the sub-plot frame, either putting it within one virtual subplot but allowing additional width to hold it, or (ideally) putting it in a separate (empty) subplot. As I show below, both of my partial solutions have problems.
Fake data:
set.seed(101)
dd <- data.frame(x=rnorm(100),
y=rnorm(100),
z=rnorm(100),
f=sample(c("a","b"),size=100,replace=TRUE))
library(GGally)
Base plot function:
ggfun <- function(...) {
ggpairs(dd,mapping = ggplot2::aes(color = f),
columns=1:3,
lower=list(continuous="points"),
diag=list(continuous="blankDiag"),
upper=list(continuous="blank"),
...)
}
Function to trim top/right column:
trim_gg <- function(gg) {
n <- gg$nrow
gg$nrow <- gg$ncol <- n-1
v <- 1:n^2
gg$plots <- gg$plots[v>n & v%%n!=0]
gg$xAxisLabels <- gg$xAxisLabels[-n]
gg$yAxisLabels <- gg$yAxisLabels[-1]
return(gg)
}
gg0 <- trim_gg(ggfun(legends=TRUE))
Get rid of legends in left column (as in the linked question above):
library(ggplot2) ## for theme()
for (i in 1:2) {
inner <- getPlot(gg0,i,1)
inner <- inner + theme(legend.position="none")
gg0 <- putPlot(gg0,inner,i,1)
}
inner <- getPlot(gg0,2,2)
inner <- inner + theme(legend.position="right")
gg0 <- putPlot(gg0,inner,2,2)
Problems:
the blank panel behind the legend is actually masking some points; I don't know why it's not outside the panel as usual, I assume that's something that ggpairs is doing
if it were outside the panel (on top or to the right), I would want to make sure to leave some extra space so the panels themselves were all the same size. However, ggmatrix/ggpairs looks very inflexible about this.
The only alternative I've been able to try to far is following ggplot separate legend and plot by extracting the legend and using gridExtra::grid.arrange():
g_legend <- function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
library(gridExtra)
grid.arrange(getPlot(gg0,1,1),
g_legend(getPlot(gg0,2,2)),
getPlot(gg0,2,1),
getPlot(gg0,2,2)+theme(legend.position="none"),
nrow=2)
Problems:
the axes and labels suppressed by ggpairs are back ...
I also considered creating a panel with a special plot that contained only the legend (i.e. trying to use theme(SOMETHING=element.blank) to suppress the plot itself, but couldn't figure out how to do it.
As a last resort, I could trim the axes where appropriate myself, but this is practically reinventing what ggpairs is doing in the first place ...
With some slight modification to solution 1: First, draw the matrix of plots without their legends (but still with the colour mapping). Second, use your trim_gg function to remove the diagonal spaces. Third, for the plot in the top left position, draw its legend but position it into the empty space to the right.
data(state)
dd <- data.frame(state.x77,
State = state.name,
Abbrev = state.abb,
Region = state.region,
Division = state.division)
columns <- c(3, 5, 6, 7)
colour <- "Region"
library(GGally)
library(ggplot2) ## for theme()
# Base plot
ggfun <- function(data = NULL, columns = NULL, colour = NULL, legends = FALSE) {
ggpairs(data,
columns = columns,
mapping = ggplot2::aes_string(colour = colour),
lower = list(continuous = "points"),
diag = list(continuous = "blankDiag"),
upper = list(continuous = "blank"),
legends = legends)
}
# Remove the diagonal elements
trim_gg <- function(gg) {
n <- gg$nrow
gg$nrow <- gg$ncol <- n-1
v <- 1:n^2
gg$plots <- gg$plots[v > n & v%%n != 0]
gg$xAxisLabels <- gg$xAxisLabels[-n]
gg$yAxisLabels <- gg$yAxisLabels[-1]
return(gg)
}
# Get the plot
gg0 <- trim_gg(ggfun(dd, columns, colour))
# For plot in position (1,1), draw its legend in the empty panels to the right
inner <- getPlot(gg0, 1, 1)
inner <- inner +
theme(legend.position = c(1.01, 0.5),
legend.direction = "horizontal",
legend.justification = "left") +
guides(colour = guide_legend(title.position = "top"))
gg0 <- putPlot(gg0, inner, 1, 1)
gg0
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]])
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
I have the following piece of code, which generates three plots after which I arrange those plots using arrangeGrob and put it in a variable g. Then to save the output I use ggsave(file="filename",g). My question is all the three plots are saving correctly in the file, however some of the axis lables gets cramped up, is there any way automatically rescale (to preserve a clear output) in the saved file. One option would be to adjust the width and height of the file, but I need to keep these dimensions and decimal format for the numbers. Can someone suggest a method for this, thanks.
I don't understand why the color in the geom_point(aes()) is not applied to the plots correctly?
x <- c(1:10)
y <- x^3
z <- y-20
s <- z/3
t <- s*6
q <- s*y
x1 <- cbind(x,y,z,s,t,q)
x1 <- data.frame(x1)
a <- ggplot(x1,aes(x=x1[,1],y=x1[,2]))+geom_point(aes(color = 'blue'),size=4)+theme(legend.position='none',plot.margin=unit(c(0,3,0,0),"mm"))
ggsave("a.png")
b <- ggplot(x1,aes(x=x1[,3],y=x1[,4]))+geom_point(aes(color = 'blue'),size=4)+theme(legend.position='none',plot.margin=unit(c(0,3,0,0),"mm"))
ggsave("b.png")
c <- ggplot(x1,aes(x=x1[,5],y=x1[,6]))+geom_point(aes(color = 'violet'),size=4)+theme(legend.position='none',plot.margin=unit(c(0,3,0,0),"mm"))
ggsave("c.png")
gA <- ggplotGrob(a)
gB <- ggplotGrob(b)
gC <- ggplotGrob(c)
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5],gC$widths[2:5])
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
gC$widths[2:5] <- as.list(maxWidth)
g <- arrangeGrob(gA, gB,gC, ncol=2)
ggsave(file='fname.png',g, width=10,height=8,units=c("cm"), dpi=600)
An illustration of the resulting plot is shown below,
Add:
+ theme(text = element_text(size = 10))
You can change the text size to fit your needs.
To change the colour of the points set the colour flag outside of the aesthetics:
geom_point(colour = "blue", size = 4)