Justification of multiple legends in ggmap/ggplot2 - r

I am trying to make a map with two legends denoting shape and colour ("Type" and "Org" in the example below), and have the legends inset. I can place the legends, but I would like them to be left justified so that their left edges line up. I can't make them anything other than centred with respect to each other:
require(ggplot2)
require(ggmap)
require(grid)
require(mapproj)
data <- data.frame(Org=rep(c("ABCDEFG","HIJKLMNOP","QRSTUVWX"),4)
, Type=rep(c("Y","Z"),6), Lat=runif(12,48,54.5)
, Long=runif(12,-133.5,-122.5))
osmMap <- get_map(location=c(-134,47.5,-122,55), source = 'osm')
points <- geom_jitter(data=data, aes(Long, Lat, shape=Type
, colour=Org))
legend <- theme(legend.justification=c(0,0), legend.position=c(0,0)
, legend.margin=unit(0,"lines"), legend.box="vertical"
, legend.key.size=unit(1,"lines"), legend.text.align=0
, legend.title.align=0)
ggmap(osmMap) + points + legend

This option is now available in ggplot2 0.9.3.1, use
ggmap(osmMap) + points + legend + theme(legend.box.just = "left")
Old, manual solution:
Here is a solution:
require(gtable)
require(ggplot2)
require(ggmap)
require(grid)
require(mapproj)
# Original data
data <- data.frame(Org=rep(c("ABCDEFG","HIJKLMNOP","QRSTUVWX"),4),
Type=rep(c("Y","Z"),6), Lat=runif(12,48,54.5),
Long=runif(12,-133.5,-122.5))
osmMap <- get_map(location=c(-134,47.5,-122,55), source = 'google')
points <- geom_jitter(data=data, aes(Long, Lat, shape=Type, colour=Org))
legend <- theme(legend.justification=c(0,0), legend.position=c(0,0),
legend.margin=unit(0,"lines"), legend.box="vertical",
legend.key.size=unit(1,"lines"), legend.text.align=0,
legend.title.align=0)
# Data transformation
p <- ggmap(osmMap) + points + legend
data <- ggplot_build(p)
gtable <- ggplot_gtable(data)
# Determining index of legends table
lbox <- which(sapply(gtable$grobs, paste) == "gtable[guide-box]")
# Each legend has several parts, wdth contains total widths for each legend
wdth <- with(gtable$grobs[[lbox]], c(sum(as.vector(grobs[[1]]$widths)),
sum(as.vector(grobs[[2]]$widths))))
# Determining narrower legend
id <- which.min(wdth)
# Adding a new empty column of abs(diff(wdth)) mm width on the right of
# the smaller legend box
gtable$grobs[[lbox]]$grobs[[id]] <- gtable_add_cols(
gtable$grobs[[lbox]]$grobs[[id]],
unit(abs(diff(wdth)), "mm"))
# Plotting
grid.draw(gtable)
This does not depend on Type or Org. However, this would not be enough having more than two legends. Also, in case you do some changes so that list of grobs (graphical objects) is altered, you might need to change grobs[[8]] to grobs[[i]] where i is the position of your legends, see gtable$grobs and look for TableGrob (5 x 3) "guide-box": 2 grobs.
Edit: 1. Automatically detecting which grob is legends table, i.e. no need to change anything after modifying other parts of plot. 2. Changed calculation of width differences, now code should work when having any two legends, i.e. in more complex cases as well, for example:

Related

Duplicate Same Legend Twice in Ggplot2

