Adding asterisk to flag significance on ggplot - r

I have this bar graph, and want to show asterisks that flag significance (**).
viz_data_one <- tibble(
age_group = c(rep("Young Adult", 4), rep("Older Adult", 4)),
MemoryAccuracy = c(32.8, 28.448, 27.672, 27.075, 29.667, 28.944, 27.556, 28.889),
upper = MemoryAccuracy + 1.76,
lower = MemoryAccuracy - 1.76,
reward = rep(c("Self High Value", "Self Low Value", "Other High Value", "Other Low Value"), 2)
) %>%
mutate(
reward = as_factor(reward) %>% fct_relevel("Self High Value",
"Self Low Value",
"Other High Value",
"Other Low Value"))
viz_data_one <- viz_data_one %>%
mutate(upper = MemoryAccuracy + ifelse(age_group == "Young Adult", 1.76, 1.94),
lower = MemoryAccuracy - ifelse(age_group == "Young Adult", 1.76, 1.94))
p <- viz_data_one %>%
ggplot(aes(x = age_group,
y = MemoryAccuracy,
fill = reward,
ymin = lower,
ymax = upper)) +
geom_col(width = .5, position = position_dodge(.6),
color = "black", key_glyph = "polygon") +
geom_errorbar(width = .1, position = position_dodge(.6)) +
scale_fill_manual(values = c("#E495A5", "#ABB065", "#39BEB1", "#ACA4E2" )) +
labs(
x = "Age Group",
y = "Memory Accuracy (%)",
fill = NULL,
title = ""
) +
theme(
plot.margin = unit(c(1, 1, 1, 1), "cm"),
panel.background = element_blank(),
plot.title = element_text(size = 14, face = "bold",
hjust = 0.5,
margin = margin(b = 15)),
axis.line = element_line(color = "black"),
axis.title = element_text(size = 14, color = "black",
face = "bold"),
axis.text = element_text(size = 18, color = "black"),
axis.text.x = element_text(margin = margin(t = 10)),
axis.text.y = element_text(size = 14),
axis.title.y = element_text(margin = margin(r = 10)),
axis.ticks.x = element_blank(),
legend.position = c(0.90, 0.99),
legend.background = element_rect(color = "black"),
legend.text = element_text(size = 15),
legend.margin = margin(t = 5, l = 5, r = 5, b = 5),
legend.key = element_rect(color = NA, fill = NA)
) +
guides(
fill = guide_legend(
keywidth = .5,
keyheight = .5,
default.unit= "cm"
)
)
p + expand_limits(y = 40)
I want to add asterisk stars to the younger adult group (between self high value and self low value) and have everything else as ns. I've tried a few different things with ggpubr and geom_signif but had no luck.


I ended up solving this by drawing my own using geom_line
p +
geom_line(data=tibble(x=c(1.77,1.929), y=c(40,40)),
aes(x=x, y=y), inherit.aes = FALSE) +
geom_text(data=tibble(x=1.849, y = 41),
aes(x=x, y=y, label = "**"),
inherit.aes = FALSE)+
geom_line(data=tibble(x=c(1.929,2.22), y=c(33,33)),
aes(x=x, y=y), inherit.aes = FALSE) +
geom_text(data=tibble(x=2.0745, y = 34.5),
aes(x=x, y=y, label = "ns"),
inherit.aes = FALSE)+
geom_line(data=tibble(x=c(0.77,1.22), y=c(40,40)),
aes(x=x, y=y), inherit.aes = FALSE) +
geom_text(data=tibble(x=1, y = 41.5),
aes(x=x, y=y, label = "ns"),
inherit.aes = FALSE)

Related

Questioned concerning Conditional_effects () and Error in `check_aesthetics()`: ! Aesthetics must be either length 1

