Annotation position does not work in faceted ggplot2 with inherit=FALSE - r

I have a simple faceted plot from the following data
structure(list(Entity = c("Africa", "Americas", "Eastern Mediterranean",
"Europe", "South-East Asia", "Western Pacific"), meandeaths = c(93.9,
0.0821, 1.47, 0, 4.02, 0.569)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -6L))
I used the code here to add a single annotation at the bottom of the plot. Unfortunately, the annotation appears in each of the facets, although I have used inherit = TRUE in the aes.
library(ggfittext)
library(ggtext)
library(extrafont)
library(extrafontdb)
library(tidyverse)
plot_label <- 'Africa is the world region that is most affected by malaria: in 2019, 96% of global deaths from malaria occurred on the African continent.' %>%
str_wrap(width = 50)
colors_palette <- c(
"Africa"= "#01FF70",
"Americas" = "#FFDC00",
"Eastern Mediterranean" = "#FF851B",
"South-East Asia" = "#F012BE",
"Western Pacific" = "red",
"Europe" = "skyblue")
common_theme <- function() {
theme_minimal() +
theme(
text = element_text(color = "#FFFFFF"),
strip.text = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.title = element_markdown(family = "Century Gothic", size = rel(7.5), face = "bold", color = "#EF476F", hjust = .5, margin = margin(t = 1,b = 1, unit = "cm")),
plot.subtitle = element_markdown(size = rel(3), face = "bold", family = "Century Gothic", hjust = .5, margin = margin(t = .25, b = .25, unit = "cm")),
plot.background = element_rect(fill = "#111111", color = NA)
)
}
plotmal %>%
mutate(Entity = as.factor(Entity)) %>%
ggplot(aes(x = 3, fill = Entity)) +
geom_col(
aes(y= meandeaths),
color = NA
) +
geom_col(
aes(y = 1),
alpha = .35,
color = NA
) +
ggtext::geom_richtext(
aes(.2, 0,
label = glue::glue("<span style ='font-size: 35px;'>{str_to_title(Entity)}</span><br><span style='font-size:27.5px;'>{round(meandeaths,2)}%</span>"),
color = Entity
),
family = "Century Gothic",
fill = NA,
label.size = 0,
label.color = NA,
lineheight = 1.5
) +
annotate(geom ="text", x = 1.2, y =-1.5, label = plot_label,
size = 4.5, family = "Century Gothic" ,fontface = "italic", color = "#FFFFFF", lineheight = .95,inherit.aes = FALSE
)+ # inherit.aes = FALSE does not work
labs(
title = "Silent Killer",
subtitle = "Global Malaria Deaths by Region 2000-2020",
caption = "Data:OurWorldinData | Viz: #stepminer2"
) +
scale_x_continuous(
limits = c(0.2, 3 + 0.5)
) +
scale_fill_manual(
values = colors_palette,
guide = "none"
) +
scale_color_manual(
values = colors_palette,
guide = "none"
) +
coord_polar(theta = "y") +
facet_wrap(vars(Entity), nrow = 2) +
common_theme() +
theme(
plot.margin = margin(t = .5,b = 1, unit = "cm")
)
How can I solve this problem?

