R - How can I add a bivariate legend to my ggplot2 chart? - r

I'm trying to add a bivariate legend to my ggplot2 chart but I don't know whether (a) this is possible through some guides options and (b) how to achieve it.
The only way I've managed to produce something close to the desired outcome was by specifically creating a new chart which resembles a legend (named p.legend below) and inserting it, via the cowplot package, somewhere in the original chart (named p.chart below). But surely there must be a better way than this, given that this approach requires creating the legend in the first place and fiddling with its size/location to fit it in the original chart.
Here's code for a dummy example of my approach:
library(tidyverse)
# Create Dummy Data #
set.seed(876)
n <- 2
df <- expand.grid(Area = LETTERS[1:n],
Period = c("Summer", "Winter"),
stringsAsFactors = FALSE) %>%
mutate(Objective = runif(2 * n, min = 0, max = 2),
Performance = runif(2 * n) * Objective) %>%
gather(Type, Value, Objective:Performance)
# Original chart without legend #
p.chart <- df %>%
ggplot(., aes(x = Area)) +
geom_col(data = . %>% filter(Type == "Objective"),
aes(y = Value, fill = Period),
position = "dodge", width = 0.7, alpha = 0.6) +
geom_col(data = . %>% filter(Type == "Performance"),
aes(y = Value, fill = Period),
position = "dodge", width = 0.7) +
scale_fill_manual(values = c("Summer" = "#ff7f00", "Winter" = "#1f78b4"), guide = FALSE) +
theme_minimal() +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.y = element_blank())
# Create a chart resembling a legend #
p.legend <- expand.grid(Period = c("Summer", "Winter"),
Type = c("Objective", "Performance"),
stringsAsFactors = FALSE) %>%
ggplot(., aes(x = Period, y = factor(Type, levels = c("Performance", "Objective")),
fill = Period, alpha = Type)) +
geom_tile() +
scale_fill_manual(values = c("Summer" = "#ff7f00", "Winter" = "#1f78b4"), guide = FALSE) +
scale_alpha_manual(values = c("Objective" = 0.7, "Performance" = 1), guide = FALSE) +
ggtitle("Legend") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
rect = element_rect(fill = "transparent"),
axis.title = element_blank(),
panel.grid.major = element_blank())
# Add legend to original chart #
p.final <- cowplot::ggdraw() +
cowplot::draw_plot(plot = p.chart) +
cowplot::draw_plot(plot = p.legend, x = 0.5, y = 0.65, width = 0.4, height = 0.28, scale = 0.7)
# Save chart #
cowplot::ggsave("Bivariate Legend.png", p.final, width = 8, height = 6, dpi = 500)
... and the resulting chart:
Is there an easier way of doing this?