I have a question regarding brms_conditional effects.
int_conditions <- list(
Freq_std = setNames(c(-1, 0, 1),
c("-1 SD", "Mean", "+1 SD"))
)
Trip_InAir <- conditional_effects(
Mod1_Copy_Spanish_Inair,
effects = "POC_std:Freq_std",
method = "posterior_epred",
re_formula = NA,
select_points = 0.1,
spaghetti = T,
nsamples = 300,
ncol = 2,
int_conditions = int_conditions
)
plot(Trip_InAir, plot = F, line_args = list(size = 2))[[1]] +
scale_x_continuous(expand = c(0, 0.1)) +
coord_cartesian(ylim = c(100, 250)) +
geom_hline(yintercept = 150, lty = 3) +
scale_color_manual(
name = "",
values = alpha(viridis::viridis_pal(option = "B", end = 0.8)(3), 0.1)) +
labs(y = "InAir-Pen Duration", x = "POC_Feedforward") +
theme_bw(base_size = 12, base_family = "") +
theme(
legend.position = c(0.8, 0.15),
legend.background = element_blank(),
legend.direction = "horizontal",
legend.key.size = unit(0.7, "cm"),
legend.text.align = 0.5,
legend.title = element_text(size = 10, color = "grey45"),
legend.spacing.x = unit(0,"cm"),
strip.background = element_blank(), strip.text = element_blank()) +
guides(color = guide_legend(keywidth = 0.5, keyheight = 0.1,
default.unit = "inch", title.hjust = 0.5, reverse = T,
title = "Word Frequency",
label.position = "bottom", title.position = "top",
override.aes = list(fill = NA, size = 2)))
After this, I got a plot with colors for 300 draws from the posterior distribution, but the thick lines shared the same white color, so I apply a geom_line function to fill the thick line color.
Plot
plot(Trip_InAir, plot = F, line_args = list(size = 2))[[1]] +
scale_x_continuous(expand = c(0, 0.1)) +
coord_cartesian(ylim = c(100, 250)) +
geom_line(aes(group = effect2__), size = 2,
color = rep(viridis::viridis_pal(option = "B", end = 0.8)(3), 0.1)) +
geom_hline(yintercept = 150, lty = 3) +
scale_color_manual(
name = "",
values = alpha(viridis::viridis_pal(option = "B", end = 0.8)(3), 0.1)) +
labs(y = "InAir-Pen Duration", x = "POC_Feedforward") +
theme_bw(base_size = 12, base_family = "") +
theme(
legend.position = c(0.8, 0.15),
legend.background = element_blank(),
legend.direction = "horizontal",
legend.key.size = unit(0.7, "cm"),
legend.text.align = 0.5,
legend.title = element_text(size = 10, color = "grey45"),
legend.spacing.x = unit(0,"cm"),
strip.background = element_blank(), strip.text = element_blank()) +
guides(color = guide_legend(keywidth = 0.5, keyheight = 0.1,
default.unit = "inch", title.hjust = 0.5, reverse = T,
title = "Word Frequency",
label.position = "bottom", title.position = "top",
override.aes = list(fill = NA, size = 2)))
However, errors happened
Error in `check_aesthetics()`:
! Aesthetics must be either length 1 or the same as the data (300): colour
I understood that this code indicates only one color is available for three lines but is there an opportunity to make each line color the same as their thin lines?
Best

ggplot box plot with data points: how to control legend appearance?

I tried various options, but I cannot find a way to achieve custom legend appearance (unless I export the figure to power point and edit it there...). I would like the legend to look like in the image below and wonder if that is at all possible:
I do not wish to make any changes in the figure itself:
Here is my sample data and code:
df = data.frame(sex = c(1,1,1,1,1, 2,2,2,2,2),
age_cat = c(1,1,1, 2,2,2, 1,1,1, 2),
score_type = c(1,2, 1,2, 1,2, 1,2, 1,2),
score = c(25,28,18,20,30, 37,40,35,43,45))
df$sex <- factor((df$sex))
df$age_cat <- factor((df$age_cat))
df$score_type <- factor((df$score_type))
windows(width=7, height=7)
library(ggplot2)
df %>%
ggplot( aes(x=score_type, y=score)) +
geom_boxplot(aes(color=sex),outlier.shape = NA, size=1.5, show.legend=T) +
geom_point(aes(color=sex, shape = age_cat, group = sex),
position=position_jitterdodge(dodge.width=0.9), size=3, show.legend=F) +
scale_color_manual(values=c("#0072B2", "#CC79A7"), name="",
labels=c("Male", "Female")) +
scale_shape_manual(name="", labels=c('Younger', 'Older'),
values=c(16, 17)) +
theme_bw()+
theme(panel.border = element_blank(), axis.ticks = element_blank(),
legend.position=c(0.9, 0.65), legend.text=element_text(size=11),
legend.title=element_text(size=11.5),
panel.grid.major.x = element_blank() ,
plot.title = element_text(size=11, face = "bold"),
axis.title=element_text(size=13),
axis.text.y = element_text(size=11),
axis.text.x = element_text(size=11),
plot.margin = unit(c(0.5,0.2,0,0.2), "cm")) +
labs(title= "", x = "",y = "Score") +
scale_y_continuous(breaks=c(0, 20, 40, 60, 80, 100),
labels=c('0', '20', '40', '60', '80', '100')) +
expand_limits(x=5, y=70) +
scale_x_discrete(labels = c("A", "B")) +
coord_cartesian(clip = "off")

