Making a a four quadrant proportional area chart in R - r

I am looking for a method, using ggplot2 or grid, to make a chart like the one below. I can recreate this in Tableau, but am not sure where to begin (data setup, packages) to do so in R. Any help recreating this would be great! I am hoping to use a chart like this in the future.

You can try working with this function.
four_quadrant <- function(x, col_quad="gray65", col_text="white") {
nx <- length(x)
sqx <- sqrt(x)
df <- data.frame(x=c(sqx[1],-sqx[2],-sqx[3],sqx[4])/2,
y=c(sqx[1],sqx[2],-sqx[3],-sqx[4])/2,
size=sqx, label=x)
mm <- max(df$size)*1.1
ggplot(data=df, aes(x=x, y=y, width=size, height=size,
group=factor(size))) +
geom_tile(fill=col_quad) +
geom_text(aes(label=label), col=col_text, size=5) +
geom_hline(aes(yintercept=0), size=0.8) +
geom_vline(aes(xintercept=0), size=0.8) +
coord_fixed() +
xlim(c(-mm,mm)) + ylim(c(-mm,mm)) +
theme_void() +
theme(legend.position = "none")
}
x <- c(18, 54, 5, 15)
p1 <- four_quadrant(x)
x <- c(30, 17, 6, 34)
p2 <- four_quadrant(x, col_quad="salmon")
gridExtra::grid.arrange(p1, p2, nrow=1)

You can rather easily do it with ggplot using geom_rect. I've created a mock up data of the first chart to show you how to create one plot. You can reuse this to create the others and put them together using grid (there are loads of examples on SO how to do this).
library(tidyverse)
df <- data.frame(perc = c(54, 18, 5, 15),
wall_policy = c("oppose", "favor", "oppose", "favor"),
dreamer_policy = c("favor", "favor", "oppose", "oppose"),
stringsAsFactors = FALSE)
df <- df %>%
mutate(xmin = if_else(wall_policy == "oppose", -sqrt(perc), 0),
xmax = if_else(wall_policy == "favor", sqrt(perc), 0),
ymin = if_else(dreamer_policy == "oppose", -sqrt(perc), 0),
ymax = if_else(dreamer_policy == "favor", sqrt(perc), 0))
ggplot(df) +
geom_rect(aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), fill = "grey") +
geom_text(aes(x = xmin + 0.5*sqrt(perc),
y = ymin + 0.5*sqrt(perc),
label = perc),
color = "white", size = 10) +
coord_equal() +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 0) +
labs(title = "Total") +
theme_minimal() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(color="grey40", face="bold",
size=20, hjust = 0.5))

Related

How can I make a discontinuous axis in R with ggplot2?