Unfortunately ggplot2::annotate or ggplot2::annotation_custom will add to each facet and using inherit=FALSE will not change that.
But one option to overcome this would be the gggrid package which unlike ggplot2::annotate or ggplot2::annotation_custom allows for placing different grobs on each facet or as in your case to place a label on only one facet. To this end:
Create your label as a textGrob which also allows to use relative coordinates to place your label.
Add this label to your plot via gggrid::grid_panel. Here you could pass a data.frame to the data argument which contains only an Entity column and which is used to specify the panels where you want to add the label, i.e. in your case "Europe".
tg <- grid::textGrob(plot_label,
x = unit(0, "npc") + unit(2, "mm"),
y = unit(0, "npc") + unit(2, "mm"),
just = c("left", "bottom"),
gp = grid::gpar(fontsize = 4.5 * .pt, fontfamily = "Century Gothic", col = "#FFFFFF", lineheight = .95)
)
plotmal %>%
mutate(Entity = as.factor(Entity)) %>%
ggplot(aes(x = 3, fill = Entity)) +
geom_col(
aes(y = meandeaths),
color = NA
) +
geom_col(
aes(y = 1),
alpha = .35,
color = NA
) +
ggtext::geom_richtext(
aes(.2, 0,
label = glue::glue("<span style ='font-size: 35px;'>{str_to_title(Entity)}</span><br><span style='font-size:27.5px;'>{round(meandeaths,2)}%</span>"),
color = Entity
),
family = "Century Gothic",
fill = NA,
label.size = 0,
label.color = NA,
lineheight = 1.5
) +
labs(
title = "Silent Killer",
subtitle = "Global Malaria Deaths by Region 2000-2020",
caption = "Data:OurWorldinData | Viz: #stepminer2"
) +
scale_x_continuous(
limits = c(0.2, 3 + 0.5)
) +
scale_fill_manual(
values = colors_palette,
guide = "none"
) +
scale_color_manual(
values = colors_palette,
guide = "none"
) +
coord_polar(theta = "y") +
facet_wrap(vars(Entity), nrow = 2) +
common_theme() +
theme(
plot.margin = margin(t = .5, b = 1, unit = "cm")
) +
gggrid::grid_panel(tg, data = data.frame(Entity = "Europe"))
UPDATE If you want your annotation to span the whole width of the plot I would go for a patchwork approach where the annotation is created as a second plot and glued to the main plot.
Note: For the annotation plot I use geom_textbox. I also dropped the str_wrap which IMHO does not make any sense in this case.
p_main <- plotmal %>%
mutate(Entity = as.factor(Entity)) %>%
ggplot(aes(x = 3, fill = Entity)) +
geom_col(
aes(y = meandeaths),
color = NA
) +
geom_col(
aes(y = 1),
alpha = .35,
color = NA
) +
ggtext::geom_richtext(
aes(.2, 0,
label = glue::glue("<span style ='font-size: 35px;'>{str_to_title(Entity)}</span><br><span style='font-size:27.5px;'>{round(meandeaths,2)}%</span>"),
color = Entity
),
family = "Century Gothic",
fill = NA,
label.size = 0,
label.color = NA,
lineheight = 1.5
) +
scale_fill_manual(
values = colors_palette,
guide = "none"
) +
scale_color_manual(
values = colors_palette,
guide = "none"
) +
coord_polar(theta = "y") +
facet_wrap(vars(Entity), nrow = 2) +
common_theme()
p_anno <- ggplot(data.frame(x = factor(1), y = factor(1)), aes(x = x, y = y)) +
geom_textbox(label = plot_label, color = "white", fill = "#111111", lineheight = .95,
family = "Century Gothic", size = 4.5, width = unit(1, "npc"), box.colour = NA,
halign = .5) +
common_theme() +
theme(
plot.margin = margin(t = .5, b = 1, unit = "cm")
)
library(patchwork)
p_main / p_anno + plot_layout(heights = c(20, 1)) &
plot_annotation(
title = "Silent Killer",
subtitle = "Global Malaria Deaths by Region 2000-2020",
caption = "Data:OurWorldinData | Viz: #stepminer2",
theme = common_theme()
)

Related

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

duplicating and edit a discrete axis in ggplot2 - 2021