You could achieve your desired result by
dropping show.legend=FALSE from geom_point
Overriding the shapes to be displayed in the legend using guides(shape = guide_legend(override.aes = list(shape = c(1, 2))))
library(ggplot2)
ggplot(df, aes(x = score_type, y = score)) +
geom_boxplot(aes(color = sex), outlier.shape = NA, size = 1.5) +
geom_point(aes(color = sex, shape = age_cat, group = sex),
position = position_jitterdodge(dodge.width = 0.9), size = 3
) +
scale_color_manual(
values = c("#0072B2", "#CC79A7"), name = "",
labels = c("Male", "Female")
) +
scale_shape_manual(
name = "", labels = c("Younger", "Older"),
values = c(16, 17)
) +
theme_bw() +
theme(
panel.border = element_blank(), axis.ticks = element_blank(),
legend.position = c(0.9, 0.65), legend.text = element_text(size = 11),
legend.title = element_text(size = 11.5),
panel.grid.major.x = element_blank(),
plot.title = element_text(size = 11, face = "bold"),
axis.title = element_text(size = 13),
axis.text.y = element_text(size = 11),
axis.text.x = element_text(size = 11),
plot.margin = unit(c(0.5, 0.2, 0, 0.2), "cm")
) +
labs(title = "", x = "", y = "Score") +
scale_y_continuous(
breaks = c(0, 20, 40, 60, 80, 100),
labels = c("0", "20", "40", "60", "80", "100")
) +
expand_limits(x = 5, y = 70) +
scale_x_discrete(labels = c("A", "B")) +
coord_cartesian(clip = "off") +
guides(shape = guide_legend(override.aes = list(shape = c(1, 2))))

Pie chart and Bar chart aligned on same plot

After seeing this question on how to recreate this graph from the economist in ggplot2, I decided to attempt this myself from scratch (since no code or data was provided), as I found this quite interesting.
Here is what I have managed to do so far:
I was able to do this with relative ease. However, I am struggling with putting pie charts. Because ggplot uses cartesian coordinates to make pie charts, I can't have bars and pies on the same graph. So I discovered geom_arc_bar() from ggforce, which does allow pies on cartesian coordinate system. However, the issue is with coord_fixed(). I can get the pies to align but I cannot get the circular shape without coord_fixed(). However, with coord_fixed(), I can't get the graph to match the height of Economist graph. Without coord_fixed() I can, but the pies are ovals rather than circles. See below:
With coord_fixed():
Without coord_fixed():
The other option that I have tried is to make a series of pie charts separately and then combine the plots together. However, I struggled to get the plots aligned with gridExtra and other alternatives. I did combining with paint. Obviously this works, but is not programmatic. I need a solution that is 100% based in R.
My solution with pasting separate images from R in paint:
Anybody with a solution to this problem? I think it is an interesting question to answer and I have provided a starting point. I am open to any suggestions, also feel free to suggest an entirely different approach, as I acknowledge that mine is not the best. Thanks!
CODE:
# packages
library(data.table)
library(dplyr)
library(forcats)
library(ggplot2)
library(ggforce)
library(ggnewscale)
library(ggtext)
library(showtext)
library(stringr)
# data
global <- fread("Sector,ROE,Share,Status
Technology,14.2,10,Local
Technology,19,90,Multinational
Other consumer,16.5,77,Multinational
Other consumer,20.5,23,Local
Industrial,13,70,Multinational
Industrial,18,30,Local
Cyclical consumer,12,77,Multinational
Cyclical consumer,21,23,Local
Utilities,6,88,Local
Utilities,11,12,Multinational
All sectors,10,50,Local
All sectors,10.2,50,Multinational
Financial,6,27,Multinational
Financial,10.5,73,Local
Diversified,4.9,21,Local
Diversified,5,79,Multinational
Basic materials,4,82,Multinational
Basic materials,9,18,Local
Media & communications,3,76,Multinational
Media & communications,14,24,Local
Energy,-1,40,Local
Energy,1,60,Multinational
")
equity <- global %>%
group_by(Sector) %>%
mutate(xend = ifelse(min(ROE) > 0, 0, min(ROE)))
equity$Sector <- factor(equity$Sector, levels= rev(c("Technology", "Other consumer",
"Industrial", "Cyclical consumer",
"Utilities", "All sectors", "Financial",
"Diversified", "Basic materials",
"Media & communications", "Energy")))
equity$Status <- factor(equity$Status, levels = c("Multinational", "Local"))
# fonts
font_add_google("Montserrat", "Montserrat")
font_add_google("Roboto", "Roboto")
# scaling text for high res image
img_scale <- 5.5
# graph
showtext_auto() # for montserrat font to show
economist <- ggplot(equity)+
geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
show.legend = FALSE, size = 2)+
geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status),
size = 0.5)+
geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
scale_x_continuous(position = "top", limits = c(-5, 25),
breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25),
labels = c(5, "-", 0, "+", 5,10,15,20,25),
minor_breaks = c(-2.5, 2.5)
)+
scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
#width = 40))+
labs(x = "", y = "", caption = c("Sources: Bloomberg;",
"The Economist",
"<span style='font-size:80px;
color:#292929;'><sup>*</sup></span>Top 500 global companies"))+
ggtitle("The price of being global",
subtitle = "Return on equity<span style='font-size:80px;color:#292929;'>*</span>, latest 12 months, %")+
theme(legend.position = "top",
legend.direction = "vertical",
legend.justification = -1.25,
legend.key.size = unit(0.18, "cm"),
legend.key.height = unit(0.1, "cm"),
legend.background = element_rect("#cddee6"),
legend.text = element_text("Montserrat", size = 9 * img_scale),
plot.background = element_rect("#cddee6"),
plot.margin = margin(t = 10, r = 10, b = 20, l = 10),
panel.background = element_rect("#cddee6"),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
axis.ticks = element_blank(),
axis.text = element_text(family = "Montserrat", size = 9 * img_scale,
colour = "black"),
axis.text.y = element_text(hjust = 0, lineheight = 0.15,
face = c(rep("plain",5), "bold.italic", rep("plain",5))
),
#axis.text.x = element_text(family = "Montserrat", size = 9*img_scale,)
plot.title = element_text(family = "Montserrat", size = 12 * img_scale,
face = "bold",
hjust = -34.12),
text = element_text(family = "Montserrat"),
plot.subtitle = element_markdown(family = "Montserrat", size = 9 * img_scale,
hjust = 7.5),
plot.caption = element_markdown(size = 9*img_scale,
face = c("plain", "italic", "plain"),
hjust = c(-1.35, -1.85, -2.05),
vjust = c(0,0.75,0)))
# only way to get google fonts on plot (R device does not show them)
png("bar.png", height = 480*8, width = 250*8, res = 72*8) # increased resolution (dpi)
economist
dev.off()
# piechart
pies <- equity %>%
mutate(Sector = fct_rev(Sector)) %>%
ggplot(aes(x = "", y = Share, fill = Status, width = 0.15)) +
geom_bar(stat = "identity", position = position_fill(), show.legend = FALSE, size = 0.1) +
# geom_text(aes(label = Cnt), position = position_fill(vjust = 0.5)) +
coord_polar(theta = "y", direction = -1) +
facet_wrap(~ Sector, dir = "v", ncol = 1) +
scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b"))+
#theme_void()+
theme(panel.spacing = unit(-0.35, "lines"),
plot.background = element_rect("#cddee6"),
panel.background = element_rect("transparent"),
strip.text = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position='none',
axis.ticks = element_blank(),
axis.text = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
# guides(fill=guide_legend(nrow=2, byrow=TRUE))
png("pie_chart.png", height = 350*8, width = 51*8, res = 72*8)
pies
dev.off()
# geom_bar_arc (ggforce) with coord_fixed - cannot match height but pies are circular
eco_circle_pies <- ggplot(equity)+
geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
show.legend = FALSE, size = 1)+
scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status),
size = 0.5, show.legend = TRUE)+
geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
new_scale_fill()+
geom_arc_bar(aes(x0 = 27, y0 = as.numeric(equity$Sector), r0 = 0, r = 0.45,
amount = Share,
fill = Status),
stat = 'pie',
color = "transparent",
show.legend = FALSE)+
coord_fixed()+
scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b"))+
scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
scale_x_continuous(position = "top", limits = c(-5, 30),
breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25),
labels = c(5, "-", 0, "+", 5,10,15,20,25),
minor_breaks = c(-2.5, 2.5)
)+
scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
# below is to get * superscript
labs(x = "", y = "", caption = c("Sources: Bloomberg;",
"<span style='font-style:italic;font-color:#292929'>The Economist</span>",
"<span style='font-size:80px;
color:#292929;'><sup>*</sup></span>Top 500 global companies"))+ # this is to get
ggtitle("The price of being global",
subtitle = "Return on equity<span style='font-size:80px;color:#292929;'>*</span>, latest 12 months, %")+
guides(color = FALSE)+
theme(legend.position = "top",
legend.direction = "vertical",
# legend.justification = -0.9,
legend.key.size = unit(0.18, "cm"),
legend.key.height = unit(0.1, "cm"),
legend.background = element_rect("#cddee6"),
legend.text = element_text("Montserrat", size = 9 * img_scale),
plot.background = element_rect("#cddee6"),
# plot.margin = margin(t = -80, r = 10, b = -20, l = 10),
panel.background = element_rect("#cddee6"),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
axis.ticks = element_blank(),
axis.text = element_text(family = "Montserrat", size = 9 * img_scale,
colour = "black"),
axis.text.y = element_text(hjust = 0, lineheight = 0.15),
#axis.text.x = element_text(family = "Montserrat", size = 9*img_scale,)
plot.title = element_text(family = "Montserrat", size = 12 * img_scale,
hjust = -2.12),
plot.subtitle = element_markdown(family = "Montserrat", size = 9 * img_scale,
hjust = -5.75),
plot.caption = element_markdown(size = 9*img_scale,
face = c("plain", "italic", "plain"),
#hjust = c(-.9, -1.22, -1.95),
#vjust = c(0,0.75,0)))
))
png("eco_circle_pies.png", height = 220*8, width = 420*8, res = 72*8)
eco_circle_pies
dev.off()
# geom_bar_arc (ggforce) without coord_fixed - matches height, but pies are oval
eco_oval_pie <- ggplot(equity)+
geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
show.legend = FALSE, size = 1)+
scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status),
size = 0.5, show.legend = TRUE)+
geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
new_scale_fill()+
geom_arc_bar(aes(x0 = 27, y0 = as.numeric(equity$Sector), r0 = 0, r = 0.45,
amount = Share,
fill = Status),
stat = 'pie',
color = "transparent",
show.legend = FALSE)+
# coord_fixed()+
scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b"))+
scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
scale_x_continuous(position = "top", limits = c(-5, 30),
breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25),
labels = c(5, "-", 0, "+", 5,10,15,20,25),
minor_breaks = c(-2.5, 2.5)
)+
scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
#width = 40))+
labs(x = "", y = "", caption = c("Sources: Bloomberg;",
"<span style='font-style:italic;font-color:#292929'>The Economist</span>",
"<span style='font-size:80px;
color:#292929;'><sup>*</sup></span>Top 500 global companies"))+
ggtitle("The price of being global",
subtitle = "Return on equity<span style='font-size:80px;color:#292929;'>*</span>, latest 12 months, %")+
guides(color = FALSE)+
theme(legend.position = "top",
legend.direction = "vertical",
legend.justification = -1.1,
legend.key.size = unit(0.18, "cm"),
legend.key.height = unit(0.1, "cm"),
legend.background = element_rect("#cddee6"),
legend.text = element_text("Montserrat", size = 9 * img_scale),
plot.background = element_rect("#cddee6"),
# plot.margin = margin(t = -80, r = 10, b = -20, l = 10),
panel.background = element_rect("#cddee6"),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
axis.ticks = element_blank(),
axis.text = element_text(family = "Montserrat", size = 9 * img_scale,
colour = "black"),
axis.text.y = element_text(hjust = 0, lineheight = 0.15),
text = element_text(family = "Montserrat"),
plot.title = element_text(family = "Montserrat", size = 12 * img_scale,
face = "bold",
hjust = -7.05),
plot.subtitle = element_markdown(family = "Montserrat", size = 9 * img_scale,
hjust = 53.75),
plot.caption = element_markdown(size = 9*img_scale,
face = c("plain", "italic", "plain"),
hjust = c(-1.15, -1.58, -1.95),
vjust = c(0.5,1.15,0.5)))
png("eco_oval_pies.png", height = 480*8, width = 250*8, res = 72*8)
eco_oval_pie
dev.off()

Indeed an interesting problem. In my opinion the easiest way to get your desired result is to create two separate plots and to glue them together using the wonderful patchwork package:
Note: To focus on the main issue and to make the code more minimal I dropped all or most of your theme adjustments, ggtext styling, custom fonts, ... . Instead I relied on ggthemes::theme_economist to get close to the economist look.
# packages
library(data.table)
library(dplyr)
library(stringr)
library(forcats)
library(ggplot2)
library(patchwork)
library(ggthemes)
bars <-ggplot(equity)+
geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
show.legend = FALSE, size = 2)+
geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status),
size = 0.5)+
geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
scale_x_continuous(position = "top", limits = c(-5, 25),
breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25),
labels = c(5, "-", 0, "+", 5,10,15,20,25),
minor_breaks = c(-2.5, 2.5)
)+
scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
labs(x = "", y = "") +
ggthemes::theme_economist() +
theme(legend.position = "top", legend.justification = "left")
pies <- equity %>%
mutate(Sector = fct_rev(Sector)) %>%
ggplot(aes(x = "", y = Share, fill = Status, width = 0.15)) +
geom_bar(stat = "identity", position = position_fill(), show.legend = FALSE, size = 0.1) +
coord_polar(theta = "y", direction = -1) +
facet_wrap(~ Sector, dir = "v", ncol = 1) +
scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b")) +
labs(x = NULL, y = NULL) +
ggthemes::theme_economist() +
theme(strip.text = element_blank(), panel.spacing.y = unit(0, "pt"),
axis.text = element_blank(), , axis.ticks = element_blank(), axis.line = element_blank(),
panel.grid.major = element_blank())
bars + pies +
plot_layout(widths= c(5, 1)) +
plot_annotation(caption = c("Sources: Bloomberg;",
"The Economist", "Top 500 global companies"),
title = "The price of being global",
subtitle = "Return on equity, latest 12 months, %",
theme = theme_economist())

Here's a base figure
global <- read.csv(strip.white = TRUE, text = "Sector,ROE,Share,Status
Technology,14.2,10,Local
Technology,19,90,Multinational
Other consumer,16.5,77,Multinational
Other consumer,20.5,23,Local
Industrial,13,70,Multinational
Industrial,18,30,Local
Cyclical consumer,12,77,Multinational
Cyclical consumer,21,23,Local
Utilities,6,88,Local
Utilities,11,12,Multinational
All sectors,10,50,Local
All sectors,10.2,50,Multinational
Financial,6,27,Multinational
Financial,10.5,73,Local
Diversified,4.9,21,Local
Diversified,5,79,Multinational
Basic materials,4,82,Multinational
Basic materials,9,18,Local
Media & communications,3,76,Multinational
Media & communications,14,24,Local
Energy,-1,40,Local
Energy,1,60,Multinational")
global <- within(global, {
Sector <- factor(Sector, unique(Sector))
Status <- factor(Status, unique(Status))
})
global <- global[order(global$Sector, global$Status), ]
f <- function(x, y, z, col, lbl, xat) {
all <- grepl('All', lbl)
par(mar = c(0, 0, 0, 0))
pie(rev(z), labels = '', clockwise = TRUE, border = NA, col = rev(col))
par(mar = c(0, 10, 0, 0))
plot.new()
plot.window(range(xat), c(-1, 1))
abline(v = xat, col = 'white', lwd = 3)
abline(v = 0, col = 'tomato3', lwd = 3)
segments(min(c(x, 0)), 0, max(x), 0, ifelse(all, 'grey50', 'grey75'), lwd = 7, lend = 1)
text(grconvertX(0.05, 'ndc'), 0, paste(strwrap(lbl, 15), collapse = '\n'),
xpd = NA, adj = 0, cex = 2, font = 1 + all * 3)
for (ii in 1:2)
segments(x[ii], -y / 2, x[ii], y / 2, col = col[ii], lwd = 7, lend = 1)
}
pdf('~/desktop/fig.pdf', height = 10, width = 7)
layout(
matrix(rev(sequence(nlevels(global$Sector) * 2)), ncol = 2, byrow = TRUE),
widths = c(5, 1)
)
cols <- c(Local = '#ea5f47', Multinational = '#08526b')
op <- par(bg = '#cddee6', oma = c(5, 6, 15, 0))
sp <- rev(split(global, global$Sector))
for (x in sp)
f(x$ROE, 1, x$Share, cols, x$Sector[1], -1:5 * 5)
axis(3, lwd = 0, cex.axis = 2)
cols <- rev(cols)
legend(
grconvertX(0.05, 'ndc'), grconvertY(0.91, 'ndc'), paste(names(cols), 'firms'),
border = NA, fill = cols, bty = 'n', xpd = NA, cex = 2
)
text(
grconvertX(0.05, 'ndc'), grconvertY(c(0.96, 0.925), 'ndc'),
c('The price of being global', 'Return on equity*, latest 12 months, %'),
font = c(2, 1), adj = 0, cex = c(3, 2), xpd = NA
)
text(
grconvertX(0.05, 'ndc'), grconvertY(0.03, 'ndc'),
'Sources: Bloomberg;\nThe Economist', xpd = NA, adj = 0, cex = 1.5
)
text(
grconvertX(0.95, 'ndc'), grconvertY(0.03, 'ndc'),
'*Top 500 global companies', xpd = NA, adj = 1, cex = 1.5
)
box('outer')
par(op)
dev.off()

Adjusting space between legend text and boxes after coord_flip() in ggplot

I am trying to move the legend text and legend boxes further apart (horizontally) on a box and jitter plot. The complicating factor is the coord_flip I used to make the boxplot horizontal. In theme I tried using both legend.spacing.x and legend.spacing.y but neither had any effect on the distance between legend text and legend boxes.
Here is the graph with fake data. More complex than necessary I know but I need to be able to make it work with all the complications.
library(dplyr)
library(ggplot2)
set.seed(01234)
# make some data
totDays <- data.frame(id = 1:80,
group = rep(c("Placebo", "Drug"), each = 40),
total84 = c(pmin(abs(round(rnorm(40, 55, 30))),84), pmin(abs(round(rnorm(40, 38, 30))),84)))
# get some descriptives
(groupDF <- totDays %>% group_by(group) %>%
dplyr::summarise(m = mean(total84, na.rm = T),
sd = sd(total84, na.rm = T),
count = n()) %>%
mutate(se = sd/sqrt(count)))
# now for the box and scatter plot
(g <- ggplot(totDays, aes(group, total84, colour = group)) +
geom_jitter(size = 1, width = 0.1) + # so points aren't overlaid, width controls how much jitter
geom_point(stat = "summary", fun.y = "mean", shape = 3, size = 3, colour = "black") + # crosses for mean
geom_boxplot(alpha = 0, width = 0.5, lwd = 1, size = 0.5) +
scale_color_manual(values = c("#00AFBB", "#E7B800")) +
scale_y_continuous(breaks = seq(0,84,14), minor_breaks = seq(0, 84, 14)) + # changes minor break line
coord_flip() +
labs(y = "Score") +
geom_hline(yintercept = c(groupDF$m), linetype = "dotted") +
geom_segment(x = 2.38, xend = 2.38, y = groupDF$m[2] + .1, yend = groupDF$m[1] - .1, size = .7, arrow = arrow(end = "both", type = "open", length = unit(0.15, "cm")), colour = "#696969") +
annotate("text", x = 2.46, y = mean(groupDF$m), label = paste0("italic(p) == ", 0.02), parse = T) +
theme_bw() +
theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(size = 13),
axis.title.x = element_text(size = 13, face = "bold", margin = margin(t = 0, r = 0, b = 10, l = 0), vjust = -2), # note the use of margin to move the title away from the axis text
legend.title = element_blank(),
legend.position = "top",
legend.spacing.y = unit(.1, "cm"),
legend.box.spacing = unit(.1, "cm"), # adjusts distance of box from x-axis
legend.key.size = unit(1, "cm"),
legend.text = element_text(size = 13, face = "bold"),
strip.text = element_text(size = 13, face = "bold"),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(size=.4, color="#F7F7F7")))

Use either stringr::str_pad() or theme(legend.spacing.x = ...) or both
g <- ggplot(totDays, aes(group, total84, colour = group)) +
geom_jitter(size = 1, width = 0.1) + # so points aren't overlaid, width controls how much jitter
geom_point(stat = "summary", fun.y = "mean", shape = 3, size = 3, colour = "black") + # crosses for mean
geom_boxplot(alpha = 0, width = 0.5, lwd = 1, size = 0.5) +
scale_color_manual(values = c("#00AFBB", "#E7B800"),
### added
labels = stringr::str_pad(c("Drug", "Placebo"), 10, "right")) +
scale_y_continuous(breaks = seq(0,84,14), minor_breaks = seq(0, 84, 14)) + # changes minor break line
coord_flip() +
labs(y = "Score") +
geom_hline(yintercept = c(groupDF$m), linetype = "dotted") +
geom_segment(x = 2.38, xend = 2.38, y = groupDF$m[2] + .1, yend = groupDF$m[1] - .1, size = .7,
arrow = arrow(end = "both", type = "open", length = unit(0.15, "cm")), colour = "#696969") +
annotate("text", x = 2.46, y = mean(groupDF$m), label = paste0("italic(p) == ", 0.02), parse = T) +
theme_bw() +
theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(size = 13),
axis.title.x = element_text(size = 13, face = "bold",
margin = margin(t = 0, r = 0, b = 10, l = 0), vjust = -2),
legend.title = element_blank(),
legend.position = "top",
### added
legend.spacing.x = unit(0.25, 'cm'),
legend.spacing.y = unit(.1, "cm"),
legend.box.spacing = unit(.1, "cm"), # adjusts distance of box from x-axis
legend.key.size = unit(1, "cm"),
legend.text = element_text(size = 13, face = "bold"),
strip.text = element_text(size = 13, face = "bold"),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(size=.4, color="#F7F7F7"))
Created on 2019-03-11 by the reprex package (v0.2.1.9000)

