Extent Viridis color scheme - r

Is there a way i could extent (prepend) the value 'transparent' at the start of the Viridis colour scheme? Or maybe to overrule it in a way that every value (let's say) below -30 is the 'colour' transparent?
plot.nme = paste0('PLOTS/','temphi_tomorrow_test.png')
pred <- ggplot() +
geom_raster(data = nnmsk_df , aes(x = x, y = y, fill = var1.pred),interpolate = FALSE) +
annotate(geom="raster", x=ctry$x, y=ctry$y, alpha=.2,fill = scales::colour_ramp(c("#00000000","grey"))(ctry[,3])) +
theme_void() + # Empty theme without axis lines and texts
scale_fill_viridis(option = "viridis", direction = 1,name="Maximum temperature (°C)", limits = c(-30,30),breaks=c(-30,-25,-20,-15,-10,-5,0,5,10,15,20,25,30), na.value = "transparent") +
geom_text(aes(label = dfdat$temphi),x = dfdat$Longitude,y = dfdat$Latitude,size=0.6,col="#ffffff",
hjust = -0.01,
vjust = 0.01) +
geom_point(shape = 1)
pred_snow <- pred +
geom_contour(aes(x = x, y = y, z = var1.pred),data = nnmsk_df, na.rm = TRUE,bins = 6,colour = "white", alpha = 0.2,size=0.1) +
theme(
panel.background = element_rect(fill = "transparent", colour = NA),
plot.background = element_rect(fill = "transparent", colour = NA),
legend.background = element_rect(fill = "transparent", colour = NA),
legend.box.background = element_rect(fill = "transparent", colour = NA),
legend.position = c(0.5, 0.3),
legend.key.size = unit(0.4, "cm"),
legend.key.width = unit(0.4, "cm"),
legend.key.height = unit(0.1, "cm"),
legend.direction = "horizontal",
legend.title = element_text(color = "white", size = 4),
legend.text = element_text(colour="white",size=3)
)
pred_snow
ggsave(plot.nme, height = graph_height , width = graph_height * aspect_ratio,bg = "transparent",dpi = 300)

Related

Editing legend in ggplot2 - R

I'm learning to use ggplot to make graphs for my research and I'm having some trouble setting legends for them.
Initially I thought about just using the aes() function inside geom_point and geom_line to get the aesthetics I'm looking for. However, I realized the legends weren't being generated by doing it this way. Code and exemple below.
#Stablish the variables as vectors
MexxJan_hydrogen <- c(0, 1.38, 3.19, 8.30)
MexyJan_hydrogen <- c(0, 1.25, 2.78, 6.23)
MexzJan_hydrogen <- c(0, 2.46, 5.68, 12.18)
MexwJan_hydrogen <- c(0, 7.56, 9.20, 10.19)
time_hydrogen <- c(0, 60, 120, 180)
#Create the data frame
hydrogen_data <- data.frame(time_hydrogen, MexxJan_hydrogen, MexyJan_hydrogen, MexzJan_hydrogen, MexwJan_hydrogen)
view(hydrogen_data)
#Code the plot
hydrogen_plot <- ggplot(data = hydrogen_data) +
geom_line(aes(x = time_hydrogen, y = MexxJan_hydrogen), color = "palegreen3", lwd = 1) +
geom_line(aes(x = time_hydrogen, y = MexyJan_hydrogen), color = "tan1", lwd = 1) +
geom_line(aes(x = time_hydrogen, y = MexzJan_hydrogen), color = "tomato2", lwd = 1) +
geom_line(aes(x = time_hydrogen, y = MexwJan_hydrogen), color = "cadetblue", lwd = 1) +
geom_point(aes(x = time_hydrogen, y = MexxJan_hydrogen), color = "palegreen3", shape = 15, size = 5) +
geom_point(aes(x = time_hydrogen, y = MexyJan_hydrogen), color = "tan1", shape = 16, size = 5) +
geom_point(aes(x = time_hydrogen, y = MexzJan_hydrogen), color = "tomato2", shape = 17, size = 5) +
geom_point(aes(x = time_hydrogen, y = MexwJan_hydrogen), color = "cadetblue", shape = 18, size = 5) +
theme_bw() +
theme(axis.text = element_text(family = "Arial", size = 15, color = "black"),
axis.title.x = element_text(family = "Arial", size = 16, margin = margin(t = 15)),
axis.title.y = element_text(family = "Arial", size = 16, margin = margin(r = 15)),axis.line = element_line(color = "black"),
plot.background = element_rect(fill = "transparent", color = NA),
panel.border = element_rect(color = "black"),
panel.background = element_rect(fill = "transparent"),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.ticks.length = unit(0.20, units = "cm"),
legend.background = element_rect(fill = "transparent"),
legend.key = element_rect(fill = "transparent", colour = NA),
legend.position = "top",
legend.key.width = unit(0, unit = "cm"),
legend.key.height = unit(0, unit = "cm"),
legend.title = element_blank(),
legend.text = element_text(size = 13.5),
legend.spacing.x = unit(0.1, "cm"),
legend.text.align = unit(0.05, unit = "cm")) +
labs(x = "Time (min)", y = "Gas Evolution (µmol.g"^-1~")") +
coord_cartesian(ylim = c(0,15), xlim = c(0,180)) +
scale_y_continuous(expand = expansion(mult = c(0.02, 0.02)),
n.breaks = 5) +
scale_x_continuous(expand = expansion(mult = c(0.02, 0.02)),
breaks = c(0, 60, 120, 180))
I then found that I could use the function scale_colors_manual to get the desired colors and show the legend. Also, using scale_colors_manual I managed to change the legend text to a shorter option. Code and exemple below.
#Stablish the variables as vectors
MexxJan_hydrogen <- c(0, 1.38, 3.19, 8.30)
MexyJan_hydrogen <- c(0, 1.25, 2.78, 6.23)
MexzJan_hydrogen <- c(0, 2.46, 5.68, 12.18)
MexwJan_hydrogen <- c(0, 7.56, 9.20, 10.19)
time_hydrogen <- c(0, 60, 120, 180)
#Create the data frame
hydrogen_data <- data.frame(time_hydrogen, MexxJan_hydrogen, MexyJan_hydrogen, MexzJan_hydrogen, MexwJan_hydrogen)
view(hydrogen_data)
hydrogen_plot <- ggplot(data = hydrogen_data) +
geom_line(aes(x = time_hydrogen, y = MexxJan_hydrogen, color = "MexxJan_hydrogen"), lwd = 1) +
geom_line(aes(x = time_hydrogen, y = MexyJan_hydrogen, color = "MexyJan_hydrogen"), lwd = 1) +
geom_line(aes(x = time_hydrogen, y = MexzJan_hydrogen, color = "MexzJan_hydrogen"), lwd = 1) +
geom_line(aes(x = time_hydrogen, y = MexwJan_hydrogen, color = "MexwJan_hydrogen"), lwd = 1) +
geom_point(aes(x = time_hydrogen, y = MexxJan_hydrogen, color = "MexxJan_hydrogen"), shape = 15, size = 5) +
geom_point(aes(x = time_hydrogen, y = MexyJan_hydrogen, color = "MexyJan_hydrogen"), shape = 16, size = 5) +
geom_point(aes(x = time_hydrogen, y = MexzJan_hydrogen, color = "MexzJan_hydrogen"), shape = 17, size = 5) +
geom_point(aes(x = time_hydrogen, y = MexwJan_hydrogen, color = "MexwJan_hydrogen"), shape = 18, size = 5) +
theme_bw() +
theme(axis.text = element_text(family = "Arial", size = 15, color = "black"),
axis.title.x = element_text(family = "Arial", size = 16, margin = margin(t = 15)),
axis.title.y = element_text(family = "Arial", size = 16, margin = margin(r = 15)),axis.line = element_line(color = "black"),
plot.background = element_rect(fill = "transparent", color = NA),
panel.border = element_rect(color = "black"),
panel.background = element_rect(fill = "transparent"),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.ticks.length = unit(0.20, units = "cm"),
legend.background = element_rect(fill = "transparent"),
legend.key = element_rect(fill = "transparent", colour = NA),
legend.position = "top",
legend.key.width = unit(0, unit = "cm"),
legend.key.height = unit(0, unit = "cm"),
legend.title = element_blank(),
legend.text = element_text(size = 13.5),
legend.spacing.x = unit(0.1, "cm"),
legend.text.align = unit(0.05, unit = "cm")) +
labs(x = "Time (min)", y = "Gas Evolution (µmol.g"^-1~")") +
coord_cartesian(ylim = c(0,15), xlim = c(0,180)) + #Limit the size of the plot
scale_y_continuous(expand = expansion(mult = c(0.02, 0.02)),
n.breaks = 5) +
scale_x_continuous(expand = expansion(mult = c(0.02, 0.02)),
breaks = c(0, 60, 120, 180)) +
scale_color_manual(labels = c("15Me-NT", "15Me-nNT", "15Me-NNT", "15Me-nnt"),
values = c("MexxJan_hydrogen" = "palegreen3", "MexyJan_hydrogen" = "tan1", "MexzJan_hydrogen" = "cadetblue", "MexwJan_hydrogen" = "tomato2"))
In this case, I got the colors and the legend. However, as you can see in the image, the legend keys look like a bunch of geometric forms stacked. I couldn't find a way to solve this. Tried using scale_shape_manual but I couldn't get the code right.
May you help me getting this plot some beautiful aesthetics? hehehe
Thank you. Stay safe.
To fix your issue you have to move shape inside aes similar to what you have done for color and afterwards set your shapes via scale_shape_manual. However, you could simplify your approach considerably by first reshaping your data to long or tidy data format. Doing so allows to add your lines and points which just one geom_point and geom_line:
library(tidyr)
library(ggplot2)
hydrogen_data_long <- hydrogen_data %>%
tidyr::pivot_longer(-time_hydrogen, names_to = "hydrogren")
ggplot(hydrogen_data_long, aes(x = time_hydrogen, y = value, color = hydrogren)) +
geom_line(lwd = 1) +
geom_point(aes(shape = hydrogren), size = 5) +
scale_shape_manual(
labels = c("15Me-NT", "15Me-nNT", "15Me-NNT", "15Me-nnt"),
values = c(
"MexxJan_hydrogen" = 15, "MexyJan_hydrogen" = 16,
"MexzJan_hydrogen" = 17, "MexwJan_hydrogen" = 18
)
) +
scale_color_manual(
labels = c("15Me-NT", "15Me-nNT", "15Me-NNT", "15Me-nnt"),
values = c(
"MexxJan_hydrogen" = "palegreen3", "MexyJan_hydrogen" = "tan1",
"MexzJan_hydrogen" = "cadetblue", "MexwJan_hydrogen" = "tomato2"
)
) +
theme_bw() +
theme(
axis.text = element_text(family = "Arial", size = 15, color = "black"),
axis.title.x = element_text(family = "Arial", size = 16, margin = margin(t = 15)),
axis.title.y = element_text(family = "Arial", size = 16, margin = margin(r = 15)),
axis.line = element_line(color = "black"),
plot.background = element_rect(fill = "transparent", color = NA),
panel.border = element_rect(color = "black"),
panel.background = element_rect(fill = "transparent"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks.length = unit(0.20, units = "cm"),
legend.background = element_rect(fill = "transparent"),
legend.key = element_rect(fill = "transparent", colour = NA),
legend.position = "top",
legend.key.width = unit(0, unit = "cm"),
legend.key.height = unit(0, unit = "cm"),
legend.title = element_blank(),
legend.text = element_text(size = 13.5),
legend.spacing.x = unit(0.1, "cm"),
legend.text.align = unit(0.05, unit = "cm")
) +
labs(x = "Time (min)", y = "Gas Evolution (µmol.g"^-1 ~ ")") +
coord_cartesian(ylim = c(0, 15), xlim = c(0, 180)) + # Limit the size of the plot
scale_y_continuous(
expand = expansion(mult = c(0.02, 0.02)),
n.breaks = 5
) +
scale_x_continuous(
expand = expansion(mult = c(0.02, 0.02)),
breaks = c(0, 60, 120, 180)
)
You are making life harder for yourself by passing your data frame in the wrong format. If you pivot to long format, you only need a single geom_line and geom_point. It's also far easier to map your colors and shapes, which will automatically appear in the legend.
Also, try to choose a default theme that's closer to the look you want to achieve to cut down on the number of tweaks you have to make via theme. One of the key things you'll learn in R, as in other languages, is that cutting down code to a minimum makes it easier to change or debug your code later on.
library(tidyverse)
hydrogen_data %>%
pivot_longer(-time_hydrogen) %>%
ggplot(aes(time_hydrogen, value, color = name, shape = name)) +
geom_line(lwd = 1) +
geom_point(size = 5) +
scale_color_manual(values = c("tomato2", "palegreen", "tan1", "cadetblue"),
labels = paste0("15Me-", c("NT", "nNT", "NNT", "nnt"))) +
scale_shape_manual(values = c(18, 15, 16, 17),
labels = paste0("15Me-", c("NT", "nNT", "NNT", "nnt"))) +
scale_y_continuous(expression(Gas~Evolution~(µmol.g^-1)),
expand = expansion(mult = c(0.02, 0.02)), n.breaks = 5) +
scale_x_continuous("Time (min)", expand = expansion(mult = c(0.02, 0.02)),
breaks = c(0, 60, 120, 180)) +
theme_classic(base_size = 16) +
theme(axis.text = element_text(family = "Arial", size = 15, color = "black"),
plot.background = element_blank(),
panel.border = element_rect(color = "black", fill = NA),
panel.background = element_blank(),
axis.ticks.length = unit(0.20, units = "cm"),
legend.background = element_blank(),
legend.position = "top",
legend.title = element_blank()) +
coord_cartesian(ylim = c(0, 15), xlim = c(0, 180))

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

plotting geom_text() with free scale facet_wrap

I would like to plot geom_text() in a facet_wrap with scale = free.
I tried to use geom_blank() or, set each height on each graph, but it was not successful.
Would you possibly tell me how to plot geom_text() in the right bottom in each figure.
z_cor <- fit01_varsize2 %>%
filter(!variable1 == "intercept") %>%
group_by(variable1) %>%
# mutate(height = max(value_with) + .3 * sd(value_with)) %>%
ggplot(aes(x = value_without, y = value_with))+
geom_point(aes(color = value), shape = 1)+
# geom_blank(aes(x = 1, y = 1)) +
geom_text(
data = data.frame(variable1 = c("Agricultural_land", "Artificial_land", "Precipitation", "Protected_area",
"RiverLake", "Seashore", "Temperature", "Volcanic_area", "Wasteland"),
label = c("TRUE:FALSE = 694:316", "TRUE:FALSE = 698:312", "TRUE:FALSE = 733:277", "TRUE:FALSE = 864:146",
"TRUE:FALSE = 721:289", "TRUE:FALSE = 739:271", "TRUE:FALSE = 657:353", "TRUE:FALSE = 748:262", "TRUE:FALSE = 707:303")),
aes(x = 0.1, y = 0.1, label = label))+
geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
scale_color_manual(values = c("TRUE" = "salmon", "FALSE" = "steelblue"))+
# geom_smooth(method = "lm",colour= "deepskyblue3")+
# ggpubr::stat_cor(method="pearson", label.y.npc="top", label.x.npc = "center")+
facet_wrap(.~variable1, scales = "free")+
theme(strip.text.x = element_text(size = 20),
axis.title=element_text(size=16),
axis.line = element_line(colour="grey40"),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
legend.position = "bottom",
panel.background = element_rect(fill = "transparent",
colour = "transparent",
size = 0.5, linetype = "solid"),
plot.background = element_rect(fill = "transparent",
colour = "transparent"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)
[![enter image description here][1]][1]
By setting the aes(x, y) parameters to positive or negative Inf inside geom_text, we can have text labels on the lower right bottom of each facet. The extra hjust and vjust adjust the position of the label so that they would be in the panel.
Here I use the diamonds dataset as an example, and the data for geom_text is called diamonds_label.
library(ggplot2)
diamonds_label <- data.frame(clarity = unique(diamonds$clarity), label = LETTERS[1:8])
ggplot(diamonds, aes(x, y)) +
geom_point() +
facet_wrap(.~clarity, scale = "free") +
geom_text(data = diamonds_label, aes(Inf, -Inf, label = label),
col = "red",
hjust = 1,
vjust = -1)
Created on 2022-05-10 by the reprex package (v2.0.1)

How to draw color line with size in R

I have a data with over 700 observations but below is a sample. Using geom_curve I want to make a plot where the line size(total_trips) corresponds to a color say 3 different colors. For instance between 0-100 (total_trips) can have a color of red
df <- data.frame(
origin_x = c(659627.8,642136.2,648774.7,659627.8,659627.8,658455.7,659627.8,659620.6,661641.8,656246.4),
origin_y = c(6473200,6473200,6462166,6473200,6473200,6467413,6473200,6467163,6479577,6487039),
dest_x = c(642136.2,659627.8,659627.8,648774.7,659620.6,659627.8,658455.7,659627.8,659627.8,659627.8),
dest_y = c(6456563,6473200,6473200,6462166,6467163,6473200,6467413,6473200,6473200,6473200
),
total_trips = c(4002,49878,2011,500,100,3000,2500,654,900,600))
I tried
ggplot() + geom_sf(data=shapefile, colour='grey', fill='grey93', size = 0.25) +
geom_curve(
data = df),
aes(
x = origin_x,
xend = dest_x,
y = origin_y,
yend = dest_y,
size = n,
colour= as.factor(c('red','blue'))),
curvature = 0.3
) + scale_alpha_continuous(range = c(0.09,1)) +
theme(
axis.title = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
plot.title = element_text(hjust = 0.5, size = 6),
plot.caption = element_text(hjust = 1),
plot.caption.position = 'plot',
axis.ticks = element_blank(),
panel.background = element_rect(fill = 'white'),
panel.grid = element_blank(),
plot.background = element_rect(color = NA, size = 0.5, fill=NA),
panel.border = element_rect(color = 'black', fill = NA, size=0.2) ,
legend.position = c(0.89,0.15),
legend.key.size = unit(0.4, 'cm'),
legend.text = element_text(size=7)
) +
annotation_scale(location = 'br', style = 'ticks') + coord_sf(crs=3301) +
annotation_north_arrow(location = 'tr', width = unit(0.20, 'cm'),height = unit(0.5,'cm'))
If I understand correctly - you want to change the colour of the line according to a categorised continuous variable (total_trips), we can do this:
Use cut to categorise the variable and give labels to the groups
Add this new variable to the aes(colour =.
library(dplyr)
library(ggplot2)
df <- df |> mutate(trips = cut(total_trips, c(0, 2000, 5000, 50000),
labels = c("0-2k", "2k-5k", "5k-50k")))
ggplot() +
geom_curve(data = df, aes(x = origin_x,
xend = dest_x,
y = origin_y,
yend = dest_y,
size = total_trips,
colour = trips
))
Output:
Not sure if this is what you want, though – your sample dataset doesn't contain the variable n that you mention in size = n, and you haven't provided us with shapefile.

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

Resources