I am preparing a chart where I have client's requirement to put same legend on top and bottom. Using ggplot I can put it either at top or at bottom. But I am not aware about option of duplicating at both the places.
I have tried putting legend.position as c('top','bottom') but that is giving me error and I know if should give error.
Can it be done with other libraries? I want to same legend twice at top and at bottom?
Take this code for an instance
library(ggplot2)
bp <- ggplot(data=PlantGrowth, aes(x=group, y=weight, fill=group)) + geom_boxplot()
bp <- bp + theme(legend.position="bottom")
bp
You have to work with the intermediate graphic objects (grobs) that ggplot2 uses when being plotted.
I grabbed a function that was flowing around here on StackOverflow to extract the legend, and put it into a package that is now on CRAN.
Here's a solution:
library(lemon)
bp <- bp + theme(legend.position='bottom')
g <- ggplotGrob(bp)
l <- g_legend(g)
grid.arrange(g, top=l)
g_legend accepts both the grob-version (that cannot be manipulated with ggplot2 objects) and the ordinary ggplot2 objects. Using ggplotGrob is a one-way street; once converted you cannot convert it back to ggplot2. But, as in the example, we keep the original ggplot2 object. ;)
Depending on the use case, a center-aligned top legend may not be appropriate as in the contributed answer by #MrGrumble here: https://stackoverflow.com/a/46725487/5982900
Alternatively, you can copy the "guide-box" element of the ggplotGrob, append it to your grob object, and reset the coordinates to the top of the ggplot.
createTopLegend <- function(ggplot, heightFromTop = 1) {
g <- ggplotGrob(ggplot)
nGrobs <- (length(g$grobs))
legendGrob <- which(g$layout$name == "guide-box")
g$grobs[[nGrobs+ 1]] <- g$grobs[[legendGrob]]
g$layout[nGrobs+ 1,] <- g$layout[legendGrob,]
rightLeft <- unname(unlist(g$layout[legendGrob, c(2,4)]))
g$layout[nGrobs+ 1, 1:4] <- c(heightFromTop, rightLeft[1], heightFromTop, rightLeft[2])
g
}
Load the gridExtra package. From your ggplot object bp, use createTopLegend to duplicate another legend, then use grid.draw to produce your final figure. Note you may need to alter your plot margins depending on your figure.
library(ggplot2)
library(grid)
library(gridExtra)
bp <- ggplot(data=PlantGrowth, aes(x=group, y=weight, fill=group)) + geom_boxplot()
bp <- bp + theme(legend.position="bottom", plot.margin = unit(c(2,0,0,0), "lines"))
g <- createTopLegend(bp)
grid.draw(g)
# dev.off()
This will ensure the legend is aligned in the same way horizontally as it appears in your original ggplot.

tweaks to customized legends with ggplot and cowplot: colour matching issue

I'm trying to create a picture with points (actually bars, but whatever) in two distinct colours with parallel saturated-to-unsaturated colour scales, with corresponding colourbar legends. I'm most of the way there, but there are a few minor points I can't handle yet.
tl;dr the color scales I get from a red-to-white gradient and a saturated-red-to-completely-unsaturated gradient are not identical.
Set up data: y will determine both y-axis position and degree of saturation, w will determine binary colour choice.
set.seed(101)
dd <- data.frame(x=1:100,y=rnorm(100))
dd$w <- as.logical(sample(0:1,size=nrow(dd),
replace=TRUE))
Get packages:
library(ggplot2)
library(cowplot)
library(gridExtra)
I can get the plot I want by allowing alpha (transparency) to vary with y, but the legend is ugly:
g0 <- ggplot(dd,aes(x,y))+
geom_point(size=8,aes(alpha=y,colour=w))+
scale_colour_manual(values=c("red","blue"))
## + scale_alpha(guide="colourbar") ## doesn't work
I can draw each half of the points by themselves to get a legend similar to what I want:
g1 <- ggplot(dd[!dd$w,],aes(x,y))+
geom_point(size=8,aes(colour=y))+
scale_colour_gradient(low="white",high="red",name="not w")+
expand_limits(x=range(dd$x),y=range(dd$y))
g2 <- ggplot(dd[dd$w,],aes(x,y))+
geom_point(size=8,aes(colour=y))+
scale_colour_gradient(low="white",high="blue",name="w")+
expand_limits(x=range(dd$x),y=range(dd$y))
Now I can use tools from cowplot to pick off the legends and combine them with the original plot:
g1_leg <- get_legend(g1)
g2_leg <- get_legend(g2)
g0_noleg <- g0 + theme(legend.position='none')
ggdraw(plot_grid(g0_noleg,g1_leg,g2_leg,nrow=1,rel_widths=c(1,0.2,0.2)))
This is most of the way there, but:
ideally I'd like to squash the two colourbars together (I know I can probably do that with sufficient grid-hacking ...)
the colours don't quite match; the legend colours are slightly warmer than the point colours ...
Ideas? Or other ways of achieving the same goal?

Adding a table to ggplot figure

