R Codes for the Bubble Chart:
# Clear R einvironment:
rm(list = ls())
# Load some R packages for data manipulation + visulization:
library(dplyr)
library(ggplot2)
# Simulate data for ploting:
<- 893
samples
<- 0.85
r
set.seed(29)
<- MASS::mvrnorm(n = samples, mu = c(0, 0), Sigma = matrix(c(1, r, r, 1), nrow = 2), empirical = TRUE)
data
as.data.frame(data) -> df_fake
%>%
df_fake rename(x = V1, y = V2) %>%
mutate_all(function(x) {((x - min(x)) / (max(x) - min(x)))}) %>%
filter(!x %in% c(0, 1), !y %in% c(0, 1)) -> df_fake
<- nrow(df_fake)
n
<- c("Wholesales", "Retail", "Finance", "Manufacturing", "Health care", "IT")
industry_names
<- length(industry_names)
k
set.seed(1)
sample(industry_names, size = nrow(df_fake), replace = TRUE, prob = rep(1 / k, k)) -> industry
set.seed(29)
%>%
df_fake mutate(industry = industry, size = sample(c(1, 10, 30, 100, 800), size = n, replace = TRUE, prob = c(0.4, 0.25, 0.2, 0.1, 0.05))) %>%
mutate(industry = factor(industry, levels = industry_names)) -> df_fake
# Function converts CMYK to HEX:
<- function(C, M, Y, K) {
convert_CMYK_to_HEX
<- C / 100.0
C <- M / 100.0
M <- Y / 100.0
Y <- K / 100.0
K
<- (C * (1 - K) + K)
n.c <- (M * (1 - K) + K)
n.m <- (Y * (1 - K) + K)
n.y
<- ceiling(255 * (1 - n.c))
r.col <- ceiling(255 * (1 - n.m))
g.col <- ceiling(255 * (1 - n.y))
b.col
<- rgb(r.col, g.col, b.col, max = 255)
hex_color_code
return(hex_color_code)
}
# Convert some CMKYs to HEX-color codes using by The Economist:
<- convert_CMYK_to_HEX(0, 100, 100, 0)
red_icon
<- convert_CMYK_to_HEX(90, 50, 15, 5)
who_color
<- convert_CMYK_to_HEX(85, 10, 0, 58)
ret_color
<- convert_CMYK_to_HEX(12, 30, 70, 0)
fin_color
<- convert_CMYK_to_HEX(0, 75, 35, 45)
man_color
<- convert_CMYK_to_HEX(80, 25, 50, 50)
hea_color
<- convert_CMYK_to_HEX(27, 42, 25, 10)
it_color
<- "#cddee7"
bgr_color
<- convert_CMYK_to_HEX(15, 0, 0, 10)
hig_color
<- "#6b9aae"
ann_color
<- "A widespread effect"
p_title
<- "Top four firms' share of total industry revenue, %\nUnited States, 893 industries, grouped by sector"
p_subtitle
<- "Source: US Census Bureau | Graphic Designer: Nguyen Chi Dung"
p_caption
<- "Top four firms' share of total industry revenue, 2000, %"
legend_y
<- "Top four firms' share of total industry revenue, 1997, %"
legend_x
library(showtext) # Package for using extra fonts.
<- "Roboto Condensed"
my_font
# Load font for ploting:
font_add_google(name = my_font, family = my_font)
<- "Oswald"
anno_font
font_add_google(name = anno_font, family = anno_font)
showtext_auto() # Automatically render text.
#--------------------------------------------------
# Replicate bubble plot created by The Economist
#--------------------------------------------------
<- tibble(x = 0:1, y = 0:1)
df_bgr2
<- "#008a84"
bgr_color2
ggplot() +
theme_minimal() +
theme(plot.background = element_rect(fill = bgr_color, color = NA)) +
geom_area(data = df_bgr2, aes(x = x, y = y), fill = bgr_color2, alpha = 0.1,
orientation = "y", color = "grey40", linetype = "longdash", size = 0.7, alpha = 0) +
geom_hline(yintercept = seq(0, 1, 0.2), color = "white", size = 0.8) +
geom_point(data = df_fake, aes(x = x, y = y, size = size, color = industry, fill = industry), alpha = 0.35) +
scale_size(range = c(1, 10)) +
guides(size = FALSE) +
scale_fill_manual(values = c(Wholesales = who_color,
Retail = ret_color,
Finance = fin_color,
Manufacturing = man_color,
"Health care" = hea_color,
IT = it_color)) +
scale_color_manual(values = c(Wholesales = who_color,
Retail = ret_color,
Finance = fin_color,
Manufacturing = man_color,
"Health care" = hea_color,
IT = it_color)) +
theme(legend.position = c(0.12, 0.77)) +
theme(panel.grid = element_blank()) +
scale_y_continuous(expand = c(0, 0), breaks = seq(0, 1, 0.2), labels = seq(0, 100, 20), limits = c(-0.015, 1.05)) +
scale_x_continuous(expand = c(0.001, 0), breaks = seq(0, 1, 0.1), labels = seq(0,100, 10)) +
theme(plot.margin = unit(c(0.5, 1, 0.5, 0.9), "cm")) +
labs(title = p_title, subtitle = p_subtitle, caption = p_caption, x = legend_x, y = legend_y) +
geom_hline(yintercept = 0, color = "grey30", size = 0.71) +
geom_segment(aes(x = seq(0, 1, 0.1), xend = seq(0, 1, 0.1), y = 0, yend = -0.015), size = 1, color = "grey30") +
theme(axis.title = element_text(family = my_font, color = "grey20", size = 11.5, face = "italic")) +
theme(axis.text = element_text(family = my_font, color = "grey20", size = 12)) +
theme(plot.title = element_text(family = my_font, size = 18, hjust = 0, face = "bold")) +
theme(plot.subtitle = element_text(family = my_font, size = 11, color = "grey20")) +
theme(plot.caption = element_text(family = my_font, color = "grey40", hjust = 0, size = 11, vjust = -1)) +
theme(plot.title.position = "plot") +
theme(plot.caption.position = "plot") +
# Adjust legend:
theme(legend.text = element_text(family = my_font, size = 10.5, color = "grey20", hjust = 0)) +
theme(legend.title = element_blank()) +
guides(color = guide_legend(override.aes = list(size = 5))) +
theme(legend.background = element_rect(fill = NA, color = NA)) +
# theme(legend.background = element_rect(fill = alpha(bgr_color2, 0.1), color = NA)) +
annotate("text", x = 0.4, y = 0.9, label = "BECOMING MORE\nCONCENTRATED",
hjust = 0, color = "#008a84", alpha = 0.9, family = anno_font, size = 3.5) +
annotate("text", x = 0.7, y = 0.3, label = "BECOMING LESS\nCONCENTRATED",
hjust = 0, color = "#008a84", alpha = 0.9, family = anno_font, size = 3.5)
# Make Financial Times icon:
library(grid)
<- "#ed1c24"
red_icon
grid.rect(x = 0, y = 1, width = 0.018, height = 0.008*8, just = c("left", "top"), gp = gpar(fill = red_icon, col = red_icon))