Multicolor titles with ggplot2 for R - r

I was trying to implement multicolor texts as shown here:
multicolor text on chart
which referenced this:
multicolor text in R
This is what I came up with (with help from here):
require(ggplot2)
require(grid)
png(file="multicolortitle.png",width=800,height=500)
qplot(x = hp,y = mpg,data = mtcars,color=factor(mtcars$cyl),size=2) +
scale_colour_manual(values = c("red3","green3","blue3")) +
theme_bw() +
opts(title = " \n ") +
opts(legend.position = "none")
spacing <- 20
grid.text(0.5, unit(1,"npc") - unit(1,"line"),
label=paste("4 cylinder,",paste(rep(" ",spacing*2), collapse='')),
gp=gpar(col="red3", fontsize=16,fontface="bold"))
grid.text(0.5, unit(1,"npc") - unit(1,"line"),
label=paste(paste(rep(" ",spacing), collapse=''),"6 cylinder,",
paste(rep(" ",spacing), collapse='')),
gp=gpar(col="green3", fontsize=16,fontface="bold"))
grid.text(0.5, unit(1,"npc") - unit(1,"line"),
label=paste(paste(rep(" ",spacing*2), collapse=''),"8 cylinder"),
gp=gpar(col="blue3", fontsize=16,fontface="bold"))
grid.text(0.5, unit(1,"npc") - unit(2,"line"),
label=paste(paste(rep(" ",spacing*0), collapse=''),
"- Horsepower versus Miles per Gallon"),
gp=gpar(col="black", fontsize=16,fontface="bold"))
dev.off()
Here's the resulting graph:
So, my question: is there a more elegant method to use for this? I'd like to be able to use ggsave for example, and creating the spacing for this is a highly manual process - not suited for scenarios where I need to automatically make hundreds of plots of this nature. I could see writing some functions on top of this, but maybe there's a better way to implement the methods utilized with the base plotting function?

Here's a more general approach that takes advantage of a few additional grid functions. It's not particularly well-polished, but it may give you some useful ideas:
library(grid)
library(ggplot2)
p <- ggplot(data=mtcars, aes(mpg,hp,color=factor(cyl),size=2)) +
geom_point() + theme_bw() +
opts(title = " \n ") + opts(legend.position="none")
## Get factor levels
levs <- levels(factor(mtcars$cyl))
n <- length(levs)
## Get factors' plotting colors
g <- ggplot_build(p)
d <- unique(g$data[[1]][c("colour", "group")])
cols <- d$colour[order(d$group)]
## Use widest label's width to determine spacing
labs <- paste(levs, "cylinder")
xlocs <- unit(0.5, "npc") +
1.1 * (seq_len(n) - mean(seq_len(n))) * max(unit(1, "strwidth", labs))
## Plot labels in top 10% of device
pushViewport(viewport(y=0.95, height=0.1))
grid.text(paste(levs, "cylinder"),
x = xlocs, y=unit(0.5, "lines"),
gp = gpar(col=cols, fontface="bold"))
grid.text("- Horsepower versus Miles per Gallon",
y = unit(-0.5, "lines"))
upViewport()
## Plot main figure in bottom 90% of device
pushViewport(viewport(y=0.45, height=0.9))
print(p, newpage=FALSE)
upViewport()

A possible strategy wrapping the words in a dummy table,
library(gridExtra)
library(grid)
library(ggplot2)
title = c('Concentration of ','affluence',' and ','poverty',' nationwide')
colors = c('black', '#EEB422','black', '#238E68','black')
grid.arrange(ggplot(),
top = tableGrob(t(title),
theme=ttheme_minimal(padding=unit(c(0,2),'mm'),
base_colour = colors)))
enter image description here

Related

How to add titles between plots