This might work at some point, but right now the colorbox seems to ignore all breaks, names and labels (#ClausWilke?). Probably because the multiscales package is in really early stages.
Posting since it might work when future readers are here.
library(multiscales)
df %>%
mutate(
period = as.numeric(factor(Period)),
type = as.numeric(factor(Type))
) %>%
ggplot(., aes(x = Area, y = Value, fill = zip(period, type), group = interaction(Area, Period))) +
geom_col(width = 0.7, position = 'dodge') +
bivariate_scale(
"fill",
pal_hue_sat(c(0.07, 0.6), c(0.4, 0.8)),
guide = guide_colorbox(
nbin = 2,
name = c("Period", "Type"), #ignored
breaks = list(1:2, 1:2), #ignored
labels = list(levels(.$Period), levels(.$Type)) #ignored
)

Related

3 layer donut chart in R

I am trying to recreate this image in R, however I am unable to work out how to have 3 layers to a donut chart - everything I find (for instance, webr::PieDonut) only allows 2. Using ggplot I am also unable to re-create it.
A MRE is:
library(ggplot2)
library(webr)
library(dplyr)
lexicon <- data.frame("Level1" = c(rep("Flavour", 11), rep("Appearance", 4)),
"Level2" = c(rep("Misc", 6), rep("Pungent", 5), rep("Colour", 4)),
"Level3" = c("Fresh", "Refreshing", "Soapy", "Minty", "Nutty", "Milky", "Peppery", "Sharp", "Horseradish", "Mustard hot", "Spicy", "Colourful"," Fresh Green", "Dark Green", "Bright Green")
)
PieDonut(lexicon, aes(Level1, Level2), title = "Salad Lexicon", showRatioDonut =FALSE, showRatioPie = FALSE)
ggplot(lexicon, aes(Level2, Level3, fill = Level1)) +
geom_col() +
scale_fill_viridis_d() +
coord_polar("y")
While the PieDonut works for 2 levels (not shown), it doesn't allow the final level to be included. The ggplot approach also does not work, as seen in the figure below.
How can I get this style of chart in R? Either with ggplot or base plotting.
I think a nice alternative is to use geom_rect here after some data manipulation. Using the fill, color, and alpha scales can help improve the differentiation of categories. I would also use geom_textpath here, though I might go for circumferential labels if there is room to do so:
lexicon %>%
mutate(top_level = Level1) %>%
pivot_longer(1:3) %>%
group_by(name, value) %>%
mutate(width = n()) %>%
unique() %>%
arrange(name) %>%
group_by(name) %>%
mutate(ymid = as.numeric(sub("\\D+", "", name)),
ymax = ymid + 0.5, ymin = ymid - 0.5,
xmin = c(0, head(cumsum(width), -1)),
xmax = cumsum(width),
xmid = (xmax + xmin) / 2) %>%
ggplot(aes(xmid, ymid, fill = top_level)) +
geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax,
alpha = name, color = top_level)) +
geomtextpath::geom_textpath(aes(y = ymid + 0.25, label = value,
group = value)) +
scale_alpha_manual(values = c(1, 0.3, 0.1)) +
scale_fill_manual(values = c("#cd9900", "#00817e")) +
scale_colour_manual(values = c("#cd9900", "#00817e")) +
scale_y_continuous(limits = c(-0.5, 3.6)) +
coord_polar() +
theme_void() +
theme(legend.position = "none")
One option would be to reeshape your data to long and do some manual aggregating before passing to ggplot. Additionally I use geomtextpath::geom_textpath to add the labels:
library(ggplot2)
library(dplyr)
library(geomtextpath)
lexicon <- data.frame("Level1" = c(rep("Flavour", 11), rep("Appearance", 4)),
"Level2" = c(rep("Misc", 6), rep("Pungent", 5), rep("Colour", 4)),
"Level3" = c("Fresh", "Refreshing", "Soapy", "Minty", "Nutty", "Milky", "Peppery", "Sharp", "Horseradish", "Mustard hot", "Spicy", "Colourful"," Fresh Green", "Dark Green", "Bright Green")
)
lexicon_long <- lexicon |>
mutate(fill = Level1) |>
tidyr::pivot_longer(-fill, names_to = "level", values_to = "label") |>
mutate(label = forcats::fct_inorder(label)) |>
count(fill, level, label) |>
group_by(level) |>
mutate(pct = n / sum(n))
ggplot(lexicon_long, aes(level, pct, fill = fill)) +
geom_col(color = "white") +
geom_textpath(aes(label = label, group = label),
position = position_stack(vjust = .5),
upright = TRUE, hjust = .5, size = 3
) +
scale_fill_viridis_d() +
coord_polar("y") +
theme_void() +
guides(fill = "none")

Text color with geom_label_repel

