Related
This question is quite trivial but I cannot be handled nicely with.
I'm trying to plot a circular tree with a side heatmap.
I'm using ggtree but any approach ggplo2 based is welcome.
The problems that I'm not understanding well the gheatmap function.
I want:
1- names AFTER the heatmap
2- 2 text columns after heatmap (for while may have the same value, but I need to know how to add it )
3- heatmap columns name nicely handled, should we remove the columns name and use different colors scales for each? wherever the solution falls might better than the way it is now
library(tidyverse)
library(ggtree)
library(treeio)
library(tidytree)
beast_file <- system.file("examples/MCC_FluA_H3.tree", package="ggtree")
beast_tree <- read.beast(beast_file)
genotype_file <- system.file("examples/Genotype.txt", package="ggtree")
genotype <- read.table(genotype_file, sep="\t", stringsAsFactor=F)
colnames(genotype) <- sub("\\.$", "", colnames(genotype))
p <- ggtree(beast_tree, mrsd="2013-01-01",layout = "fan", open.angle = -270) +
geom_treescale(x=2008, y=1, offset=2) +
geom_tiplab(size=2)
gheatmap(p, genotype, offset=5, width=0.5, font.size=3,
colnames_angle=-45, hjust=0) +
scale_fill_manual(breaks=c("HuH3N2", "pdm", "trig"),
values=c("steelblue", "firebrick", "darkgreen"), name="genotype")
Thanks in advance
UPDATE:
I found a better way to plot the name of heatmap columns.
Also, I found that the simplification of the data was useful to
clean up a little the tip labels.
Now, I just need to add two text columns after heatmap.
p <- ggtree(beast_tree)
gheatmap(
p, genotype, colnames=TRUE,
colnames_angle=90,
colnames_offset_y = 5,
colnames_position = "top",
) +
scale_fill_manual(breaks=c("HuH3N2", "pdm", "trig"),
values=c("steelblue", "firebrick", "darkgreen"), name="genotype")
UPDATE 2:
A very bad improvement
I just used ggplot to create the label and merge with patchwork
library(patchwork)
p$data %>%
ggplot(aes(1, y= y, label = label )) +
geom_text(size=2) +
xlim(NA, 1) +
theme_classic() +
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank()) -> adText
pp + adText
The answer according #xiangpin at GitHub.
Big offset value to geom_tiplabel:
p <- ggtree(beast_tree)
p1 <- gheatmap(
p, genotype, colnames=TRUE,
colnames_angle=-45,
colnames_offset_y = 5,
colnames_position = "bottom",
width=0.3,
hjust=0, font.size=2) +
scale_fill_manual(breaks=c("HuH3N2", "pdm", "trig"),
values=c("steelblue", "firebrick", "darkgreen"), name="genotype") +
geom_tiplab(align = TRUE, linesize=0, offset = 7, size=2) +
xlim_tree(xlim=c(0, 36)) +
scale_y_continuous(limits = c(-1, NA))
p1
Using ggtreeExtra:
library(ggtreeExtra)
library(ggtree)
library(treeio)
library(ggplot2)
beast_file <- system.file("examples/MCC_FluA_H3.tree", package="ggtree")
genotype_file <- system.file("examples/Genotype.txt", package="ggtree")
tree <- read.beast(beast_file)
genotype <- read.table(genotype_file, sep="\t")
colnames(genotype) <- sub("\\.$", "", colnames(genotype))
genotype$ID <- row.names(genotype)
dat <- reshape2::melt(genotype, id.vars="ID", variable.name = "type", value.name="genotype", factorsAsStrings=FALSE)
dat$genotype <- unlist(lapply(as.vector(dat$genotype),function(x)ifelse(nchar(x)==0,NA,x)))
p <- ggtree(tree) + geom_treescale()
p2 <- p + geom_fruit(data=dat,
geom=geom_tile,
mapping=aes(y=ID, x=type, fill=genotype),
color="white") +
scale_fill_manual(values=c("steelblue", "firebrick", "darkgreen"),
na.translate=FALSE) +
geom_axis_text(angle=-45, hjust=0, size=1.5) +
geom_tiplab(align = TRUE, linesize=0, offset = 6, size=2) +
xlim_tree(xlim=c(0, 36)) +
scale_y_continuous(limits = c(-1, NA))
p2
I have a list of 45 ggplot objects that I'm arranging across multiple pages thanks to the marrangeGrob() function from gridExtra. I would like to show a same and unique legend on each pages.
I know how to extract the legend (g_legend), how to plot my ggplot without the legend. But I do not find a way to have a multipages thanks to marrangeGrob and a unique legend.
I used g_legend() to extract my legend
g_legend<-function(a.gplot){
g <- ggplotGrob(a.gplot + theme(legend.position = "right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
return(legend)}
In order to simplify, the reproductible data set is from diamonds, and let say I want to produce on one page p1 and p2 and on an other page p2 and p1.
df <- count(diamonds, cut)
p1 = ggplot(df, aes(x=cut, y=n, label=format(n, big.mark=","), fill=cut)) +
geom_bar(stat="identity") +
geom_text(aes(y=0.5*n), colour="white") +
coord_flip() +
theme(legend.position="bottom")
p2 = ggplot(diamonds %>% sample_n(1000), aes(x=carat, y=price, colour=cut)) +
geom_point()
leg = g_legend(p1)
I first try to plot the 4 graphs in one page
combined<-arrangeGrob(do.call("arrangeGrob",c(
lapply(list(p1,p2,p2,p1), function(x){ x + theme(legend.position="none")}),ncol=2)),
leg,
ncol = 2)
grid.newpage()
grid.draw(combined)
which works perfectly but when I try to do it with multipages
marrangeGrob(do.call("marrangeGrob",c(lapply(list(p1,p2,p2,p1), function(x){ x + theme(legend.position="none")}),
ncol=2,nrow=2)),
leg,
ncol = 2,nrow=1)
I obtained :
Error in $<-.data.frame(*tmp*, "wrapvp", value = list(x = 0.5, y = 0.5, : replacement has 17 rows, data has 5
Does anyone know a way to use marrangeGrob and obtain a unique legend on each multipages?
For an example dataset, I create a pyramid plot by country showing levels (%) of overweight males and females in a population.
library(plotrix)
xy.males.overweight<-c(23.2,33.5,43.6,33.6,43.5,43.5,43.9,33.7,53.9,43.5,43.2,42.8,22.2,51.8,
41.5,31.3,60.7,50.4)
xx.females.overweight<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,22.5,22,12.7,12.5,
12.3,10,0.8)
agelabels<-c("uk","scotland","france","ireland","germany","sweden","norway",
"iceland","portugal","austria","switzerland","australia","new zealand","dubai","south africa",
"finland","italy","morocco")
par(mar=pyramid.plot(xy.males.overweight,xx.females.overweight,labels=agelabels,
gap=9))
I found this approach using 'plotrix' here:
https://stats.stackexchange.com/questions/2455/how-to-make-age-pyramid-like-plot-in-r
I wish to create a slightly more detailed pyramid plot, with the addition of a stacked bar chart on both sides showing overweight AND percentage obese for males and females (preferably in different shades of red/blue). Example data values for 'obese' are listed below:
xx.females.obese<-c(23.2,33.5,43.6,33.6,43.5,23.5,33.9,33.7,23.9,43.5,18.2,22.8,22.2,31.8,
25.5,25.3,31.7,28.4)
xy.males.obese<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,22.5,22,12.7,12.5,
12.3,10,0.8)
Also, if 'Age' on the graph could be changed (to country), that would be helpful to.
Many thanks in advance for any help/advice. I am open to using plotrix or ggplot2 as appropriate.
Plotrix might be easier, but it is possible to disassemble ggplot charts, and arrange them as a pyramid plot. Using #eipi10's data (thanks), and adapting code from drawing-pyramid-plot-using-r-and-ggplot2, I draw separate plots for "males", "females", and the "country" labels. Also, I grab a legend from one of the plots. The trick is to get the tick marks for the left chart to appear on the right side of the chart - I adapted code from mirroring-axis-ticks-in-ggplot2. The four bits (the "female" plot, the country labels, the "male plot", and the legend) are put together using gtable functions.
Minor edit: Updating to ggplot2 2.2.1
# Packages
library(plyr)
library(ggplot2)
library(scales)
library(gtable)
library(stringr)
library(grid)
# Data
mov <-c(23.2,33.5,43.6,33.6,43.5,43.5,43.9,33.7,53.9,43.5,43.2,42.8,22.2,51.8,
41.5,31.3,60.7,50.4)
fov<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,22.5,22,12.7,12.5,
12.3,10,0.8)
fob<-c(23.2,33.5,43.6,33.6,43.5,23.5,33.9,33.7,23.9,43.5,18.2,22.8,22.2,31.8,
25.5,25.3,31.7,28.4)
mob<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,22.5,22,12.7,12.5,
12.3,10,0.8)
labs<-c("uk","scotland","france","ireland","germany","sweden","norway",
"iceland","portugal","austria","switzerland","australia",
"new zealand","dubai","south africa",
"finland","italy","morocco")
df = data.frame(labs=rep(labs,4), values=c(mov, mob, fov, fob),
sex=rep(c("Male", "Female"), each=2*length(fov)),
bmi = rep(rep(c("Overweight", "Obese"), each=length(fov)),2))
# Order countries by overall percent overweight/obese
labs.order = ddply(df, .(labs), summarise, sum=sum(values))
labs.order = labs.order$labs[order(labs.order$sum)]
df$labs = factor(df$labs, levels=labs.order)
# Common theme
theme = theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank(),
plot.title = element_text(size = 10, hjust = 0.5))
#### 1. "male" plot - to appear on the right
ggM <- ggplot(data = subset(df, sex == 'Male'), aes(x=labs)) +
geom_bar(aes(y = values/100, fill = bmi), stat = "identity") +
scale_y_continuous('', labels = percent, limits = c(0, 1), expand = c(0,0)) +
labs(x = NULL) +
ggtitle("Male") +
coord_flip() + theme +
theme(plot.margin= unit(c(1, 0, 0, 0), "lines"))
# get ggplot grob
gtM <- ggplotGrob(ggM)
#### 4. Get the legend
leg = gtM$grobs[[which(gtM$layout$name == "guide-box")]]
#### 1. back to "male" plot - to appear on the right
# remove legend
legPos = gtM$layout$l[grepl("guide", gtM$layout$name)] # legend's position
gtM = gtM[, -c(legPos-1,legPos)]
#### 2. "female" plot - to appear on the left -
# reverse the 'Percent' axis using trans = "reverse"
ggF <- ggplot(data = subset(df, sex == 'Female'), aes(x=labs)) +
geom_bar(aes(y = values/100, fill = bmi), stat = "identity") +
scale_y_continuous('', labels = percent, trans = 'reverse',
limits = c(1, 0), expand = c(0,0)) +
labs(x = NULL) +
ggtitle("Female") +
coord_flip() + theme +
theme(plot.margin= unit(c(1, 0, 0, 1), "lines"))
# get ggplot grob
gtF <- ggplotGrob(ggF)
# remove legend
gtF = gtF[, -c(legPos-1,legPos)]
## Swap the tick marks to the right side of the plot panel
# Get the row number of the left axis in the layout
rn <- which(gtF$layout$name == "axis-l")
# Extract the axis (tick marks and axis text)
axis.grob <- gtF$grobs[[rn]]
axisl <- axis.grob$children[[2]] # Two children - get the second
# axisl # Note: two grobs - text and tick marks
# Get the tick marks - NOTE: tick marks are second
yaxis = axisl$grobs[[2]]
yaxis$x = yaxis$x - unit(1, "npc") + unit(2.75, "pt") # Reverse them
# Add them to the right side of the panel
# Add a column to the gtable
panelPos = gtF$layout[grepl("panel", gtF$layout$name), c('t','l')]
gtF <- gtable_add_cols(gtF, gtF$widths[3], panelPos$l)
# Add the grob
gtF <- gtable_add_grob(gtF, yaxis, t = panelPos$t, l = panelPos$l+1)
# Remove original left axis
gtF = gtF[, -c(2,3)]
#### 3. country labels - create a plot using geom_text - to appear down the middle
fontsize = 3
ggC <- ggplot(data = subset(df, sex == 'Male'), aes(x=labs)) +
geom_bar(stat = "identity", aes(y = 0)) +
geom_text(aes(y = 0, label = labs), size = fontsize) +
ggtitle("Country") +
coord_flip() + theme_bw() + theme +
theme(panel.border = element_rect(colour = NA))
# get ggplot grob
gtC <- ggplotGrob(ggC)
# Get the title
Title = gtC$grobs[[which(gtC$layout$name == "title")]]
# Get the plot panel
gtC = gtC$grobs[[which(gtC$layout$name == "panel")]]
#### Arrange the components
## First, combine "female" and "male" plots
gt = cbind(gtF, gtM, size = "first")
## Second, add the labels (gtC) down the middle
# add column to gtable
maxlab = labs[which(str_length(labs) == max(str_length(labs)))]
gt = gtable_add_cols(gt, sum(unit(1, "grobwidth", textGrob(maxlab, gp = gpar(fontsize = fontsize*72.27/25.4))), unit(5, "mm")),
pos = length(gtF$widths))
# add the grob
gt = gtable_add_grob(gt, gtC, t = panelPos$t, l = length(gtF$widths) + 1)
# add the title; ie the label 'country'
titlePos = gtF$layout$l[which(gtF$layout$name == "title")]
gt = gtable_add_grob(gt, Title, t = titlePos, l = length(gtF$widths) + 1)
## Third, add the legend to the right
gt = gtable_add_cols(gt, sum(leg$width), -1)
gt = gtable_add_grob(gt, leg, t = panelPos$t, l = length(gt$widths))
# draw the plot
grid.newpage()
grid.draw(gt)
Using ggplot2 and adapting code from this SO answer:
library(plyr)
library(ggplot2)
# Data
mov <-c(23.2,33.5,43.6,33.6,43.5,43.5,43.9,33.7,53.9,43.5,43.2,42.8,22.2,51.8,
41.5,31.3,60.7,50.4)
fov<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,22.5,22,12.7,12.5,
12.3,10,0.8)
fob<-c(23.2,33.5,43.6,33.6,43.5,23.5,33.9,33.7,23.9,43.5,18.2,22.8,22.2,31.8,
25.5,25.3,31.7,28.4)
mob<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,22.5,22,12.7,12.5,
12.3,10,0.8)
labs<-c("uk","scotland","france","ireland","germany","sweden","norway",
"iceland","portugal","austria","switzerland","australia",
"new zealand","dubai","south africa",
"finland","italy","morocco")
df = data.frame(labs=rep(labs,4), values=c(mov, mob, fov, fob),
sex=rep(c("Male", "Female"), each=2*length(fov)),
bmi = rep(rep(c("Overweight", "Obese"), each=length(fov)),2))
# Order countries by overall percent overweight/obese
labs.order = ddply(df, .(labs), summarise, sum=sum(values))
labs.order = labs.order$labs[order(labs.order$sum)]
df$labs = factor(df$labs, levels=labs.order)
Plot separate subsets of Male and Female to get a pyramid plot:
ggplot(df, aes(x=labs)) +
geom_bar(data=df[df$sex=="Male",], aes(y=values, fill=bmi), stat="identity") +
geom_bar(data=df[df$sex=="Female",], aes(y=-values, fill=bmi), stat="identity") +
geom_hline(yintercept=0, colour="white", lwd=1) +
coord_flip(ylim=c(-101,101)) +
scale_y_continuous(breaks=seq(-100,100,50), labels=c(100,50,0,50,100)) +
labs(y="Percent", x="Country") +
ggtitle("Female Male")
I have two pieces of data that I want to overlay onto the same plot. I've looked at several ggplot articles and I don't think it's possible within ggplot. So I have been using barplot. I have 5 tiers and I'm plotting total dollars by tier as a solid bar.
Then I have another piece of data that represents the number of tasks within those tiers by two different types of workers. I have this as a stacked bar plot. But I want to show them on the same graph with the total dollar amount as one bar and then the corresponding stacked bar next to it.
Here are the plots:
The data for the first graph looks like this (it's a table):
1 2 3 4 5
0 9 340 97 812 4271
1 1 417 156 3163 11314
The data for the second graph looks like this (this is a dataset):
Tier variable value
1 1 Opp_Amt 16200.00
2 2 Opp_Amt 116067.50
3 3 Opp_Amt 35284.12
4 4 Opp_Amt 278107.10
5 5 Opp_Amt 694820.29
I want to put the graphs on top of each other but the bars keep overlapping and I want them to appear side by side by tier.
Code for what I have so far.
par(mar=c(2.5, 4, 4, 4)+2)
## Plot first set of data and draw its axis
barplot(data1$value, axes=FALSE,ylim=c(0,700000), xlab="", ylab="",
col="black",space=-10,main="Work Score")
axis(2, ylim=c(0,700000),col="black",las=1) ## las=1 makes horizontal labels
mtext("Total Opportunity Amount",side=2,line=3.5)
box()
## Allow a second plot on the same graph
par(new=TRUE)
## Plot the second plot and put axis scale on right
m <- barplot(counts, xlab="", ylab="", ylim=c(0,16000),axes=FALSE, col=c("red","darkblue"),space=3,width=0.5,density=20)
## a little farther out (line=4) to make room for labels
mtext("Task Ratio: Outbound to AE",side=4,col="red",line=3.5)
axis(4, ylim=c(0,16000), col="red",col.axis="black",las=1)
And it gives me this
Using ggplot, I would do something like one of these. They plot the two sets of data separately. The first arranges the data into one dataframe, then uses facet_wrap() to position the plots side-by-side. The second generates the two plot objects separately, then combines the two plots and the legend into a combined plot.
But if you really need the "dual y-axis" approach, then with some fiddling, and using the plots' layouts and gtable functions, it can be done (using code borrowed from here).
Like this:
library(ggplot2)
library(gtable)
library(plyr)
df1 <- data.frame(Tier = rep(1:5, each = 2),
y = c(9, 1, 340, 417, 97, 156, 812, 3063, 4271, 11314),
gp = rep(0:1, 5))
df2 <- read.table(text = "
Tier variable value
1 Opp_Amt 16200.00
2 Opp_Amt 116067.50
3 Opp_Amt 35284.12
4 Opp_Amt 278107.10
5 Opp_Amt 694820.29", header = TRUE)
dfA = df1
dfB = df2
names(dfA) = c("Tier", "Value", "gp")
dfA$var = "Task Ratio"
dfB = dfB[,c(1,3)]
dfB$gp = 3
dfB$var = "Total Opportunity Amount"
names(dfB) = names(dfA)
df = rbind(dfA, dfB)
df$var = factor(df$var)
df$var = factor(df$var, levels = rev(levels(df$var)))
ggplot(df, aes(Tier, Value, fill = factor(gp))) +
geom_bar(position = "stack", stat = "identity") +
facet_wrap( ~ var, scale = "free_y") +
scale_fill_manual("Group", breaks = c("0","1"), values = c("#F8766D", "#00BFC4", "black")) +
theme_bw() +
theme(panel.spacing = unit(2, "lines"),
panel.grid = element_blank())
Or this:
p1 <- ggplot(df1, aes(factor(Tier), y, fill = factor(gp))) +
geom_bar(position = "stack", stat = "identity") +
#guides(fill = FALSE) +
scale_y_continuous("Task Ratio",
limit = c(0, 1.1*max(ddply(df1, .(Tier), summarise, sum = sum(y)))),
expand = c(0,0)) +
scale_x_discrete("Tier") +
theme_bw() +
theme(panel.grid = element_blank())
p2 <- ggplot(df2, aes(factor(Tier), value)) +
geom_bar(stat = "identity") +
scale_y_continuous("Total Opportunity Amount", limit = c(0, 1.1*max(df2$value)), expand = c(0,0)) +
scale_x_discrete("Tier") +
theme_bw() +
theme(panel.grid = element_blank())
# Get the ggplot grobs,
# And get the legend from p1
g1 <- ggplotGrob(p1)
leg = gtable_filter(g1, "guide-box")
legColumn = g1$layout[which(g1$layout$name == "guide-box"), "l"]
g1 = g1[,-legColumn]
g2 <- ggplotGrob(p2)
# Make sure the width are the same in g1 and g2
library(grid)
maxWidth = unit.pmax(g1$widths, g2$widths)
g1$widths = as.list(maxWidth)
g2$widths = as.list(maxWidth)
# Combine g1, g2 and the legend
library(gridExtra)
grid.arrange(arrangeGrob(g2, g1, nrow = 1), leg,
widths = unit.c(unit(1, "npc") - leg$width, leg$width), nrow=1)
Or the dual y-axis approach (But not recommended for reasons given in #Phil's post):
width1 = 0.6 # width of bars in p1
width2 = 0.2 # width of bars in p2
pos = .5*width1 + .5*width2 # positioning bars in p2
p1 <- ggplot(df1, aes(factor(Tier), y, fill = factor(gp))) +
geom_bar(position = "stack", stat = "identity", width = width1) +
guides(fill = FALSE) +
scale_y_continuous("",
limit = c(0, 1.1*max(ddply(df1, .(Tier), summarise, sum = sum(y)))),
expand = c(0,0)) +
scale_x_discrete("Tier") +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text.y = element_text(colour = "red", hjust = 0, margin = margin(l = 2, unit = "pt")),
axis.ticks.y = element_line(colour = "red"))
p2 <- ggplot(df2, aes(factor(Tier), value)) +
geom_blank() +
geom_bar(aes(x = Tier - pos), stat = "identity", width = width2) +
scale_y_continuous("", limit = c(0, 1.1*max(df2$value)), expand = c(0,0)) +
theme_bw() +
theme(panel.grid = element_blank())
# Get ggplot grobs
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
# Get locations of the panels in g1
pp1 <- c(subset(g1$layout, name == "panel", se = t:r))
## Get bars from g2 and insert them into the panel in g1
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]][[4]][[4]], pp1$t, pp1$l)
# Grab axis from g1, reverse elements, and put it on the right
index <- which(g1$layout$name == "axis-l")
grob <- g1$grobs[[index]]
axis <- grob$children[[2]]
axis$widths <- rev(axis$widths)
axis$grobs <- rev(axis$grobs)
axis$grobs[[1]]$x <- axis$grobs[[1]]$x - unit(1, "npc") + unit(3, "pt")
g <- gtable_add_cols(g, g1$widths[g1$layout[index, ]$l], pp1$r)
g <- gtable_add_grob(g, axis, pp1$t, pp1$l+1)
# Grab axis from g2, and put it on the left
index <- which(g2$layout$name == "axis-l")
grob <- g2$grobs[[index]]
axis <- grob$children[[2]]
g <- gtable_add_grob(g, rectGrob(gp = gpar(col = NA, fill = "white")), pp1$t-1, pp1$l-1, pp1$b+1)
g <- gtable_add_grob(g, axis, pp1$t, pp1$l-1)
# Add axis titles
# right axis title
RightAxisText = textGrob("Task Ratio", rot = 90, gp = gpar(col = "red"))
g <- gtable_add_cols(g, unit.c(unit(1, "grobwidth", RightAxisText) + unit(1, "line")), 5)
g <- gtable_add_grob(g, RightAxisText, pp1$t, pp1$r+2)
# left axis title
LeftAxisText = textGrob("Total Opportunity Amount", rot = 90)
g <- gtable_add_grob(g, LeftAxisText, pp1$t, pp1$l-2)
g$widths[2] <- unit.c(unit(1, "grobwidth", LeftAxisText) + unit(1, "line"))
# Draw it
grid.newpage()
grid.draw(g)
It appears you are trying to plot two variables on two different y scales on to one chart. I recommend against this, and this is considered bad practice. See, for example, #hadley 's (the author of ggplot2) answer here about a similar issue: https://stackoverflow.com/a/3101876/3022126
It is possible to plot two variables on one y axis if they have comparable scales, but the range of your two datasets do not greatly overlap.
Consider other visualisations, perhaps using two separate charts.
Try looking at the add parameter for barplot.
## Function to create alpha colors for illustration.
col2alpha <- function(col, alpha = 0.5) {
tmp <- col2rgb(col)
rgb(tmp[1]/255, tmp[2]/255, tmp[3]/255, alpha)
}
## Some fake data
dat1 <- data.frame(id = 1:4, val = c(10, 8, 6, 4))
dat2 <- data.frame(id = 1:4, val = c(4, 6, 8, 10))
barplot(dat1$val, col = col2alpha("blue"))
barplot(dat2$val, col = col2alpha("red"), add = TRUE)
I have two ggplots which I align horizontally with grid.arrange. I have looked through a lot of forum posts, but everything I try seem to be commands that are now updated and named something else.
My data looks like this;
# Data plot 1
axis1 axis2
group1 -0.212201 0.358867
group2 -0.279756 -0.126194
group3 0.186860 -0.203273
group4 0.417117 -0.002592
group1 -0.212201 0.358867
group2 -0.279756 -0.126194
group3 0.186860 -0.203273
group4 0.186860 -0.203273
# Data plot 2
axis1 axis2
group1 0.211826 -0.306214
group2 -0.072626 0.104988
group3 -0.072626 0.104988
group4 -0.072626 0.104988
group1 0.211826 -0.306214
group2 -0.072626 0.104988
group3 -0.072626 0.104988
group4 -0.072626 0.104988
#And I run this:
library(ggplot2)
library(gridExtra)
groups=c('group1','group2','group3','group4','group1','group2','group3','group4')
x1=data1[,1]
y1=data1[,2]
x2=data2[,1]
y2=data2[,2]
p1=ggplot(data1, aes(x=x1, y=y1,colour=groups)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)
p2=ggplot(data2, aes(x=x2, y=y2,colour=groups)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)
#Combine plots
p3=grid.arrange(
p1 + theme(legend.position="none"), p2+ theme(legend.position="none"), nrow=1, widths = unit(c(10.,10), "cm"), heights = unit(rep(8, 1), "cm")))
How would I extract the legend from any of these plots and add it to the bottom/centre of the combined plot?
You may also use ggarrange from ggpubr package and set "common.legend = TRUE":
library(ggpubr)
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data = dsamp, colour = clarity)
p2 <- qplot(cut, price, data = dsamp, colour = clarity)
p3 <- qplot(color, price, data = dsamp, colour = clarity)
p4 <- qplot(depth, price, data = dsamp, colour = clarity)
ggarrange(p1, p2, p3, p4, ncol=2, nrow=2, common.legend = TRUE, legend="bottom")
Update 2021-Mar
This answer has still some, but mostly historic, value. Over the years since this was posted better solutions have become available via packages. You should consider the newer answers posted below.
Update 2015-Feb
See Steven's answer below
df1 <- read.table(text="group x y
group1 -0.212201 0.358867
group2 -0.279756 -0.126194
group3 0.186860 -0.203273
group4 0.417117 -0.002592
group1 -0.212201 0.358867
group2 -0.279756 -0.126194
group3 0.186860 -0.203273
group4 0.186860 -0.203273",header=TRUE)
df2 <- read.table(text="group x y
group1 0.211826 -0.306214
group2 -0.072626 0.104988
group3 -0.072626 0.104988
group4 -0.072626 0.104988
group1 0.211826 -0.306214
group2 -0.072626 0.104988
group3 -0.072626 0.104988
group4 -0.072626 0.104988",header=TRUE)
library(ggplot2)
library(gridExtra)
p1 <- ggplot(df1, aes(x=x, y=y,colour=group)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8) + theme(legend.position="bottom")
p2 <- ggplot(df2, aes(x=x, y=y,colour=group)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)
#extract legend
#https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
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)}
mylegend<-g_legend(p1)
p3 <- grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
nrow=1),
mylegend, nrow=2,heights=c(10, 1))
Here is the resulting plot:
A new, attractive solution is to use patchwork. The syntax is very simple:
library(ggplot2)
library(patchwork)
p1 <- ggplot(df1, aes(x = x, y = y, colour = group)) +
geom_point(position = position_jitter(w = 0.04, h = 0.02), size = 1.8)
p2 <- ggplot(df2, aes(x = x, y = y, colour = group)) +
geom_point(position = position_jitter(w = 0.04, h = 0.02), size = 1.8)
combined <- p1 + p2 & theme(legend.position = "bottom")
combined + plot_layout(guides = "collect")
Created on 2019-12-13 by the reprex package (v0.2.1)
Roland's answer needs updating. See: https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
This method has been updated for ggplot2 v1.0.0.
library(ggplot2)
library(gridExtra)
library(grid)
grid_arrange_shared_legend <- function(...) {
plots <- list(...)
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
grid.arrange(
do.call(arrangeGrob, lapply(plots, function(x)
x + theme(legend.position="none"))),
legend,
ncol = 1,
heights = unit.c(unit(1, "npc") - lheight, lheight))
}
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data=dsamp, colour=clarity)
p2 <- qplot(cut, price, data=dsamp, colour=clarity)
p3 <- qplot(color, price, data=dsamp, colour=clarity)
p4 <- qplot(depth, price, data=dsamp, colour=clarity)
grid_arrange_shared_legend(p1, p2, p3, p4)
Note the lack of ggplot_gtable and ggplot_build. ggplotGrob is used instead. This example is a bit more convoluted than the above solution but it still solved it for me.
I suggest using cowplot. From their R vignette:
# load cowplot
library(cowplot)
# down-sampled diamonds data set
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
# Make three plots.
# We set left and right margins to 0 to remove unnecessary spacing in the
# final plot arrangement.
p1 <- qplot(carat, price, data=dsamp, colour=clarity) +
theme(plot.margin = unit(c(6,0,6,0), "pt"))
p2 <- qplot(depth, price, data=dsamp, colour=clarity) +
theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")
p3 <- qplot(color, price, data=dsamp, colour=clarity) +
theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")
# arrange the three plots in a single row
prow <- plot_grid( p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
p3 + theme(legend.position="none"),
align = 'vh',
labels = c("A", "B", "C"),
hjust = -1,
nrow = 1
)
# extract the legend from one of the plots
# (clearly the whole thing only makes sense if all plots
# have the same legend, so we can arbitrarily pick one.)
legend_b <- get_legend(p1 + theme(legend.position="bottom"))
# add the legend underneath the row we made earlier. Give it 10% of the height
# of one plot (via rel_heights).
p <- plot_grid( prow, legend_b, ncol = 1, rel_heights = c(1, .2))
p
#Giuseppe, you may want to consider this for a flexible specification of the plots arrangement (modified from here):
library(ggplot2)
library(gridExtra)
library(grid)
grid_arrange_shared_legend <- function(..., nrow = 1, ncol = length(list(...)), position = c("bottom", "right")) {
plots <- list(...)
position <- match.arg(position)
g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
lwidth <- sum(legend$width)
gl <- lapply(plots, function(x) x + theme(legend.position = "none"))
gl <- c(gl, nrow = nrow, ncol = ncol)
combined <- switch(position,
"bottom" = arrangeGrob(do.call(arrangeGrob, gl),
legend,
ncol = 1,
heights = unit.c(unit(1, "npc") - lheight, lheight)),
"right" = arrangeGrob(do.call(arrangeGrob, gl),
legend,
ncol = 2,
widths = unit.c(unit(1, "npc") - lwidth, lwidth)))
grid.newpage()
grid.draw(combined)
}
Extra arguments nrow and ncol control the layout of the arranged plots:
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data = dsamp, colour = clarity)
p2 <- qplot(cut, price, data = dsamp, colour = clarity)
p3 <- qplot(color, price, data = dsamp, colour = clarity)
p4 <- qplot(depth, price, data = dsamp, colour = clarity)
grid_arrange_shared_legend(p1, p2, p3, p4, nrow = 1, ncol = 4)
grid_arrange_shared_legend(p1, p2, p3, p4, nrow = 2, ncol = 2)
If you are plotting the same variables in both plots, the simplest way would be to combine the data frames into one, then use facet_wrap.
For your example:
big_df <- rbind(df1,df2)
big_df <- data.frame(big_df,Df = rep(c("df1","df2"),
times=c(nrow(df1),nrow(df2))))
ggplot(big_df,aes(x=x, y=y,colour=group))
+ geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)
+ facet_wrap(~Df)
Another example using the diamonds data set. This shows that you can even make it work if you have only one variable common between your plots.
diamonds_reshaped <- data.frame(price = diamonds$price,
independent.variable = c(diamonds$carat,diamonds$cut,diamonds$color,diamonds$depth),
Clarity = rep(diamonds$clarity,times=4),
Variable.name = rep(c("Carat","Cut","Color","Depth"),each=nrow(diamonds)))
ggplot(diamonds_reshaped,aes(independent.variable,price,colour=Clarity)) +
geom_point(size=2) + facet_wrap(~Variable.name,scales="free_x") +
xlab("")
Only tricky thing with the second example is that the factor variables get coerced to numeric when you combine everything into one data frame. So ideally, you will do this mainly when all your variables of interest are the same type.
#Guiseppe:
I have no idea of Grobs etc whatsoever, but I hacked together a solution for two plots, should be possible to extend to arbitrary number but its not in a sexy function:
plots <- list(p1, p2)
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
tmp <- arrangeGrob(p1 + theme(legend.position = "none"), p2 + theme(legend.position = "none"), layout_matrix = matrix(c(1, 2), nrow = 1))
grid.arrange(tmp, legend, ncol = 1, heights = unit.c(unit(1, "npc") - lheight, lheight))
If the legend is the same for both plots, there is a simple solution using grid.arrange(assuming you want your legend to align with both plots either vertically or horizontally). Simply keep the legend for the bottom-most or right-most plot while omitting the legend for the other. Adding a legend to just one plot, however, alters the size of one plot relative to the other. To avoid this use the heights command to manually adjust and keep them the same size. You can even use grid.arrange to make common axis titles. Note that this will require library(grid) in addition to library(gridExtra). For vertical plots:
y_title <- expression(paste(italic("E. coli"), " (CFU/100mL)"))
grid.arrange(arrangeGrob(p1, theme(legend.position="none"), ncol=1),
arrangeGrob(p2, theme(legend.position="bottom"), ncol=1),
heights=c(1,1.2), left=textGrob(y_title, rot=90, gp=gpar(fontsize=20)))
Here is the result for a similar graph for a project I was working on: