通過Tidytuesday Week 52 - Big Mac Index數(shù)據(jù)繪制高端可視化圖，數(shù)據(jù)可視化的經(jīng)典案例项鬼，各位看官老爺細(xì)細(xì)品味耗帕，喜歡請關(guān)注個人公眾號R語言數(shù)據(jù)分析指南持續(xù)分享更多優(yōu)質(zhì)資源
加載所需R包
rm(list=ls())
library(tidyverse)
library(lubridate)
library(patchwork)
# install.packages("fuzzyjoin")
library(fuzzyjoin)
數(shù)據(jù)清洗
bigmac <- read.delim("big-mac.csv",header = T,sep=",",
check.names = F)
eurozone_countries <- c("Austria", "Belgium", "Cyprus",
"Estonia", "Finland", "France", "Germany", "Greece",
"Ireland", "Italy", "Latvia", "Lithuania", "Luxembourg",
"Malta", "Netherlands", "Portugal", "Slovakia",
"Slovenia", "Spain")
eurozone <- tibble(iso_a3 = rep("EUZ", length(eurozone_countries)),
currency = rep("EUR", length(eurozone_countries)),
name = eurozone_countries)
eurozone <- eurozone %>%
fuzzyjoin::regex_left_join(select(maps::iso3166, mapname, a3), c(name = "mapname")) %>%
select(-mapname)
date_list <- bigmac %>%
filter(iso_a3 == "EUZ") %>%
select(date, iso_a3) %>%
distinct(date, iso_a3)
eurobigmac <- date_list %>%
inner_join(eurozone, by = c("iso_a3")) %>%
left_join(select(bigmac,-name), by = c("iso_a3", "date")) %>%
mutate(iso_a3 = ifelse(!is.na(a3), a3, iso_a3)) %>%
select(-a3)
bigmac <- bigmac %>%
mutate(name = ifelse(name == "Euro area", "Eurozone", name)) %>%
bind_rows(eurobigmac)
world_map <- map_data("world") %>%
filter(region != "Antarctica") %>%
as_tibble() %>%
fuzzyjoin::regex_left_join(maps::iso3166, c(region = "mapname")) %>%
left_join(filter(bigmac,date == ymd("2020-07-01")), by = c(a3 = "iso_a3"))
自定義函數(shù)繪制各個國家的散點(diǎn)圖
blue = "#0870A5"
red = "#DB444B"
chart <- function(country){
data <- bigmac %>%
filter(name == country) %>%
mutate(valuation = ifelse(usd_raw >= 0, "Overvalued", "Undervalued"))
min_axis <- ifelse(min(data$usd_raw) > 0, 0, min(data$usd_raw)) - 0.15
max_axis <- ifelse(max(data$usd_raw) < 0, 0, max(data$usd_raw)) + 0.15
min_date <- min(data$date)
data %>%
ggplot(aes(date, usd_raw)) +
geom_point(aes(color = valuation), size = 2) +
geom_hline(yintercept = 0, color = "grey50", linetype = "dashed") +
geom_text(x = min_date, y = 0.1,
label = "Overvalued", hjust = 0, color = blue) +
geom_text(x = min_date, y = -0.1,
label = "Undervalued",
hjust = 0, color = red) +
scale_color_manual(values = c("Overvalued" = blue,
"Undervalued" = red)) +
scale_y_continuous(limits = c(min_axis, max_axis),
labels = scales::percent) +
guides(color = FALSE)+
labs(title = country) +
theme(plot.background = element_rect(fill = NA,
color = NA), panel.background = element_rect(fill = NA,color = NA),
axis.title = element_blank(),
axis.text = element_text(family = "heebo",size = 10),
panel.grid.minor = element_blank(),
axis.text.x=element_blank(),
panel.grid.major = element_line(color = "grey80",
linetype = "dotted"),
plot.title = element_text(family = "heebo",
size = 12))
}
用折線連接地圖上的國家
centre <- map_data("world") %>% tbl_df %>%
filter(region %in% c("Norway","Switzerland",
"South Africa", "Argentina", "China", "Russia",
"Canada", "Mexico", "France", "New Zealand")) %>%
group_by(region) %>%
summarise(centx = mean(long),
centy = mean(lat))
countries_lines <- tibble(x = c(-65.5,25.3,-110,-104,
99.2,107, 170, 8.31,16.2,3.23),
xend = c(-85, 65, -200, -200, 210,
210, 210, 170, 47, -60),
y = c(-37.7, -28.8, 60, 24.2, 63.5,
35, -40.9, 46.7, 60, 46.2),
yend = c(-75, -75, 70, 10, 75,
25, -50, 115, 115, 115))
繪制世界地圖
map <- ggplot() +
geom_polygon(data = world_map, aes(long, lat, group = group, fill = usd_raw),
color = "grey50", size = 0.3) +
scale_fill_gradient2(low = "#F21A00", mid = "#E9C825", high = "#3B9AB2", midpoint = -0.3,
labels = scales::percent, na.value="grey80") +
geom_segment(data = countries_lines, aes(x = x, xend = xend, y = y , yend = yend), color = "grey50", inherit.aes = FALSE) +
scale_x_continuous(limits = c(-350, 350), expand = c(0,0)) +
scale_y_continuous(limits = c(-130, 170)) +
labs(fill = "Big Mac Index relative to USD") +
guides(fill = guide_colorbar(title.position = "top",
label.position = "bottom",
title.hjust = 0.5,
barwidth = 20)) +
theme_void() +
theme(legend.position = c(0.12, 0.12),
legend.direction = "horizontal",
legend.title = element_text(size = 10),
legend.text = element_text(size = 10))
繪制各個國家的散點(diǎn)圖
swiss <- chart("Switzerland")
swiss
norway <- chart("Norway")
euro_area <- chart("Eurozone")
south_africa <- chart("South Africa")
russia <- chart("Russia")
china <- chart("China")
new_zealand <- chart("New Zealand")
argentina <- chart("Argentina")
mexico <- chart("Mexico")
canada <- chart("Canada")
設(shè)置圖片布局
final <- map +
inset_element(swiss,0.7,0.8,0.9,0.95) +
inset_element(norway,0.5,0.8,0.7,0.95) +
inset_element(euro_area,0.3,0.8,0.5,0.95) +
inset_element(south_africa,0.55,0.05,0.75,0.20) +
inset_element(russia,0.8,0.6,1,0.75) +
inset_element(china,0.8,0.4,1,0.55) +
inset_element(new_zealand,0.8,0.15,1,0.30) +
inset_element(argentina,0.3,0.05,0.5,0.20) +
inset_element(mexico,0,0.4,0.2,0.55) +
inset_element(canada,0,0.6,0.2,0.75) +
plot_annotation(
title = "The Big Mac Index",
caption = "Visualization: Christophe Nicault | Data: The Economist",
theme = theme(plot.caption = element_text(family = "heebo",
size = 10, color = "#183170"),
plot.title = element_text(family = "oswald",
hjust = 0.5, size = 28, face = "bold",
color = "#183170", margin = margin(5,0,0,0))))
保存圖片
ggsave(final,file="big-index.png",device = NULL,
path = NULL,width = 25,height = 15,units = c("in"),dpi = 300)