Not specific to any particular piece of code, is there a relatively straightforward way to change the color of the text in a geom_label_repel box?
Specifically, I have code that produces the below chart
The percentage in the label box is the percent change in 7-day moving average for the most recent week over the week prior. I'd simply like to color the text red when the value is positive and green when it is negative.
The dataframe for this chart can be copied from here.
The plot code is
#endpoint layer
BaseEndpoints <- smDailyBaseData %>% filter(Base %in% AFMCbases) %>%
group_by(Base) %>%
filter(DaysSince == max(DaysSince)) %>%
select(Base, abbv, DaysSince, newRate,label) %>%
ungroup()
ZoomEndpoints <- BaseEndpoints %>% filter(Base != 'Edwards') %>%
mutate(zoom = TRUE)
CAEndPoint <- BaseEndpoints %>% filter(Base == 'Edwards') %>%
mutate(zoom = FALSE)
ZoomEndpoints <- rbind(ZoomEndpoints, CAEndPoint)
BasePlot <- smDailyBaseData %>% filter(Base %in% AFMCbases) %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = newRate)) +
geom_line(aes(color=abbv),show.legend = FALSE) +
scale_color_ucscgb() +
geom_point(data = BaseEndpoints,size = 1.5,shape = 21,
aes(color = abbv,fill = abbv), show.legend = FALSE) +
geom_label_repel(data=ZoomEndpoints, aes(label=label), show.legend = FALSE,
vjust = 0, xlim=c(105,200), size=3, direction='y') +
labs(x = "Days Since First Confirmed Case",
y = "% Local Population Infected Daily") +
theme(plot.title = element_text(size = rel(1), face = "bold"),
plot.subtitle = element_text(size = rel(0.7)),
plot.caption = element_text(size = rel(1))) +
facet_zoom(xlim = c(50,120), ylim=c(0,0.011),zoom.data=zoom)
print(BasePlot)
Yes, it's as simple as this:
library(ggplot2)
df <- data.frame(x = c(-1, -1, 1, 1), y = c(-1, 1, 1, -1), value = c(-2, -1, 1, 2))
ggplot(df, aes(x, y)) +
geom_point(size = 3) +
ggrepel::geom_label_repel(aes(label = value, colour = factor(sign(value)))) +
lims(x = c(-100, 100), y = c(-100, 100)) +
scale_colour_manual(values = c("red", "forestgreen"))
EDIT
Now we have a more concrete example, I can see the problem more clearly. There are workarounds such as using ggnewscale or a hand-crafted solution such as Ian Campbell's thorough example. Personally, I would just note that you haven't used the fill scale yet, and this looks pretty good to my eye:
Here's a bit of a hacky solution since you can't have two scale_color_*'s at the same time:
The approach centers on manually assigning the color outside of aes in the geom_label_repel call. Adding one to the grepl result that searches for the minus sign in the label allows you to subset the two colors. You need two colors for each label, I assume for the box and for the text, so I used rep.
smDailyBaseData %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = newRate)) +
geom_line(aes(color=abbv),show.legend = FALSE) +
scale_color_ucscgb() +
geom_point(data = BaseEndpoints,size = 1.5,shape = 21,
aes(color = abbv,fill = abbv), show.legend = FALSE) +
geom_label_repel(data=ZoomEndpoints, aes(label=label),
color = rep(c("green","red")[1+grepl("\\-\\d",as.factor(ZoomEndpoints$label))],times = 2),
show.legend = FALSE, vjust = 0, xlim=c(105,200),
size=3, direction='y') +
labs(x = "Days Since First Confirmed Case",
y = "% Local Population Infected Daily") +
theme(plot.title = element_text(size = rel(1), face = "bold"),
plot.subtitle = element_text(size = rel(0.7)),
plot.caption = element_text(size = rel(1))) +
facet_zoom(xlim = c(50,120), ylim=c(0,0.011),zoom.data=zoom)
Data Setup
#source("https://pastebin.com/raw/Vn2abQ4a")
BaseEndpoints <- smDailyBaseData %>%
group_by(Base) %>%
dplyr::filter(DaysSince == max(DaysSince)) %>%
dplyr::select(Base, abbv, DaysSince, newRate,label) %>%
ungroup()
ZoomEndpoints <- BaseEndpoints %>% filter(Base != 'Edwards') %>%
mutate(zoom = TRUE)
CAEndPoint <- BaseEndpoints %>% filter(Base == 'Edwards') %>%
mutate(zoom = FALSE)
ZoomEndpoints <- rbind(ZoomEndpoints, CAEndPoint)

