A friend of mine asked if I could replicate the following plot:
First, we load the packages and set the colors to be the same ones from the original plot (or at least, as close as possible).
# ************************************************************************* ----
# Packages ----
# ************************************************************************* ----
#install.packages("tidyverse")
library("tidyverse")
# ************************************************************************* ----
# Colors - From the original plot ----
# ************************************************************************* ----
orange <- "#e8ab5f"
green <- "#a1ad62"
background_diff <- "#eef0e2"
gray <- "#bbbbbb"
light_gray <- "#f4f4f4"
Now, we need to recreate the data. I did that as if the data were organized as follows:
# Country Ages_35_plus Ages_18_34
# 1 Germany 0.39 0.81
# 2 France 0.42 0.83
# 3 Vietnam 0.49 0.86
# 4 Japan 0.43 0.78
# 5 Poland 0.51 0.86
# 6 Lebanon 0.57 0.90
# 7 Australia 0.60 0.91
# 8 South Korea 0.45 0.75
# 9 Canada 0.65 0.93
# 10 Spain 0.57 0.85
# 11 Italy 0.57 0.83
# 12 Peru 0.65 0.91
# 13 U.S. 0.63 0.89
# 14 UK 0.59 0.84
# 15 Mexico 0.67 0.90
# 16 Chile 0.75 0.96
# 17 China 0.52 0.73
# 18 India 0.48 0.69
# 19 Pais A 0.60 0.40
# 20 Pais B 0.50 0.50
I’ve included Pais A and Pais B so that I have one country with a negative difference, and another one
with a difference of zero.
# ************************************************************************* ----
# Data for Dotplot ----
# ************************************************************************* ----
original_df <-
data.frame(
Country = c("Germany", "France", "Vietnam", "Japan",
"Poland", "Lebanon", "Australia",
"South Korea", "Canada", "Spain", "Italy", "Peru", "U.S.",
"UK", "Mexico", "Chile", "China", "India",
"Pais A", "Pais B"
),
Ages_35_plus = c(0.39, 0.42, 0.49, 0.43,
0.51, 0.57, 0.60,
0.45, 0.65, 0.57, 0.57, 0.65, 0.63,
0.59, 0.67, 0.75, 0.52, 0.48,
0.6, 0.5
),
Ages_18_34 = c(0.81, 0.83, 0.86, 0.78, 0.86, 0.90, 0.91,
0.75, 0.93, 0.85, 0.83, 0.91, 0.89,
0.84, 0.90, 0.96, 0.73, 0.69,
0.4, 0.5
)
)
Given that, I needed to do 5 things before I started:
1) Insert a line break in South Korea
2) Calculate the age differences
3) Sort countries by their age differences
4) Set country names as factors so that we can plot it in the correct order.
5) Gather columns into key-value pairs (age groups).
## \__Line Break
original_df_v2 <-
original_df %>%
mutate(
Country = ifelse(
Country == "South Korea",
# Value_if_True:
"South \n Korea",
# Value_if_False:
as.character(Country))
)
# _________________________________________________________________________ ====
## \__Calculate the age differences
base_diff <-
original_df_v2 %>%
mutate(
Diferenca = Ages_18_34-Ages_35_plus
) %>%
Sort (descending), but that's OK as ggplot inverts the order
arrange(Diferenca, desc(Country)) %>%
# Create factors from the names of the ordered countries
mutate(
Country.fact = factor(Country, levels = unique(Country))
)
# _________________________________________________________________________ ====
## \__Gather columns
df_diff_gather_age <-
base_diff %>%
gather(
# Group Name
key = Age_Group,
# Name of the Variable to input the percentages of Age
value = Age_Percent,
# Age variables
Ages_35_plus, Ages_18_34
) %>%
# Reorder the variables in the database
select(Country, Country.fact, Age_Group, Age_Percent, Diferenca)
#___________________________________________________________________________####
# ************************************************************************* ----
# Dot Plot ----
# ************************************************************************* ----
p<-
ggplot(
data = df_diff_gather_age,
mapping = aes(
# Y Axis
y=Country.fact,
# X Axis
x=Age_Percent,
# Groups with different colors
# If difference is zero, put it into a third group
color = ifelse(Diferenca == 0, "zero", Age_Group))
) +
# Plot lines between points, by Country
geom_line(
mapping = aes(group = Country),
color = gray,
size = 2.5
) +
geom_point(
# Dot size
size=4,
# dot type. Important to be number 19, otherwise we cannot plot the dots
# with the colors for different groups
pch = 19
) +
# Add % for each point
geom_text(
# Font size
size = 4,
# Set text a little below the dots
nudge_y = -0.35,
mapping =
aes(
label =
# If country is Germany (the first one), plot numbers with %
ifelse(Country == "Germany",
# Value_if_True:
paste0(as.character(round(Age_Percent*100,0)),"%"),
# Value_if_False
paste0(as.character(round(Age_Percent*100,0)))
),
color = ifelse(Diferenca == 0, "zero", Age_Group)
)
) +
# Add "Legend" above Germany (the first one)
geom_text(
# Font size
size = 4,
# Bold face
fontface = "bold",
# Set text a little above the dots
nudge_y = 0.6,
mapping =
aes(
label =
# If Country is Germany, plot legend
ifelse(Country == "Germany",
# Value_if_True:
ifelse(Age_Group == "Ages_35_plus",
# Value_if_True:
"Ages 35+",
# Value_if_False:
"Ages 18-34"
),
# Value_if_False
""
),
color = ifelse(Diferenca == 0, "zero", Age_Group)
)
) +
# Change dot colors
scale_color_manual(
values = c(orange, green, "gray")
) +
# Change scale x axis
scale_x_continuous(
# Set limits to 0 and 1.2 (we won't set it to 1 because we neeed some space
# after 1 to place the values of the differences)
limits = c(0,1.2),
# Show tick marks at every 25%
breaks = seq(0,1,.25),
# Change scale to percent
labels = scales::percent
) +
# Expand y axis scale so that the legend can fit
scale_y_discrete(
expand = expand_scale(add=c(0.65,1))
) +
# Add white rectangle to set the area where the values of the differences will
# be
geom_rect(
mapping = aes(xmin = 1.01, xmax = Inf , ymin = -Inf, ymax = Inf),
fill = "white",
color = "white"
) +
# Add rectangle with correct banground color for the differences
geom_rect(
mapping = aes(xmin = 1.05, xmax = 1.15 , ymin = -Inf, ymax = Inf),
fill = background_diff,
color = background_diff
) +
# Add Differences values
geom_text(
# Bold face
fontface = "bold",
# Font size
size = 4,
# Font Color
colour = "black",
# Position
mapping =
aes(
x = 1.1,
y = Country,
label =
# To avoid duplicate values, plot empty text for the first group and
# plot the difference only for the Ages_18_34 group.
ifelse(Age_Group == "Ages_35_plus",
# Value_if_True
"",
#Value_if_False
# If the difference is equal to zero, do not put any signal.
# Otherwise, if Positive, put the + sign on the front.
ifelse(Diferenca == 0,
# Value_if_True:
paste0(as.character(round(Diferenca*100,0))),
# Value_if_False
ifelse(Diferenca > 0,
# Value_if_True
paste0("+",as.character(round(Diferenca*100,0))),
# Value_if_False
paste0(as.character(round(Diferenca*100,0)))
)
)
)
)
) +
# Insert Title of Differences
geom_text(
# Bold face
fontface = "bold",
# Font size
size = 4,
# Cor
colour = "gray",
# Set text a little above the dots
nudge_y = 0.6,
# Position
mapping =
aes(
x = 1.1,
y = Country,
label =
# If Country is Germany, plot values
ifelse(Country == "Germany",
# Value_if_True
"DIFF",
#Value_if_False
""
)
)
) +
# Plot Title and Axis Labels
labs(
title = "The social media age gap",
subtitle = paste0(
"Adult internet users or reported smartphone owners who \n",
"use social networking sites"
),
x = "",
y = ""
) +
# Change background, General font size, and other things
theme(
# Change font color and text for all text outside geom_text
text = element_text(color = "#4e4d47", size = 14),
# Country names in bold face
axis.text.y = element_text(face = "bold"),
# Add space between x axis text and plot
axis.text.x = element_text(vjust = -0.75),
# Do not show tick marks
axis.ticks = element_blank(),
# Delete original legend (keep only the one we created)
legend.position = "none",
# White background
panel.background = element_blank(),
# Country (y Axis) Lines
panel.grid.major.y = element_line(colour = light_gray, size = 1),
# Change Title Font
plot.title = element_text(face = "bold", size = 16),
# Change Subtitle Font and add some margin
plot.subtitle = element_text(face = "italic", size = 12,
margin = margin(b = 0.5, unit = "cm"))
)
p
And the final plot:
