Pie chart and Bar chart aligned on same plot - r

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()

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

How to change items in a ggplot2 legend?

I am trying to change the legend items of this plot.
My code is:
library(ggplot2)
library(HDInterval)
library(ggridges)
df <- data.frame(
density = c(rgamma(400, 2, 10), rgamma(400, 2.25, 9), rgamma(400, 5, 7)),
source = rep(c("source_1", "source_2", "source_3"),
each = 400))
ggplot(df, aes(x = density, color = source, linetype = source,
fill = after_stat(ifelse(quantile == 2, NA, color)))) +
geom_density_ridges_gradient(aes(y = 0), quantile_lines = TRUE, size=1.2,
quantile_fun = hdi, # vline_linetype = 0, scale = 1) +
labs(y = "Density", x = "Contribution") +
scale_linetype_cyclical(name = "Source", values = c("solid", "dotted", "longdash"),
labels = c("source1", "source2", "source3"),
guide = "legend") +
scale_fill_cyclical(name = "Source", values = c("#31a354", "#2c7fb8", "#d95f0e"),
labels = c("source1", "source2", "source3"),
guide = "none", na.value = "transparent") +
scale_color_cyclical(name = "Source", values = c("#31a354", "#2c7fb8", "#d95f0e"),
labels = c("source1", "source2", "source3"),
guide = "none") +
ylim(0, 8) + xlim(0, 1) +
theme(#legend.position=c(.85,.75),
legend.text = element_text(size=16), # item legend text font size
legend.title=element_text(size=18), # title font size
legend.key.height= unit(1, 'cm'),# box height
legend.key.width= unit(1, 'cm')) + # box width
guides(color = guide_legend(override.aes = list(fill = "white")))+
theme(axis.text.y = element_text(size = 12, vjust = 0.5),
axis.text.x = element_text(size = 12, vjust = 0.5),
axis.title.x = element_text(size = 14),
axis.title.y = element_text(size = 14))
I would like to show lines in the legend, instead of the boxes.
I would appreciate your help.
I have tried to understand ggridges deeply, however it is a bit different or rigid for some things.
Thanks in advance.
ggplot(df, aes(x = density, color = source, linetype = source,
fill = after_stat(ifelse(quantile == 2, NA, color)))) +
geom_density_ridges_gradient(aes(y = 0), size=1.2,
quantile_lines = TRUE, quantile_fun = hdi,
key_glyph = "path") +
...
https://ggplot2.tidyverse.org/reference/draw_key.html

Changing the shape of one point or few points in a scatter plot in R

I have a set of points in a scatter plot as below. I want to change the shape of one point or few points. I searched for this but could not find a way to do it.
I want to achieve like this
And like this
Code:
df <- data.frame(x = c(1,2,2,3,3.5,4,4.5,5,5.5,6,1.5,2,2,2,2,1.5,2.5,3,3,3,3,5.5,5,6,5.5,7)
,y = c(2,1,2,2,2,2,2,2,1.5,2,2.5,3,3.5,4,4.5,3.5,3.5,2,3,3.5,4,2.5,3,3,4,3.5))
library(ggplot2)
library(extrafont)
# helper dataframe for axis
df_arrow <- data.frame(x = c(0, 0),
y = c(0, 0),
xend = c(0, 8),
yend = c(8, 0))
ggplot(df,aes(x, y)) +
geom_point(colour = "blue", size = 5, shape = 3)+
scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6, family = "Times New Roman")+
labs(x = NULL,
y = NULL)+
theme_bw()+
theme(panel.grid.major = element_line(colour = "gray80"),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.length = unit(1, "mm"),
text = element_text(size = 18, family = "Times New Roman"))
How is this?
Create a new column using dplyr::mutate, which is conditional upon the x-coordinates (for example, but it could be anything). Then, use this column within aes to control the shape size.
Also, you can use scale_shape_manual and scale_colour_manual to manually control the shape and colours. It's not clear to me what shape you want but you would just need to change the arguments in scale_shape_manual.
EDIT:
Since you specifically need a different symbol, then you need to use geom_text instead.
df %>%
dplyr::mutate(z = ifelse(x >= 5, "-", "+")) %>%
ggplot(aes(x, y)) +
geom_text(size = 12, aes(colour=z, label=z)) +
scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6, family = "Times New Roman")+
labs(x = NULL,
y = NULL)+
theme_bw()+
theme(panel.grid.major = element_line(colour = "gray80"),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.length = unit(1, "mm"),
text = element_text(size = 18, family = "Times New Roman")) +
scale_shape_manual(values=c(8, 9)) +
scale_colour_manual(values = c('red', 'blue'))

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