How to add annotation on each facet

I want to give each facet an alpha code, from A to H since there are eight facets, and draw each code on the top-left of each facet:
ggthemr('dust', layout = 'scientific',
spacing = 1, type = 'inner', line_weight = 0.6,
)
ptitles <- c('A' = "Total mass (g)", 'B' = "Root mass (g)", 'C' = "Stem mass (g)",
'D' = "Leaf mass (g)", 'E' = "Number of nodes",
'F' = "Number of leaves", 'G' = "Total stem length (cm)", 'H' = "RDI")
ggplot(gtr, aes(sediment, value)) +
geom_boxplot(aes(fill = nitrogen)) +
geom_text(aes(label = trait, group = trait)) +
facet_wrap(~trait, scales = "free_y", ncol = 2,
labeller = as_labeller(ptitles),
strip.position = "left"
) +
theme(legend.position = "bottom",
legend.title = element_text(size = 12),
legend.key.size = unit(2, "lines"),
legend.text = element_text(size = 12),
strip.text.x = element_text(size = 12, margin = margin(0, 0, 0, 10)),
strip.text.y = element_text(size = 14),
strip.placement = "outside",
axis.title.y = element_text(size = 14),
axis.title.x = element_text(size = 14),
axis.text.x = element_text(size = 14),
panel.spacing.x = unit(0.5, "lines"),
panel.spacing.y = unit(0.3, "lines"),
aspect.ratio = 2 / 3
) +
xlab("Effects of sediment type and nitrogen deposition") +
ylab(NULL)
I tried to use geom_text():
geom_text(aes(label = trait, group = trait))
(Here the variable trait stores factors from A to H to distinguish each facet)
But it did not work like what I expected:
Is there a simple way to such a thing?
UPDATE:
According to baptiste's answer, I changed my geom_text() code above to below:
geom_text(aes(x = -Inf, y = Inf, label = trait, group = trait),
size = 5,
hjust = -0.5,
vjust = 1.4,
inherit.aes = FALSE)
inherit.aes = FALSE here seems to do nothing, how does this parameter work?.
Now my plot looks good:

library(ggplot2)
d <- data.frame(x=rep(1:3, 4), f=rep(letters[1:4], each=3))
labels <- data.frame(f=letters[1:4], label=LETTERS[1:4])
ggplot(d, aes(x,x)) +
facet_wrap(~f) +
geom_point() +
geom_label(data = labels, aes(label=label),
x = Inf, y = -Inf, hjust=1, vjust=0,
inherit.aes = FALSE)

Resources