For the sake of simplicity, let's assume I have four graphs:
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
grid.arrange(p1,p2,p3,p4,ncol=2)
Now, I want to create a title (TITLE 1, TITLE 2) between each two titles,, as presented below:
Any ideas how to do it?
Here is a gtable solution to your problem. There might be easier solutions out there, but this should work.
First we'll bake in some titles in the leftmost plots
library(grid) # needed later for plotting
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 1")
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 2")
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
Then we can cbind and rbind the plots together as we see fit.
p12 <- cbind(ggplotGrob(p1), ggplotGrob(p2), size = "first")
p34 <- cbind(ggplotGrob(p3), ggplotGrob(p4), size = "first")
all <- rbind(p12, p34, size = "first")
grid.newpage(); grid.draw(all)
Note that we'd have to work with grid.newpage() and grid.draw() to get our plots, since we've left the ggplot sphere and are now in the realm of gtables and grid. Anyway, resulting plot looks like the following:
From your example I expect that you want these titles to be centered. This will be a bit more finicky:
# Decide what is a title
is_title <- grep("^title$", all$layout$name)
# Grab all titles
titles <- all$grobs[is_title]
# Exclude empty titles
is_title <- is_title[!sapply(titles, inherits, "zeroGrob")]
# Center title
all$grobs[is_title] <- lapply(all$grobs[is_title], function(title) {
title$children[[1]]$hjust <- 0.5
title$children[[1]]$x <- unit(0.5, "npc")
title
})
# Spread title over all panels
# You can see the number you'd need from the l/r coordinates of the 'panel' grobs
# which you can find by printing `all` or `all$layout`.
all$layout[is_title, "r"] <- 14
grid.newpage(); grid.draw(all)
EDIT: added example for adding extra titles
You can add extra titles, but you would need the gtable package for this.
library(gtable)
# First make extra titles
left <- textGrob("Left Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
right <- textGrob("Right Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
# Find a height that was 0, assign new height based on extra title
all$heights[[2]] <- unit(1, "grobheight", left)
# Add the titles (t = top position, l = left position)
all <- gtable_add_grob(all, left, t = 2, l = 5, clip = "off")
all <- gtable_add_grob(all, right, t = 2, l = 14, clip = "off")
grid.newpage(); grid.draw(all)

Remove axis text from one facet

I'm trying to display three time series using facet_grid() and in order to save space, I'm reducing panel spacing between them. The problem is that their vertical axis overlap so I want to move it to the right only on the plot in the middle.
Since this seem impossible in ggplot2, what I'm trying to do is to render every axis and then remove it editing the gtable but so far I was not successful.
This is a minimal example:
library(ggplot2)
set.seed(123)
df <- data.frame(expand.grid(x = 1:150, type = letters[1:3]))
df$y <- df$x*0.016 + rnorm(150, sd = .5)
ggplot(df, aes(x, y)) + geom_line() +
facet_grid(type~.) +
theme(panel.spacing.y = unit(-3, "lines"), strip.text = element_blank()) +
scale_y_continuous(sec.axis = dup_axis(name = ""), name = "y")
Which produces this:
And I want to delete each axis text to get to this:
Thanks!
The solution was to assign a nullGrob() to the relevant elements of the gTable.
gt <- ggplotGrob(g)
t <- gt[["grobs"]][[8]][["children"]][[2]]
# Found those grobs by looking around the table.
gt[["grobs"]][[8]][["children"]][[2]] <- nullGrob()
gt[["grobs"]][[10]][["children"]][[2]] <- nullGrob()
gt[["grobs"]][[12]][["children"]][[2]] <- nullGrob()
grid.newpage()
grid.draw(gt)

Multiple "Top" textGrob Titles

The following is a simple example of my issue (please forgive the repetitive plots - can't use my actual data)
Example:
#packages
library(grid)
library(gridExtra)
library(ggplot2)
#simple plot
p <- ggplot(mtcars, aes(wt,mpg))
# setting-up grid of plots...2 columns by 4 rows
sample <- grid.arrange(p + geom_point()+labs(title="Sample \nTitle One"),
p + geom_point()+labs(title="Sample \nTitle Two"),
p + geom_point(),
p + geom_point(),
p + geom_point(),
p + geom_point(),
p + geom_point(),
p + geom_point(),
ncol = 2)
Output:
Issue: The top two plots have been compressed. I attempted to use the textGrob, like follows:
top = textGrob("Sample Title One",hjust = 1,gp = gpar(fontfamily = "CM Roman", size = 12))
But, I am not seeing a way to incorporate two separate titles. I have yet to try using cowplot, which might be a more reasonable way to go, but was curious if there was a way to do this using textGrob.
Thanks for your time!
As stated by user20650, you can do the following:
grid.arrange(arrangeGrob(p,p,p,p,top=textGrob("Sample Title One"),
ncol=1), arrangeGrob(p,p,p,p,top=textGrob("Sample Title Two"), ncol=1),
ncol = 2)
To get the following:

Keep all plot components same size in ggplot2 between two plots

I would like two separate plots. I am using them in different frames of a beamer presentation and I will add one line to the other (eventually, not in example below). Thus I do not want the presentation to "skip" ("jump" ?) from one slide to the next slide. I would like it to look like the line is being added naturally. The below code I believe shows the problem. It is subtle, but not how the plot area of the second plot is slightly larger than of the first plot. This happens because of the y axis label.
library(ggplot2)
dfr1 <- data.frame(
time = 1:10,
value = runif(10)
)
dfr2 <- data.frame(
time = 1:10,
value = runif(10, 1000, 1001)
)
p1 <- ggplot(dfr1, aes(time, value)) + geom_line() + scale_y_continuous(breaks = NULL) + scale_x_continuous(breaks = NULL) + ylab(expression(hat(z)==hat(gamma)[1]*time+hat(gamma)[4]*time^2))
print(p1)
dev.new()
p2 <- ggplot(dfr2, aes(time, value)) + geom_line() + scale_y_continuous(breaks = NULL) + scale_x_continuous(breaks = NULL) + ylab(".")
print(p2)
I would prefer to not have a hackish solution such as setting the size of the axis label manually or adding spaces on the x-axis (see one reference below), because I will use this technique in several settings and the labels can change at any time (I like reproducibility so want a flexible solution).
I'm searched a lot and have found the following:
Specifying ggplot2 panel width
How can I make consistent-width plots in ggplot (with legends)?
https://groups.google.com/forum/#!topic/ggplot2/2MNoYtX8EEY
How can I add variable size y-axis labels in R with ggplot2 without changing the plot width?
They do not work for me, mainly because I need separate plots, so it is not a matter of aligning them virtically on one combined plot as in some of the above solutions.
haven't tried, but this might work,
gl <- lapply(list(p1,p2), ggplotGrob)
library(grid)
widths <- do.call(unit.pmax, lapply(gl, "[[", "widths"))
heights <- do.call(unit.pmax, lapply(gl, "[[", "heights"))
lg <- lapply(gl, function(g) {g$widths <- widths; g$heights <- heights; g})
grid.newpage()
grid.draw(lg[[1]])
grid.newpage()
grid.draw(lg[[2]])
How about using this for p2:
p2 <- ggplot(dfr2, aes(time, value)) + geom_line() +
scale_y_continuous(breaks = NULL) +
scale_x_continuous(breaks = NULL) +
ylab(expression(hat(z)==hat(gamma)[1]*time+hat(gamma)[4]*time^2)) +
theme(axis.title.y=element_text(color=NA))
This has the same label as p1, but the color is NA so it doesn't display. You could also use color="white".

ggplot2 facet margin

I use facet_wrap to plot some data. Here is an example:
library (ggplot2)
library (reshape)
# generate some dummy data
x = seq(0,1,0.05)
precision = sqrt(x)
recall = 1 - precision
fmeasure = 2 * (precision * recall) / (precision + recall)
# prepare it for plotting
df = data.frame(x=x, precision=precision, recall=recall, fmeasure=fmeasure)
df = melt(df, id.vars=c(x))
# plot it
p = ggplot(df, aes(x=x, y=value, group=variable))
p = p + geom_line() + facet_wrap(~variable, ncol=3)
p = p + coord_cartesian(xlim=c(0,1), ylim=c(0,1)) # second plot is without this line
print (p)
Figure 1: Plot for above code.
However, what you see in Figure 1 is that the first and last labels of consequent facets overlap. This could be fixed by increasing the space between facets. Other option is to remove xlim and ylim ranges as depicted in Figure 2, but this keeps unnecessary space in the facet itself.
Figure 2: Plot with line p = p + coord_cartesian(xlim=c(0,1), ylim=c(0,1)) removed.
I have tried to increase the space between the facets, but so far I have been unable to do it. Do you have any advice?
I use ggplot2 version 0.9.1 .
for 0.9.1 use: p + opts(panel.margin = unit(2, "lines")) but you have a lot of extra white space and IMO lose some of the effect of the faceting (note 0.9.2 now uses theme instead of opts)
Over the years the ggplot2 API has changed, as of 2018-02-01 this is the updated solution:
p + theme(panel.spacing = unit(2, "lines"))
Building upon Tyler's answer, you can further squeeze the facet panels together using the strip.text theme parameter as follows:
library(tidyverse)
mpgTidy <- pivot_longer(mpg, c(cty, hwy), names_to="mpg_categ", values_to="mpg")
g <- ggplot(mpgTidy, aes(x=displ, y=mpg, color=factor(cyl))) +
facet_wrap(~ mpg_categ) +
geom_point()
g
g + theme(strip.text=element_text(margin=margin()),
panel.spacing=unit(0, "lines"))
This can be useful when facet labels are long or include newlines and the faceted plot has both rows and columns.

Resources