Complex Chart in R/ggplot with Proper Legend Display

This is my first question to StackExchange, and I've searched for answers that have been helpful, but haven't really gotten me to where I'd like to be.
This is a stacked bar chart, combined with a point chart, combined with a line.
Here's my code:
theme_set(theme_light())
library(lubridate)
FM <- as.Date('2018-02-01')
x.range <- c(FM - months(1) - days(1) - days(day(FM) - 1), FM - days(day(FM) - 1) + months(1))
x.ticks <- seq(x.range[1] + days(1), x.range[2], by = 2)
#populate example data
preds <- data.frame(FM = FM, DATE = seq(x.range[1] + days(1), x.range[2] - days(1), by = 1))
preds <- data.frame(preds, S_O = round(seq(1, 1000000, by = 1000000/nrow(preds))))
preds <- data.frame(preds, S = round(ifelse(month(preds$FM) == month(preds$DATE), day(preds$DATE) / 30.4, 0) * preds$S_O))
preds <- data.frame(preds, O = preds$S_O - preds$S)
preds <- data.frame(preds, pred_sales = round(1000000 + rnorm(nrow(preds), 0, 10000)))
preds$ma <- with(preds, stats::filter(pred_sales, rep(1/5, 5), sides = 1))
y.max <- ceiling(max(preds$pred_sales) / 5000) * 5000 + 15000
line.cols <- c(O = 'palegreen4', S = 'steelblue4',
P = 'maroon', MA = 'blue')
fill.cols <- c(O = 'palegreen3', S = 'steelblue3',
P = 'red')
p <- ggplot(data = preds,
mapping = aes(DATE, pred_sales))
p <- p +
geom_bar(data = reshape2::melt(preds[,c('DATE', 'S', 'O')], id.var = 'DATE'),
mapping = aes(DATE, value, group = 1, fill = variable, color = variable),
width = 1,
stat = 'identity',
alpha = 0.5) +
geom_point(mapping = aes(DATE, pred_sales, group = 2, fill = 'P', color = 'P'),
shape = 22, #square
alpha = 0.5,
size = 2.5) +
geom_line(data = preds[!is.na(preds$ma),],
mapping = aes(DATE, ma, group = 3, color = 'MA'),
alpha = 0.8,
size = 1) +
geom_text(mapping = aes(DATE, pred_sales, label = formatC(pred_sales / 1000, format = 'd', big.mark = ',')),
angle = 90,
size = 2.75,
hjust = 1.25,
vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
scale_y_continuous(limits = c(0, y.max),
labels = function(x) { formatC(x / 1000, format='d', big.mark=',') }) +
scale_color_manual(values = line.cols,
breaks = c('MA'),
labels = c(MA = 'Mvg Avg (5)')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions'))
p
The chart it generates is this:
As you can see, the legend does a couple of funky things. It's close, but not quite there. I only want boxes with exterior borders for Predictions, Open Orders, and Sales, and only a blue line for the Mvg Avg (5).
Any advice would be appreciated.
Thanks!
Rather late, but if you are still interested to understand this problem, the following should work. Explanations are included as comments within the code:
library(dplyr)
preds %>%
# scale the values for ALL numeric columns in the dataset, before
# passing the dataset to ggplot()
mutate_if(is.numeric, ~./1000) %>%
# since x / y mappings are stated in the top level ggplot(), there's
# no need to repeat them in the subsequent layers UNLESS you want to
# override them
ggplot(mapping = aes(x = DATE, y = pred_sales)) +
# 1. use data = . to inherit the top level data frame, & modify it on
# the fly for this layer; this is neater as you are essentially
# using a single data source for the ggplot object.
# 2. geom_col() is a more succinct way to say geom_bar(stat = "identity")
# (I'm using tidyr rather than reshape package, since ggplot2 is a
# part of the tidyverse packages, & the two play together nicely)
geom_col(data = . %>%
select(S, O, DATE) %>%
tidyr::gather(variable, value, -DATE),
aes(y = value, fill = variable, color = variable),
width = 1, alpha = 0.5) +
# don't show legend for this layer (o/w the fill / color legend would
# include a square shape in the centre of each legend key)
geom_point(aes(fill = 'P', color = 'P'),
shape = 22, alpha = 0.5, size = 2.5, show.legend = FALSE) +
# use data = . %>% ... as above.
# since the fill / color aesthetic mappings from the geom_col layer would
# result in a border around all fill / color legends, avoid it all together
# here by hard coding the line color to "blue", & map its linetype instead
# to create a separate linetype-based legend later.
geom_line(data = . %>% na.omit(),
aes(y = ma, linetype = 'MA'),
color = "blue", alpha = 0.8, size = 1) +
# scales::comma is a more succinct alternative to formatC for this use case
geom_text(aes(label = scales::comma(pred_sales)),
angle = 90, size = 2.75, hjust = 1.25, vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
# as above, scales::comma is more succinct
scale_y_continuous(limits = c(0, y.max / 1000),
labels = scales::comma) +
# specify the same breaks & labels for the manual fill / color scales, so that
# a single legend is created for both
scale_color_manual(values = line.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
# create a separate line-only legend using the linetype mapping, with
# value = 1 (i.e. unbroken line) & specified alpha / color to match the
# geom_line layer
scale_linetype_manual(values = 1,
label = 'Mvg Avg (5)',
guide = guide_legend(override.aes = list(alpha = 1,
color = "blue")))

Ribbon chart in R

I search in R implementation (may be html widget on java script) a stacked bar chart in ribbon style, which allows you to see the rating change for each category in the dynamics.
It's look like ribbon chart in power bi desktop
Search rseek.org gave no results.
First off: Not a fan of that ribbon-styled stacked bar chart at all; while colourful and stylish, it's difficult to synthesise the relevant information. But that's just my opinion.
You could try building a similar plot in ggplot2 using geom_ribbon. See below for a minimal example:
# Sample data
set.seed(2017);
one <- sample(5:15, 10);
two <- rev(one);
df <- cbind.data.frame(
x = rep(1:10, 2),
y = c(one, two),
l = c(one - 1, two - 1),
h = c(one + 1, two + 1),
id = rep(c("one", "two"), each = 10));
require(ggplot2);
ggplot(df, aes(x = x, y = y)) +
geom_ribbon(aes(ymin = l, ymax = h, fill = id), alpha = 0.4) +
scale_fill_manual(values = c("#E69F00", "#56B4E9"));
If you need interactivity, you could wrap it inside plotly::ggplotly.
Using ggsankey package.
In the following you can make use of smooth argument geom_sankey_bump to control the look/feel of the chart as in ribbon chart of Power BI.
df <- data.frame (model = c("A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J"),
Year = c(2015,2015,2015,2015,2015,2015,2015,2015,2015,2015,2016,2016,2016,2016,2016,2016,2016,2016,2016,2016,2017,2017,2017,2017,2017,2017,2017,2017,2017,2017,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018),
sales = c(450,678,456,344,984,456,234,244,655,789,234,567,234,567,232,900,1005,1900,450,345,567,235,456,345,144,333,555,777,111,444,222,223,445,776,331,788,980,1003,456,434))
#install.packages("remotes")
#remotes::install_github("davidsjoberg/ggsankey")
library(ggsankey)
library(tidyverse)
ggplot(df, aes(x = Year,
node = model,
fill = model,
value = sales)) +
geom_sankey_bump(space = 0, type = "alluvial", color = "transparent", smooth = 15) +
scale_fill_viridis_d(option = "A", alpha = .8) +
theme_sankey_bump(base_size = 16) +
labs(x = NULL,
y = "Sales ($ ths)",
fill = "Model",
color = NULL) +
theme(legend.position = "bottom") +
labs(title = "Sales per model per year")
On suggestion in comments, I tried replicating some of the features of power BI chart.
# Prepare some data
set.seed(1)
df <- data.frame(
occupation = rep(c("Clerical", "Management", "Manual", "Professional", "Skilled"), 12),
Month = factor(rep(month.abb, 5), levels = month.abb, ordered = TRUE),
Sales = sample(200:1000, 60, replace = TRUE)
)
df %>%
group_by(Month) %>%
mutate(Max = sum(Sales)) %>%
ungroup() %>%
mutate(Max = max(Sales)) %>%
ggplot(aes(x = Month,
node = occupation,
fill = occupation,
value = Sales)) +
geom_col(aes(x = Month, y = Max/1.2),
alpha = 0.5,
fill = 'grey',
width = 0.4) +
geom_sankey_bump(space = 15,
type = "alluvial",
color = "transparent",
smooth = 8,
alpha = 0.8) +
scale_fill_brewer(palette = "Set3") +
theme_minimal() +
labs(x = NULL,
y = "Sales ($ ths)",
fill = "Occupation",
color = NULL) +
theme(legend.position = "top") +
labs(title = "Sales per occupation per month")
Created on 2022-07-07 by the reprex package (v2.0.1)
You may find your answers with ggalluvial package.
https://cran.r-project.org/web/packages/ggalluvial/vignettes/ggalluvial.html

Positioning x-axis text/label along x-axis based on another field in the data using ggplot

I would like to place each x-axis text/label based on another field. Is there a native way in ggplot2 to achieve this? Presently I am doing it through geom_text. Here are my data and the plot.I have two issues with this approach -
Labels are falling inside the plot area
For a facet the labels should only appear at the bottom-most subplots as below
not in all subplots as is the case below (my plot). (The above image was taken from here)
library(ggplot2)
library(magrittr)
mydata = data.frame(expand.grid(Tag = c('A','B','C'),
Year = 2010:2011,PNo = paste0("X-",1:4)),Value = round(runif(24,1,20)))
mydata$dist = ifelse(mydata$Tag == 'A',0,ifelse(mydata$Tag=='B',2,7))
mydata %>% ggplot(aes(x = dist,y = Value,fill = factor(Year))) +
geom_bar(stat='summary',position = 'dodge',fun.y='mean',width=1) +
facet_wrap(~PNo,ncol=2) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank()) +
geom_text(aes(x = dist,label = Tag),color = 'black',size=4,angle = 0,show.legend = F)
I would like to place Tag labels based on dist.
I notice that you have accepted an answer elsewhere, and that you have answered you own question here. But they don't quite answer your original question. In particular, the labels are still inside the plot panel. I offer two possibilities, but neither being straightforward.
The first uses a version of annotation_custom. The default annotation_custom draws the annotation in all panels. But with a small alteration (taken from here), it can be made to draw annotations in selected panels - for your plot, the lower two panels.
library(ggplot2)
library(magrittr)
mydata = data.frame(expand.grid(Tag = c('A', 'B', 'C'),
Year = 2010:2011, PNo = paste0("X-", 1:4)), Value = round(runif(24,1,20)))
mydata$dist = ifelse(mydata$Tag == 'A', 0, ifelse(mydata$Tag == 'B', 2, 7))
# The bar plot. Note extra margin above x-axis title.
# This gives space for the annotations between the panel and the title.
p1 = mydata %>% ggplot() +
geom_bar(aes(x = dist, y = Value, fill = factor(Year)),
width = 1, stat = 'identity', position = "dodge") +
facet_wrap(~PNo, ncol = 2) +
theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.x = element_text(margin = margin(t = 2, unit = "lines")))
# Baptiste's modification to annotation_custom
annotation_custom2 =
function (grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, data) {
layer(data = data, stat = StatIdentity, position = PositionIdentity,
geom = ggplot2:::GeomCustomAnn,
inherit.aes = TRUE, params = list(grob = grob,
xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax))
}
# The plot with annotations. (ymin and ymax set to -Inf
# draws the annotation at the bottom of the panel.
# vjust = 1.5 drops them below the panel).
for (i in 1:length(unique(mydata$Tag))) {
p1 = p1 + annotation_custom2(
grob = textGrob(label = unique(mydata$Tag)[i], vjust = 1.5,
gp = gpar(col = 'red', cex = 1)),
xmin = unique(mydata$dist)[i],
xmax = unique(mydata$dist)[i],
ymin = -Inf,
ymax = -Inf,
data=data.frame(PNo=c("X-3", "X-4") )) # The two bottom panels
}
# The annotations are placed outside the panels.
# Therefore, have to turn off clipping to the panels.
g1 = ggplotGrob(p1)
g1$layout$clip[grepl("panel", g1$layout$name)] = "off"
# Draw the chart
grid.newpage()
grid.draw(g1)
The second draws two charts: p1 is your bar plot, and p2 contains the labels only. The trick is to get the x-axes in the two charts to be the same. Then, plot panels are extracted from p2, and placed into a p1, but into a new row just below p1's plot panel.
library(ggplot2)
library(magrittr)
mydata = data.frame(expand.grid(Tag = c('A', 'B', 'C'),
Year = 2010:2011,PNo = paste0("X-", 1:4)),Value = round(runif(24, 1, 20)))
mydata$dist = ifelse(mydata$Tag == 'A', 0, ifelse(mydata$Tag == 'B', 2, 7))
# The bar plot
p1 = mydata %>% ggplot(aes(x = dist, y = Value, fill = factor(Year))) +
geom_bar(stat = 'summary', position = 'dodge',fun.y = 'mean', width = 1) +
facet_wrap(~PNo, ncol = 2) +
theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())
# To get the range of x values -
# so that the extent of the x-axis in p1 and in the following p2 are the same
gd = ggplot_build(p1)
xrange = gd$layout$panel_params[[1]]$x.range # xrange used in p2 (see below)
# Plot with labels (A, B, and C) only
p2 = mydata %>% ggplot(aes(x = dist, y = Value)) +
facet_wrap(~PNo, ncol = 2) +
geom_label(aes(x = dist, y = 0, label = Tag), size = 6, inherit.aes = F, color = 'red') +
### geom_text(aes(x = dist, y = 0, label = Tag), size=6, color = 'red') + ### Alternative style for labels
scale_x_continuous(lim = xrange, expand = c(0,0)) +
theme_bw() +
theme(panel.grid = element_blank(),
panel.border = element_rect(colour = NA))
# Grab a plot panel from p2
g2 = ggplotGrob(p2)
panels = subset(g2$layout, grepl("panel", g2$layout$name), t:r)
panels = subset(panels, t == min(t))
g2 = g2[unique(panels$t), min(panels$l):max(panels$r)]
# Add a row to p1 to take the plot panels
library(gtable)
library(grid)
g1 <- ggplotGrob(p1)
pos = max(subset(g1$layout, grepl("panel", g1$layout$name), t))
g1 = gtable_add_rows(g1, height = unit(2, "lines"), pos = pos)
# Add the panel (g2) to the new row
g1 = gtable_add_grob(g1,g2, t = pos + 1, l = min(panels$l), r = max(panels$r))
# Draw the chart
grid.newpage()
grid.draw(g1)
I tried to solve the problem myself but was facing some issue. I posted another question on SO here. Together the answer and question solves this question to some extent. Here is a possible solution.
p <- mydata %>% ggplot(aes(x = dist,y = Value,fill = factor(Year))) +geom_bar(stat='summary',position = 'dodge',fun.y='mean',width = 1) +
facet_wrap(~PNo,ncol=2) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank()) +
geom_label(data = mydata %>% dplyr::filter(PNo %in% c('X-3','X-4')),aes(x = dist,y=0,label = Tag),size=6,inherit.aes=F,color = 'red')
library(grid)
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[grep("panel-2-\\d+", gt$layout$name)] <- "off"
grid.draw(gt)

Resources