There are a couple of other posts on the same topic, but the solutions proposed do not fit my case.
Given a data frame like this
ddff <- structure(
list(
SampleID = structure(
20:16,
.Label = c(
"S39",
"S30",
"S35",
"S22",
"S23",
"S26",
"S29",
"S24",
"S27",
"S32",
"S37",
"S36",
"S38",
"S34",
"S33",
"S40",
"S25",
"S28",
"S31",
"S21"
),
class = "factor"
),
Counts = c(12177, 14367, 15118, 15312,
16622),
sampleName = structure(
20:16,
.Label = c(
"2Dr",
"2Es",
"1Er",
"1Bs",
"1Cs",
"2As",
"2Ds",
"1Ds",
"2Bs",
"1Br",
"2Br",
"2Ar",
"2Cr",
"1Dr",
"1Cr",
"2Er",
"1Es",
"2Cs",
"1Ar",
"1As"
),
class = "factor"
),
compartment = c("soil", "root", "soil",
"soil", "root")
),
row.names = c(NA, 5L),
class = "data.frame"
)
and the following code
library(tidyverse)
ddff %>%
ggplot(aes(x = Counts, y = SampleID)) +
geom_point(aes(col = compartment), size = 4, alpha = 0.75) +
geom_text(
aes(label = paste0(" ", Counts)),
size = 3,
hjust = 0,
nudge_x = -0.1,
check_overlap = TRUE,
color = "blue"
) +
xlim(NA, 33000) +
theme_light() +
theme(plot.title = element_text(hjust = 0.5), aspect.ratio = 1) +
theme(# remove the vertical grid lines
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()) +
labs(title = "Library Size Overview",
x = "Read Counts",
color = "Compartment") +
theme(
legend.position = c(.95, .95),
legend.justification = c("right", "top"),
legend.box.just = "right",
legend.box.background = element_rect(color = "black", size = 1)
)
I get this plot
Rplot
I'm interested in adding second labels on the right Y axis, according to the content of the ddff column 'sampleName'. Of course the solution seems to be the usage of scale_y_discrete along with dup_axis, but I'm not able to figure out how...any idea based on recent ggplot evolutions?
Discrete scales in ggplot2 don't support secondary scales (see related issue). The ggh4x package has a manual axis that can work around this limitation. (Disclaimer: I'm the author of ggh4x).
For you example, you could use it like this:
library(ggplot2)
# ddff <- structure(...) # omitted for brevity
ggplot(ddff, aes(x = Counts, y = SampleID)) +
geom_point(aes(col = compartment), size = 4, alpha = 0.75) +
geom_text(
aes(label = paste0(" ", Counts)),
size = 3,
hjust = 0,
nudge_x = -0.1,
check_overlap = TRUE,
color = "blue"
) +
xlim(NA, 33000) +
guides(y.sec = ggh4x::guide_axis_manual(
breaks = ddff$SampleID, labels = ddff$sampleName
))
However, you may need to deduplicate data in the axis if there are multiple observations per y-axis category (which isn't the case in the example).
This is a dupe of the ..., and adapting its solution to this is merely adding the scale_y_continuous and setting the y axis label. Unlike teunbrand's excellent answer (I'm a fan of teunbrand's packages/work), this is base ggplot2.
(This also alters the order, since we're now "counting" along the samples.)
ddff %>%
ggplot(aes(x = Counts, y = seq_along(SampleID))) +
geom_point(aes(col = compartment), size = 4, alpha = 0.75) +
geom_text(
aes(label = paste0(" ", Counts)),
size = 3,
hjust = 0,
nudge_x = -0.1,
check_overlap = TRUE,
color = "blue"
) +
xlim(NA, 33000) +
theme_light() +
theme(plot.title = element_text(hjust = 0.5), aspect.ratio = 1) +
theme(# remove the vertical grid lines
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()) +
labs(title = "Library Size Overview",
x = "Read Counts",
y = "SampleID", # <-- new
color = "Compartment") +
theme(
legend.position = c(.95, .95),
legend.justification = c("right", "top"),
legend.box.just = "right",
legend.box.background = element_rect(color = "black", size = 1)
) +
# new
scale_y_continuous(
breaks = seq_len(nrow(ddff)), labels = ddff$SampleID,
sec.axis = sec_axis(~., breaks = seq_len(nrow(ddff)),
labels = ddff$sampleName)
)

R: ggplot2 images as y-axis labels

I am trying to add images to a y-axis label. At the moment I am only able to add them inside the graph. You can find the code for the added images at the bottom of the code chunk. I want the flags to be displayed after or under or on top of the country name.
Does anybody know how to do it or where I can find a tutorial?
p <- ggplot(data, aes(x = country, y = thisyear)) +
geom_segment(aes(
x = reorder(country, thisyear) ,
xend = country,
y = lastyear,
yend = thisyear
),
color = "#3b3b3b") +
geom_point(size = 3, color = "#f7931b") +
geom_point(aes(x = country, y = lastyear), color = "#BCBCBC", size = 4) +
geom_point(aes(x = country, y = thisyear), color = "#f7931b", size = 4) +
annotate(
"text",
label = "this year",
x = nrow(data) - 0.7,
y = data[2, 3] + 3,
size = 4,
color = "#f7931b",
fontface = "bold"
) +
geom_curve(
aes(
x = nrow(data) - 0.85,
y = data[2, 3] + 3,
xend = nrow(data) - 1,
yend = data[2, 3] + 0.5
),
colour = "#f7931b",
size = 1,
curvature = -0.2,
arrow = arrow(length = unit(0.015, "npc"))
) +
annotate(
"text",
label = "last year",
x = nrow(data) - 1.5,
y = data[2, 2] + 3.2,
size = 4,
color = "#A8A8A8",
fontface = "bold"
) +
geom_curve(
aes(
x = nrow(data) - 1.35,
y = data[2, 2] + 3.2,
xend = nrow(data) - 1.05,
yend = data[2, 2] + 0.5
),
colour = "#A8A8A8",
size = 1,
curvature = -0.15,
arrow = arrow(length = unit(0.015, "npc"))
) +
scale_y_continuous(expand = expansion(mult = c(0, .05))) +
coord_flip() +
theme_ipsum() +
theme(
panel.grid.minor.y = element_blank(),
panel.grid.major.y = element_blank(),
legend.position = "none"
) +
labs(
title = "Share Of Global Bictoin Hashrate",
subtitle = paste0(as.character(format(maxdate, "%B %Y")), " Monthly Average"),
x = "",
y = '%',
caption = "#data99076083 | Source: Cambridge Centre for Alternative Finance (https://www.cbeci.org/mining_map)"
) +
theme_ipsum() +
theme(
legend.title = element_blank(),
plot.title = element_text(color = "#f7931b"),
plot.subtitle = element_text(color = "#3b3b3b"),
plot.caption = element_text(color = "#646464", face = 'bold'),
panel.border = element_rect(
colour = "grey",
fill = NA,
size = 1
)
)
p <-
p + geom_image(data = data, aes(x = id, y = 70, image = emoji), size = 0.04)
p
SOLUTION
As suggested I have tried to add the images with the [ggtext][2] tutorial. First I had to make the label vector with the HTML code:
labels <- c()
for (i in 1:length(data$emoji)){
img.name <- data$country[i]
labels <- c(labels, paste0("<img src='", data$emoji[i], "' width='25' /><br>*", img.name,"*"))
}
Example image code:
"<img src='../pics/twitter-emojis/flag-cote-divoire_1f1e8-1f1ee.png'
width='100' /><br>*I. virginica*"
After that the labels can be changed and printed with markdown:
p + scale_x_discrete(name = NULL,
labels = rev(labels)) +
theme(axis.text.y = element_markdown(color = "black", size = 11))

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

How to add a free text entry as a legend to ggplot?

I'm trying to make a world map with a custom legend on the right side. The legend should be with the prepared text on the left and the generated numbers on the right. I tried but to no avail. I need help My code is as follows:
library(dplyr)
library(ggplot2)
library(ggrepel)
library(rworldmap)
world_map_without_antarctica <- getMap()[-which(getMap()$ADMIN=='Antarctica'),] #get data from web
world_map_without_antarctica_t <- fortify(world_map_without_antarctica)
Data <- data.frame( "lon"=c(17.816883, 38.544239,20.895352,20.819651,35.392102,99.060241,
43.756911, 10.288485, 16.566191, 14.076159,8.118301,16.596266,
121.544442,-73.077732,14.938152),
"lat"=c(44.1807678, 35.0126143, 42.5793648, 44.2330372, 38.9907297,
39.5015541, 33.0368223, 51.1337227, 45.0162344, 47.6139488,
46.7917377, 62.8114850, 15.7509443, 3.9272139, 46.1254221),
"NAME"=c("Bosnia and Herzegovina", "Syria", "Kosovo","Republic of Serbia",
"Turkey","United States of America","Iraq","Germany","Croatia",
"Austria","Switzerland","Sweden","Philippines","Colombia","Slovenia"),
"Count"=c(65800,32636,15005,9276,6979,6528,6449,
5830,4862,3109,2959,2777,2577,2315,1394))
Data$label <- paste0(Data$NAME,': ',Data$Count)
word_data_merged <- merge(world_map_without_antarctica_t, Data[ , c("NAME","Count")], by.x="id", by.y="NAME", all.x=T)
word_data_merged <- word_data_merged %>% arrange(id, order)
country_shapes <- geom_polygon(data = world_map_without_antarctica_t, aes(x = long, y = lat, group = group),fill = NA)
maptheme <-
theme(panel.grid = element_blank())+
theme(axis.text = element_blank())+
theme(axis.ticks = element_blank())+
theme(axis.title = element_blank())+
theme(legend.position = "bottom")+
theme(panel.grid = element_blank())+
theme(plot.margin = unit(c(0, 0, 0.5, 0), 'cm'))
guide = guide_colorbar(
title="legend_title",
label = TRUE,
draw.ulim = TRUE,
draw.llim = TRUE,
frame.colour = "black",
ticks = TRUE,
nbin = 10,
label.position = "bottom",
barwidth = 13,
barheight = 1.3,
direction = 'horizontal')
ggplot(word_data_merged) +
labs(title = "plot_title", subtitle = "plot_subtitle") +
country_shapes +
scale_fill_gradient(high = "#381802", low = "#fccaa7", guide = guide) +
geom_polygon(aes(long, lat, group = group, fill=Count),alpha=1) +
geom_point(data=Data[Data$label !="",],aes(x = lon, y = lat), shape = 21,fill= "#275083", color = "#275083", size = 1.5,alpha=0.5) +
geom_path(aes(x=long,y=lat, group = group), color="#c7c9c9", size= 0.5, alpha=0.4) +
geom_label_repel(data=Data,aes(x= lon,y= lat,label = label),
size = 5,
show.legend= F,
fontface = "bold",
point.padding = unit(0.2, "lines") ) +
maptheme +
theme(panel.background = element_rect(fill = "#ebf2f7"))
After running the code, the following world map is obtained:
How can I add a legend with free text entry? I would like the map to look like in this picture:
This might help:
a) changing plot.margin,
b) adding geom_text for the annotation (updated with #Tung's suggestion to use check_overlap = TRUE to sharpen up the text), and
c) coord_cartesian(clip = 'off') to allow drawing outside of the plot area
ggplot(word_data_merged) +
labs(title = "plot_title", subtitle = "plot_subtitle") +
country_shapes +
scale_fill_gradient(high = "#381802", low = "#fccaa7", guide = guide) +
geom_polygon(aes(long, lat, group = group, fill=Count),alpha=1) +
geom_point(data=Data[Data$label !="",],aes(x = lon, y = lat), shape = 21,fill= "#275083", color = "#275083", size = 1.5,alpha=0.5) +
geom_path(aes(x=long,y=lat, group = group), color="#c7c9c9", size= 0.5, alpha=0.4) +
geom_label_repel(data=Data,aes(x= lon,y= lat,label = label),
size = 5,
show.legend= F,
fontface = "bold",
point.padding = unit(0.2, "lines") ) +
geom_text(aes(label = "Statistics", x = 180, y = 80),
fontface = "bold",
hjust = -0.5,
size = 5,
check_overlap = TRUE) +
geom_text(aes(label = "Total unique countries = #", x = 180, y = 70),
hjust = -0.35,
size = 3,
check_overlap = TRUE) +
coord_cartesian(clip = 'off')+
maptheme +
theme(panel.background = element_rect(fill = "#ebf2f7"),
plot.margin = unit(c(0, 4, 0.5, 0), 'cm'))
#> Warning: ggrepel: 12 unlabeled data points (too many overlaps). Consider
#> increasing max.overlaps
Based on: ggplot2 - annotate outside of plot
Created on 2021-01-16 by the reprex package (v0.3.0)

Resources