I have dose response data:
df <- data.frame(dose=c(10,0.625,2.5,0.15625,0.0390625,0.0024414,0.00976562,0.00061034,10,0.625,2.5,0.15625,0.0390625,0.0024414,0.00976562,0.00061034,10,0.625,2.5,0.15625,0.0390625,0.0024414,0.00976562,0.00061034),viability=c(6.117463479317,105.176885855348,57.9126197628863,81.9068445005286,86.484379347143,98.3093580807309,96.4351897372596,81.831197750164,27.3331232120347,85.2221817678203,80.7904933803092,91.9801454635583,82.4963735273569,110.440066995265,90.1705406346481,76.6265869905362,11.8651732228561,88.9673125759484,35.4484427232156,78.9756635057238,95.836828982968,117.339025930735,82.0786828300557,95.0717213053837),stringsAsFactors=F)
I fit log-logistic model to these data using the drc R package:
library(drc)
fit <- drm(viability~dose,data=df,fct=LL.4(names=c("Slope","Lower Limit","Upper Limit","ED50")))
I then plot this curve with the standard error using:
pred.df <- expand.grid(dose=exp(seq(log(max(df$dose)),log(min(df$dose)),length=100)))
pred <- predict(fit,newdata=pred.df,interval="confidence")
pred.df$viability <- pred[,1]
pred.df$viability.low <- pred[,2]
pred.df$viability.high <- pred[,3]
library(ggplot2)
p <- ggplot(df,aes(x=dose,y=viability))+geom_point()+geom_ribbon(data=pred.df,aes(x=dose,y=viability,ymin=viability.low,ymax=viability.high),alpha=0.2)+labs(y="viability")+
geom_line(data=pred.df,aes(x=dose,y=viability))+coord_trans(x="log")+theme_bw()+scale_x_continuous(name="dose",breaks=sort(unique(df$dose)),labels=format(signif(sort(unique(df$dose)),3),scientific=T))+ggtitle(label="all doses")
Finally I'd like to add the parameter estimates to the plot as a table. I'm trying:
params.df <- cbind(data.frame(param=gsub(":\\(Intercept\\)","",rownames(summary(fit)$coefficient)),stringsAsFactors=F),data.frame(summary(fit)$coefficient))
rownames(params.df) <- NULL
ann.df <- data.frame(param=gsub(" Limit","",params.df$param),value=signif(params.df[,2],3),stringsAsFactors=F)
rownames(ann.df) <- NULL
xmin <- sort(unique(df$dose))[1]
xmax <- sort(unique(df$dose))[3]
ymin <- df$viability[which(df$dose==xmin)][1]
ymax <- max(pred.df$viability.high)
p <- p+annotation_custom(tableGrob(ann.df),xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax)
But getting the error:
Error: annotation_custom only works with Cartesian coordinates
Any idea?
Also,
once plotted, is there a way to suppress row names?
I'm not sure if there's a way around the annotation_custom error within "base" ggplot2. However, you can use draw_grob from the cowplot package to add the table grob (as described here).
Note that in draw_grob the x-y coordinates give the location of the lower left corner of the table grob (where the coordinates of the width and height of the "canvas" go from 0 to 1):
library(gridExtra)
library(cowplot)
ggdraw(p) + draw_grob(tableGrob(ann.df, rows=NULL), x=0.1, y=0.1, width=0.3, height=0.4)
Another option is to resort to grid functions. We create a viewport within the plot p draw the table grob within that viewport.
library(gridExtra)
library(grid)
Draw the plot p that you've already created:
p
Create a viewport within plot p and draw the table grob. In this case, the x-y coordinates give the location of the center of the viewport and therefore the center of the table grob:
vp = viewport(x=0.3, y=0.3, width=0.3, height=0.4)
pushViewport(vp)
grid.draw(tableGrob(ann.df, rows=NULL))
UPDATE: To remove the background colors of the table grob, you can manipulate the table grob theme elements. See the example below. I also justified the numbers so that they line up on the decimal point. For more information on editing table grobs, see the tableGrob vignette.
thm <- ttheme_minimal(
core=list(fg_params = list(hjust=rep(c(0, 1), each=4),
x=rep(c(0.15, 0.85), each=4)),
bg_params = list(fill = NA)),
colhead=list(bg_params=list(fill = NA)))
ggdraw(p) + draw_grob(tableGrob(ann.df, rows=NULL, theme=thm),
x=0.1, y=0.1, width=0.3, height=0.4)