I have a dataframe (dat) with two columns 1) Month and 2) Value. I would like to highlight that the x-axis is not continuous in my boxplot by interrupting the x-axis with two angled lines on the x-axis that are empty between the angled lines.
Example Data and Boxplot
library(ggplot2)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black"))
The ideal figure would look something like below. How can I make this discontinuous axis in ggplot?
You could make use of the extended axis guides in the ggh4x package. Alas, you won't easily be able to create the "separators" without a hack similar to the one suggested by user Zhiqiang Wang
guide_axis_truncated accepts vectors to define lower and upper trunks. This also works for units, by the way, then you have to pass the vector inside the unit function (e.g., trunc_lower = unit(c(0,.45), "npc") !
library(ggplot2)
library(ggh4x)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
# this is to make it slightly more programmatic
x1end <- 3.45
x2start <- 3.55
p <-
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_classic() +
theme(axis.line = element_line(colour = "black"))
p +
guides(x = guide_axis_truncated(
trunc_lower = c(-Inf, x2start),
trunc_upper = c(x1end, Inf)
))
Created on 2021-11-01 by the reprex package (v2.0.1)
The below is taking user Zhiqiang Wang's hack a step further. You will see I am using simple trigonometry to calculate the segment coordinates. in order to make the angle actually look as it is defined in the function, you would need to set coord_equal.
# a simple function to help make the segments
add_separators <- function(x, y = 0, angle = 45, length = .1){
add_y <- length * sin(angle * pi/180)
add_x <- length * cos(angle * pi/180)
## making the list for your segments
myseg <- list(x = x - add_x, xend = x + add_x,
y = rep(y - add_y, length(x)), yend = rep(y + add_y, length(x)))
## this function returns an annotate layer with your segment coordinates
annotate("segment",
x = myseg$x, xend = myseg$xend,
y = myseg$y, yend = myseg$yend)
}
# you will need to set limits for correct positioning of your separators
# I chose 0.05 because this is the expand factor by default
y_sep <- min(dat$Value) -0.05*(min(dat$Value))
p +
guides(x = guide_axis_truncated(
trunc_lower = c(-Inf, x2start),
trunc_upper = c(x1end, Inf)
)) +
add_separators(x = c(x1end, x2start), y = y_sep, angle = 70) +
# you need to set expand to 0
scale_y_continuous(expand = c(0,0)) +
## to make the angle look like specified, you would need to use coord_equal()
coord_cartesian(clip = "off", ylim = c(y_sep, NA))
I think it is possible to get what you want. It may take some work.
Here is your graph:
library(ggplot2)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
p <- ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black"))
Here is my effort:
p + annotate("segment", x = c(3.3, 3.5), xend = c(3.6, 3.8), y = c(14, 14), yend = c(15, 15))+
coord_cartesian(clip = "off", ylim = c(15, 25))
Get something like this:
If you want to go further, it may take several tries to get it right:
p + annotate("segment", x = c(3.3, 3.5), xend = c(3.6, 3.8), y = c(14, 14), yend = c(15, 15))+
annotate("segment", x = c(0, 3.65), xend = c(3.45, 7), y = c(14.55, 14.55), yend = c(14.55, 14.55)) +
coord_cartesian(clip = "off", ylim = c(15, 25)) +
theme_classic()+
theme(axis.line.x = element_blank())
Just replace axis with two new lines. This is a rough idea, it may take some time to make it perfect.
You could use facet_wrap. If you assign the first 3 months to one group, and the other months to another, then you can produce two plots that are side by side and use a single y axis.
It's not exactly what you want, but it will show the data effectively, and highlights the fact that the x axis is not continuous.
dat$group[dat$Month %in% c("1", "2", "3")] <- 1
dat$group[dat$Month %in% c("10", "11", "12")] <- 2
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black")) +
facet_wrap(~group, scales = "free_x")
* Differences in the plot are likely due to using different versions of R where the set.seed gives different result

Delete the symbol a from legend

I need to delete that symbol 'a' that is coming in the legend, plus I would like to know if there is a possibility to place the label on the top of the bars.
This my example file:
Residue,Position,Weight,SVM Count,Odd,Ttest,lower,upper,Resistance
G163R,163,0.357,49,19.9453848,6.978518E-82,5.6628402,70.2925768,Accessory
V165I,165,0.268,49,2.98167788,1.60934E-80,1.25797484,7.06728692,Novel
N155H,155,0.253,50,38.6089584,1.089188E-83,9.5815554,155.7070612,Major
library(ggplot2)
m <- read.csv('example.csv', header=T, row.names=1)
boxOdds = m$Odd
df <- data.frame(
yAxis = length(boxOdds):1,
boxnucleotide = m$Position,
boxCILow = m$lower,
boxCIHigh = m$upper,
Mutation = m$Resistance)
ticksy<-c(seq(0,0.3,by=.1), seq(0, 1, by =.5), seq(0, 20, by =5), seq(0, 150, by =50))
ticksx<-c(seq(0,300,by=25))
p <- ggplot(df, aes(x = boxnucleotide, y = boxOdds, colour=Mutation,label=rownames(m)))
p1 <- p + geom_errorbar(aes(ymax = boxCIHigh, ymin = boxCILow), size = .5, height = .01) +
geom_point(size = 1) +
theme_bw() +
theme(panel.grid.minor = element_blank()) +
scale_y_continuous(breaks=ticksy, labels = ticksy) +
scale_x_continuous(breaks=ticksx, labels = ticksx) +
coord_trans(y = "log10") +
ylab("Odds ratio (log scale)") +
scale_color_manual(values=c("#00BFC4","#F8766D","#619CFF")) +
xlab("Integrase nucleotide position") +
geom_text(size=4,hjust=0, vjust=0)+
theme(legend.position = c(0.9, 0.9))
p1
I already tried all possible solutions from Remove 'a' from legend when using aesthetics and geom_text but none worked out

Problems adding legend to ggplot2 + ggfortify

I'm having troubles using
scale_colour_manual
function of ggplot. I tried
guide = "legend"
to force legend appears, but it doesn't work. Rep code:
library(ggfortify)
library(ggplot2)
p <- ggdistribution(pgamma, seq(0, 100, 0.1), shape = 0.92, scale = 22,
colour = 'red')
p2 <- ggdistribution(pgamma, seq(0, 100, 0.1), shape = 0.9, scale = 5,
colour = 'blue', p=p)
p2 +
theme_bw(base_size = 14) +
theme(legend.position ="top") +
xlab("Precipitación") +
ylab("F(x)") +
scale_colour_manual("Legend title", guide = "legend",
values = c("red", "blue"), labels = c("Observado","Reforecast")) +
ggtitle("Ajuste Gamma")
A solution with stat_function:
library(ggplot2)
library(scales)
cols <- c("LINE1"="red","LINE2"="blue")
df <- data.frame(x=seq(0, 100, 0.1))
ggplot(data=df, aes(x=x)) +
stat_function(aes(colour = "LINE1"), fun=pgamma, args=list(shape = 0.92, scale = 22)) +
stat_function(aes(colour = "LINE2"), fun=pgamma, args=list(shape = 0.9, scale = 5)) +
theme_bw(base_size = 14) +
theme(legend.position ="top") +
xlab("Precipitación") +
ylab("F(x)") +
scale_colour_manual("Legend title", values=c(LINE1="red",LINE2="blue"),
labels = c("Observado","Reforecast")) +
scale_y_continuous(labels=percent) +
ggtitle("Ajuste Gamma")
This appears to be a bug with ggfortify.* You can achieve identical results simply using geom_line() from ggplot2 though:
library(ggplot2)
# Sequence of values to draw from dist(s) for plotting
x = seq(0, 100, 0.1)
# Defining dists
d1 = pgamma(x, shape=0.92, scale=22)
d2 = pgamma(x, shape=0.90, scale=5)
# Plotting
p1 = ggplot() +
geom_line(aes(x,d1,colour='red')) +
geom_line(aes(x,d2,colour='blue')) +
theme_bw(base_size = 14) +
theme(legend.position="top") +
ggtitle("Ajuste Gamma") +
xlab("Precipitación") +
ylab("F(x)") +
scale_colour_manual("Legend title",
guide = "legend",
values = c("red", "blue"),
labels=c("Observado", "Reforecast"))
* Related question: Plotting multiple density distributions on one plot

Plot title is not displaying on two lines while using conventional methods [duplicate]

I'm using ggplot2 to improve precipitation barplots.
Here's a reproducible example of what I want to achieve:
library(ggplot2)
library(gridExtra)
secu <- seq(1, 16, by=2)
melt.d <- data.frame(y=secu, x=LETTERS[1:8])
m <- ggplot(melt.d, aes(x=x, y=y)) +
geom_bar(fill="darkblue") +
labs(x="Weather stations", y="Accumulated Rainfall [mm]") +
opts(axis.text.x=theme_text(angle=-45, hjust=0, vjust=1),
title=expression("Rainfall"), plot.margin = unit(c(1.5, 1, 1, 1), "cm"),
plot.title = theme_text(size = 25, face = "bold", colour = "black", vjust = 5))
z <- arrangeGrob(m, sub = textGrob("Location", x = 0, hjust = -3.5, vjust = -33, gp = gpar(fontsize = 18, col = "gray40"))) #Or guessing x and y with just option
z
I don't know how to avoid using guessing numbers on hjust and vjust on ggplot2? Is there a better way to put a subtitle (not just using \n, but a subtitle with different text color and size)?
I need to be able to use with ggsave to have a pdf file.
Here are two related questions:
Add a footnote citation outside of plot area in R?
How can I add a subtitle and change the font size of ggplot plots in R?
Thanks for any help.
The latest ggplot2 builds (i.e., 2.1.0.9000 or newer) have subtitles and below-plot captions as built-in functionality. That means you can do this:
library(ggplot2) # 2.1.0.9000+
secu <- seq(1, 16, by=2)
melt.d <- data.frame(y=secu, x=LETTERS[1:8])
m <- ggplot(melt.d, aes(x=x, y=y))
m <- m + geom_bar(fill="darkblue", stat="identity")
m <- m + labs(x="Weather stations",
y="Accumulated Rainfall [mm]",
title="Rainfall",
subtitle="Location")
m <- m + theme(axis.text.x=element_text(angle=-45, hjust=0, vjust=1))
m <- m + theme(plot.title=element_text(size=25, hjust=0.5, face="bold", colour="maroon", vjust=-1))
m <- m + theme(plot.subtitle=element_text(size=18, hjust=0.5, face="italic", color="black"))
m
Ignore this answer ggplot2 version 2.2.0 has title and subtitle functionality. See #hrbrmstr's answer below.
You could use nested atop functions inside an expression to get different sizes.
EDIT Updated code for ggplot2 0.9.3
m <- ggplot(melt.d, aes(x=x, y=y)) +
geom_bar(fill="darkblue", stat = "identity") +
labs(x="Weather stations", y="Accumulated Rainfall [mm]") +
ggtitle(expression(atop("Rainfall", atop(italic("Location"), "")))) +
theme(axis.text.x = element_text(angle=-45, hjust=0, vjust=1),
#plot.margin = unit(c(1.5, 1, 1, 1), "cm"),
plot.title = element_text(size = 25, face = "bold", colour = "black", vjust = -1))
it's not too hard to add grobs to the gtable and make a fancy title that way,
library(ggplot2)
library(grid)
library(gridExtra)
library(magrittr)
library(gtable)
p <- ggplot() +
theme(plot.margin = unit(c(0.5, 1, 1, 1), "cm"))
lg <- list(textGrob("Rainfall", x=0, hjust=0,
gp = gpar(fontsize=24, fontfamily="Skia", face=2, col="turquoise4")),
textGrob("location", x=0, hjust=0,
gp = gpar(fontsize=14, fontfamily="Zapfino", fontface=3, col="violetred1")),
pointsGrob(pch=21, gp=gpar(col=NA, cex=0.5,fill="steelblue")))
margin <- unit(0.2, "line")
tg <- arrangeGrob(grobs=lg, layout_matrix=matrix(c(1,2,3,3), ncol=2),
widths = unit.c(grobWidth(lg[[1]]), unit(1,"null")),
heights = do.call(unit.c, lapply(lg[c(1,2)], grobHeight)) + margin)
grid.newpage()
ggplotGrob(p) %>%
gtable_add_rows(sum(tg$heights), 0) %>%
gtable_add_grob(grobs=tg, t = 1, l = 4) %>%
grid.draw()
It appears opts is deprecated as of ggplot 2 0.9.1 and no longer functional. This worked for me with the latest versions as of today: + ggtitle(expression(atop("Top line", atop(italic("2nd line"), "")))).
This version uses a gtable function. It allows two lines of text in the title. The text, size, colour, and font face of each line can be set independently of the other. However, the function will modify a plot with a single plot panel only.
Minor edit: Updating to ggplot2 v2.0.0
# The original plot
library(ggplot2)
secu <- seq(1, 16, by = 2)
melt.d <- data.frame(y = secu, x = LETTERS[1:8])
m <- ggplot(melt.d, aes(x = x, y = y)) +
geom_bar(fill="darkblue", stat = "identity") +
labs(x = "Weather stations", y = "Accumulated Rainfall [mm]") +
theme(axis.text.x = element_text(angle = -45, hjust = 0, vjust = 1))
# The function to set text, size, colour, and face
plot.title = function(plot = NULL, text.1 = NULL, text.2 = NULL,
size.1 = 12, size.2 = 12,
col.1 = "black", col.2 = "black",
face.1 = "plain", face.2 = "plain") {
library(gtable)
library(grid)
gt = ggplotGrob(plot)
text.grob1 = textGrob(text.1, y = unit(.45, "npc"),
gp = gpar(fontsize = size.1, col = col.1, fontface = face.1))
text.grob2 = textGrob(text.2, y = unit(.65, "npc"),
gp = gpar(fontsize = size.2, col = col.2, fontface = face.2))
text = matrix(list(text.grob1, text.grob2), nrow = 2)
text = gtable_matrix(name = "title", grobs = text,
widths = unit(1, "null"),
heights = unit.c(unit(1.1, "grobheight", text.grob1) + unit(0.5, "lines"), unit(1.1, "grobheight", text.grob2) + unit(0.5, "lines")))
gt = gtable_add_grob(gt, text, t = 2, l = 4)
gt$heights[2] = sum(text$heights)
class(gt) = c("Title", class(gt))
gt
}
# A print method for the plot
print.Title <- function(x) {
grid.newpage()
grid.draw(x)
}
# Try it out - modify the original plot
p = plot.title(m, "Rainfall", "Location",
size.1 = 20, size.2 = 15,
col.1 = "red", col.2 = "blue",
face.2 = "italic")
p
You could use wrap the plot in grid.arrange and pass a custom grid-based title,
library(ggplot2)
library(gridExtra)
p <- ggplot() +
theme(plot.margin = unit(c(0.5, 1, 1, 1), "cm"))
tg <- grobTree(textGrob("Rainfall", y=1, vjust=1, gp = gpar(fontsize=25, face=2, col="black")),
textGrob("location", y=0, vjust=0, gp = gpar(fontsize=12, face=3, col="grey50")),
cl="titlegrob")
heightDetails.titlegrob <- function(x) do.call(sum,lapply(x$children, grobHeight))
grid.arrange(p, top = tg)
You might have noticed that Sandy's code doesn't produce a bold title for "Rainfall" - the instruction to make this bold should occur within the atop() function rather than the theme() function.
ggplot(melt.d, aes(x=x, y=y)) +
geom_bar(fill="darkblue", stat = "identity") +
labs(x="Weather stations", y="Accumulated Rainfall [mm]") +
ggtitle(expression(atop(bold("Rainfall"), atop(italic("Location"), "")))) +
theme(axis.text.x = element_text(angle=-45, hjust=0, vjust=1),
plot.title = element_text(size = 25, colour = "black", vjust = -1))

How to add a ggplot2 subtitle with different size and colour?

I'm using ggplot2 to improve precipitation barplots.
Here's a reproducible example of what I want to achieve:
library(ggplot2)
library(gridExtra)
secu <- seq(1, 16, by=2)
melt.d <- data.frame(y=secu, x=LETTERS[1:8])
m <- ggplot(melt.d, aes(x=x, y=y)) +
geom_bar(fill="darkblue") +
labs(x="Weather stations", y="Accumulated Rainfall [mm]") +
opts(axis.text.x=theme_text(angle=-45, hjust=0, vjust=1),
title=expression("Rainfall"), plot.margin = unit(c(1.5, 1, 1, 1), "cm"),
plot.title = theme_text(size = 25, face = "bold", colour = "black", vjust = 5))
z <- arrangeGrob(m, sub = textGrob("Location", x = 0, hjust = -3.5, vjust = -33, gp = gpar(fontsize = 18, col = "gray40"))) #Or guessing x and y with just option
z
I don't know how to avoid using guessing numbers on hjust and vjust on ggplot2? Is there a better way to put a subtitle (not just using \n, but a subtitle with different text color and size)?
I need to be able to use with ggsave to have a pdf file.
Here are two related questions:
Add a footnote citation outside of plot area in R?
How can I add a subtitle and change the font size of ggplot plots in R?
Thanks for any help.
The latest ggplot2 builds (i.e., 2.1.0.9000 or newer) have subtitles and below-plot captions as built-in functionality. That means you can do this:
library(ggplot2) # 2.1.0.9000+
secu <- seq(1, 16, by=2)
melt.d <- data.frame(y=secu, x=LETTERS[1:8])
m <- ggplot(melt.d, aes(x=x, y=y))
m <- m + geom_bar(fill="darkblue", stat="identity")
m <- m + labs(x="Weather stations",
y="Accumulated Rainfall [mm]",
title="Rainfall",
subtitle="Location")
m <- m + theme(axis.text.x=element_text(angle=-45, hjust=0, vjust=1))
m <- m + theme(plot.title=element_text(size=25, hjust=0.5, face="bold", colour="maroon", vjust=-1))
m <- m + theme(plot.subtitle=element_text(size=18, hjust=0.5, face="italic", color="black"))
m
Ignore this answer ggplot2 version 2.2.0 has title and subtitle functionality. See #hrbrmstr's answer below.
You could use nested atop functions inside an expression to get different sizes.
EDIT Updated code for ggplot2 0.9.3
m <- ggplot(melt.d, aes(x=x, y=y)) +
geom_bar(fill="darkblue", stat = "identity") +
labs(x="Weather stations", y="Accumulated Rainfall [mm]") +
ggtitle(expression(atop("Rainfall", atop(italic("Location"), "")))) +
theme(axis.text.x = element_text(angle=-45, hjust=0, vjust=1),
#plot.margin = unit(c(1.5, 1, 1, 1), "cm"),
plot.title = element_text(size = 25, face = "bold", colour = "black", vjust = -1))
it's not too hard to add grobs to the gtable and make a fancy title that way,
library(ggplot2)
library(grid)
library(gridExtra)
library(magrittr)
library(gtable)
p <- ggplot() +
theme(plot.margin = unit(c(0.5, 1, 1, 1), "cm"))
lg <- list(textGrob("Rainfall", x=0, hjust=0,
gp = gpar(fontsize=24, fontfamily="Skia", face=2, col="turquoise4")),
textGrob("location", x=0, hjust=0,
gp = gpar(fontsize=14, fontfamily="Zapfino", fontface=3, col="violetred1")),
pointsGrob(pch=21, gp=gpar(col=NA, cex=0.5,fill="steelblue")))
margin <- unit(0.2, "line")
tg <- arrangeGrob(grobs=lg, layout_matrix=matrix(c(1,2,3,3), ncol=2),
widths = unit.c(grobWidth(lg[[1]]), unit(1,"null")),
heights = do.call(unit.c, lapply(lg[c(1,2)], grobHeight)) + margin)
grid.newpage()
ggplotGrob(p) %>%
gtable_add_rows(sum(tg$heights), 0) %>%
gtable_add_grob(grobs=tg, t = 1, l = 4) %>%
grid.draw()
It appears opts is deprecated as of ggplot 2 0.9.1 and no longer functional. This worked for me with the latest versions as of today: + ggtitle(expression(atop("Top line", atop(italic("2nd line"), "")))).
This version uses a gtable function. It allows two lines of text in the title. The text, size, colour, and font face of each line can be set independently of the other. However, the function will modify a plot with a single plot panel only.
Minor edit: Updating to ggplot2 v2.0.0
# The original plot
library(ggplot2)
secu <- seq(1, 16, by = 2)
melt.d <- data.frame(y = secu, x = LETTERS[1:8])
m <- ggplot(melt.d, aes(x = x, y = y)) +
geom_bar(fill="darkblue", stat = "identity") +
labs(x = "Weather stations", y = "Accumulated Rainfall [mm]") +
theme(axis.text.x = element_text(angle = -45, hjust = 0, vjust = 1))
# The function to set text, size, colour, and face
plot.title = function(plot = NULL, text.1 = NULL, text.2 = NULL,
size.1 = 12, size.2 = 12,
col.1 = "black", col.2 = "black",
face.1 = "plain", face.2 = "plain") {
library(gtable)
library(grid)
gt = ggplotGrob(plot)
text.grob1 = textGrob(text.1, y = unit(.45, "npc"),
gp = gpar(fontsize = size.1, col = col.1, fontface = face.1))
text.grob2 = textGrob(text.2, y = unit(.65, "npc"),
gp = gpar(fontsize = size.2, col = col.2, fontface = face.2))
text = matrix(list(text.grob1, text.grob2), nrow = 2)
text = gtable_matrix(name = "title", grobs = text,
widths = unit(1, "null"),
heights = unit.c(unit(1.1, "grobheight", text.grob1) + unit(0.5, "lines"), unit(1.1, "grobheight", text.grob2) + unit(0.5, "lines")))
gt = gtable_add_grob(gt, text, t = 2, l = 4)
gt$heights[2] = sum(text$heights)
class(gt) = c("Title", class(gt))
gt
}
# A print method for the plot
print.Title <- function(x) {
grid.newpage()
grid.draw(x)
}
# Try it out - modify the original plot
p = plot.title(m, "Rainfall", "Location",
size.1 = 20, size.2 = 15,
col.1 = "red", col.2 = "blue",
face.2 = "italic")
p
You could use wrap the plot in grid.arrange and pass a custom grid-based title,
library(ggplot2)
library(gridExtra)
p <- ggplot() +
theme(plot.margin = unit(c(0.5, 1, 1, 1), "cm"))
tg <- grobTree(textGrob("Rainfall", y=1, vjust=1, gp = gpar(fontsize=25, face=2, col="black")),
textGrob("location", y=0, vjust=0, gp = gpar(fontsize=12, face=3, col="grey50")),
cl="titlegrob")
heightDetails.titlegrob <- function(x) do.call(sum,lapply(x$children, grobHeight))
grid.arrange(p, top = tg)
You might have noticed that Sandy's code doesn't produce a bold title for "Rainfall" - the instruction to make this bold should occur within the atop() function rather than the theme() function.
ggplot(melt.d, aes(x=x, y=y)) +
geom_bar(fill="darkblue", stat = "identity") +
labs(x="Weather stations", y="Accumulated Rainfall [mm]") +
ggtitle(expression(atop(bold("Rainfall"), atop(italic("Location"), "")))) +
theme(axis.text.x = element_text(angle=-45, hjust=0, vjust=1),
plot.title = element_text(size = 25, colour = "black", vjust = -1))

Resources