Match absolute tile sizes of two different ggplots when saving as PNG

When creating PNG files for a document using ggplot2 and geom_tile, is there a way to set the size of the tiles to some absolute unit (cm, pt)? I have multiple plots that, when inserted into a document, do not have the exact same tile sizes. Of course I could change the width and height of the plots manually, so the tiles almost match each other, but that's cheating...
The variable names on the x- and y-axis have different lengths. So rather than setting the dimensions of the whole plot (including all the labels), I would like to set the dimensions of only the plot area to some fixed value, maybe through scale_x/y_discrete? Or maybe the individual plots can be extracted after they have been resized with gridExtra or gtable?
# Create some example data.
set.seed(1)
dt1 <- data.table(x=letters[1:5], y=rep(c("aaaaaaaaa", letters[2:3]), rep(5,3)),
value=runif(5*3))
dt2 <- data.table(x=letters[1:4], y=rep(letters[1:4], rep(4,4)),
value=runif(4*4))
# Make two tile plots.
p1 <- ggplot(dt1, aes(x, y, fill=value)) +
geom_tile() +
coord_equal(); p1
p2 <- ggplot(dt2, aes(x, y, fill=value)) +
geom_tile() +
coord_equal(); p2
# Save tile plots to drive.
# ggsave("p1.png", p1, width=5)
# ggsave("p2.png", p2, width=5)
Here's a screenshot from a document with PNG images inserted, note that the labels have the same size:
And this is what I'm after: the absolute distance between the red arrows is identical in both images, without resizing the labels.
Any suggestions greatly appreciated!

R parallel coordinate plot with fixed scale on X-axis, no matter how large the plot becomes

I am trying to build a parallel coordinate diagram in R for showing the difference in ranking in different age groups. And I want to have a fixed scale on the Y axis for showing the values.
Here is a PC plot :
The goal is to see the slopes of the lines really well. So if I have value 1 that is bound with the value 1000, I want to see the line going aaall the way down steeply.
In R so far, if I have values that are too big, my plot is all squished so everything fits and it's hard to visualize anything.
My code for drawing the parallel coordinate plot is the following so far:
pc_18_34 <- read.table("parCoordData_18_24_25_34.csv", header=FALSE, sep="\t")
#name columns of data frame
colnames(pc_18_34) = c("18-25","25-34")
#build the parallel coordinate plot
# doc : http://docs.ggplot2.org/current/geom_path.html
group <- rep(c("Top 10", "Top 10-29", "Top 30-49"), each = 18)
df <- data.frame(id = seq_along(group), group, pc_18_34[,1], pc_18_34[,2])
colnames(df)[3] = "18-25"
colnames(df)[4] = "25-34"
library(reshape2) # for melt
dfm <- melt(df, id.var = c("id", "group"))
dfm[order(dfm$group,dfm$ArtistRank,decreasing=TRUE),]
colnames(dfm)[3] = "AgeGroup"
colnames(dfm)[4] = "ArtistRank"
ggplot(dfm, aes(x=AgeGroup, y=ArtistRank, group = id, colour = group), main="Tops across age groups")+ geom_path(alpha = 0.5, size=1) + geom_path(aes(color=group))
I have looked into how to get the scales to change in ggplot, using libraries like scales but when I had a layer of scale, the diagram doesn't even show up anymore.
Any thoughts on how to make to use a fixed scale (say difference of 1 in rank shown as 5px in the plot), even if it means that the plot is very tall ?
Thaanks !! :)
You can set the panel height to an absolute size based on the number of axis breaks. Note that the device won't scale automatically, so you'll have to adjust it manually for your plot to fit well.
library(ggplot2)
library(gtable)
p <- ggplot(Loblolly, aes(height, factor(age))) +
geom_point()
gb <- ggplot_build(p)
gt <- ggplot_gtable(gb)
n <- length(gb$panel$ranges[[1]]$y.major_source)
# locate the panel in the gtable layout
panel <- gt$layout$t[grepl("panel", gt$layout$name)]
# assign new height to the panels, based on the number of breaks
gt$heights[panel] <- list(unit(n*25,"pt"))
grid.newpage()
grid.draw(gt)

Resources