From 25102bb85bfc2a731a7858d7ba3b93fbeaa4800f Mon Sep 17 00:00:00 2001 From: Chih-Hsuan Chang <100536001@alumnos.uc3m.es> Date: Sun, 14 Dec 2025 14:06:17 +0100 Subject: [PATCH 1/3] initial verson_replication --- _projects/2025/100536001/100536001.Rmd | 767 ++ _projects/2025/100536001/100536001.html | 2340 ++++ .../anchor-4.2.2/anchor.min.js | 9 + .../bowser-1.9.3/bowser.min.js | 6 + .../distill-2.2.21/template.v2.js | 744 ++ .../figure-html5/unnamed-chunk-12-1.png | Bin 0 -> 231076 bytes .../figure-html5/unnamed-chunk-13-1.png | Bin 0 -> 247904 bytes .../figure-html5/unnamed-chunk-7-1.png | Bin 0 -> 159760 bytes .../figure-html5/unnamed-chunk-9-1.png | Bin 0 -> 182208 bytes .../header-attrs-2.29/header-attrs.js | 12 + .../jquery-3.6.0/jquery-3.6.0.js | 10881 ++++++++++++++++ .../jquery-3.6.0/jquery-3.6.0.min.js | 2 + .../jquery-3.6.0/jquery-3.6.0.min.map | 1 + .../popper-2.6.0/popper.min.js | 6 + .../tippy-6.2.7/tippy-bundle.umd.min.js | 2 + .../tippy-6.2.7/tippy-light-border.css | 1 + .../100536001_files/tippy-6.2.7/tippy.css | 1 + .../tippy-6.2.7/tippy.umd.min.js | 2 + .../webcomponents-2.0.0/webcomponents.js | 236 + .../Consumer-Inflation_2020-2025.jpeg | Bin 0 -> 289260 bytes ... inflation 2025_Deutsche Bank - Sheet1.csv | 50 + projects.html | 291 +- .../figure-html5/unnamed-chunk-12-1.png | Bin 0 -> 231076 bytes .../figure-html5/unnamed-chunk-13-1.png | Bin 0 -> 247904 bytes .../figure-html5/unnamed-chunk-7-1.png | Bin 0 -> 159760 bytes .../figure-html5/unnamed-chunk-9-1.png | Bin 0 -> 182208 bytes .../Consumer-Inflation_2020-2025.jpeg | Bin 0 -> 289260 bytes ... inflation 2025_Deutsche Bank - Sheet1.csv | 50 + projects/2025/100536001/index.html | 3335 +++++ projects/projects.json | 21 + sitemap.xml | 14 +- 31 files changed, 18632 insertions(+), 139 deletions(-) create mode 100644 _projects/2025/100536001/100536001.Rmd create mode 100644 _projects/2025/100536001/100536001.html create mode 100644 _projects/2025/100536001/100536001_files/anchor-4.2.2/anchor.min.js create mode 100644 _projects/2025/100536001/100536001_files/bowser-1.9.3/bowser.min.js create mode 100644 _projects/2025/100536001/100536001_files/distill-2.2.21/template.v2.js create mode 100644 _projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-12-1.png create mode 100644 _projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-13-1.png create mode 100644 _projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-7-1.png create mode 100644 _projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-9-1.png create mode 100644 _projects/2025/100536001/100536001_files/header-attrs-2.29/header-attrs.js create mode 100644 _projects/2025/100536001/100536001_files/jquery-3.6.0/jquery-3.6.0.js create mode 100644 _projects/2025/100536001/100536001_files/jquery-3.6.0/jquery-3.6.0.min.js create mode 100644 _projects/2025/100536001/100536001_files/jquery-3.6.0/jquery-3.6.0.min.map create mode 100644 _projects/2025/100536001/100536001_files/popper-2.6.0/popper.min.js create mode 100644 _projects/2025/100536001/100536001_files/tippy-6.2.7/tippy-bundle.umd.min.js create mode 100644 _projects/2025/100536001/100536001_files/tippy-6.2.7/tippy-light-border.css create mode 100644 _projects/2025/100536001/100536001_files/tippy-6.2.7/tippy.css create mode 100644 _projects/2025/100536001/100536001_files/tippy-6.2.7/tippy.umd.min.js create mode 100644 _projects/2025/100536001/100536001_files/webcomponents-2.0.0/webcomponents.js create mode 100644 _projects/2025/100536001/Consumer-Inflation_2020-2025.jpeg create mode 100644 _projects/2025/100536001/global inflation 2025_Deutsche Bank - Sheet1.csv create mode 100644 projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-12-1.png create mode 100644 projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-13-1.png create mode 100644 projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-7-1.png create mode 100644 projects/2025/100536001/100536001_files/figure-html5/unnamed-chunk-9-1.png create mode 100644 projects/2025/100536001/Consumer-Inflation_2020-2025.jpeg create mode 100644 projects/2025/100536001/global inflation 2025_Deutsche Bank - Sheet1.csv create mode 100644 projects/2025/100536001/index.html diff --git a/_projects/2025/100536001/100536001.Rmd b/_projects/2025/100536001/100536001.Rmd new file mode 100644 index 00000000..89ef04de --- /dev/null +++ b/_projects/2025/100536001/100536001.Rmd @@ -0,0 +1,767 @@ +--- +title: "Final Project_Chih Hsuan Chang" +description: | +categories: "2025" +author: Chih Hsuan Chang +date: "`r Sys.Date()`" +output: + distill::distill_article: + self_contained: false + toc: true +--- + +## Consumer Inflation 2020 - 2025 + +```{r setup, include = FALSE} +knitr::opts_chunk$set(out.width="100%", fig.align="center", fig.showtext=TRUE) +``` + +I have choose the graph from Visual Capitalist, "Consumer Inflation from 2020 to 2025". The dataset is from Deutsche Bank, record consumer inflation from 2020 to June 2025. + + + +### Packages + +```{r} +library(readr) +library(ggplot2) +library(tidyverse) +library(sf) # map structure +library(scales) # making the scale +library(rnaturalearth) # map info +library(showtext) # fonts +library(systemfonts) +library(cowplot) # composite maps together +``` + +### Data Cleaning + +```{r} +# import data +inflation2025 <- read_csv("global inflation 2025_Deutsche Bank - Sheet1.csv") + +# clean data +cum_inflation_2025 <- inflation2025 |> + select(-`cum change since 2012 (%)`, + -`cum change since 2020 (%)`, + -`Rank based on change from 2012 Economy`) |> + mutate(Economy = case_when(Economy == "United States" ~ "United States of America", + Economy == "Czech Republic" ~ "Czechia", + TRUE ~ Economy)) + +# sf data object +world_map <- ne_countries(scale = "medium", returnclass = "sf") |> + filter(admin != "Antarctica") +world_inflation <- world_map |> + left_join(cum_inflation_2025, by = c("name" = "Economy")) |> + # change names that are shown/not shown on the map + mutate(name = case_when(name == "South Africa" ~ "S. Africa", + name == "Turkey" ~ "Türkiye", + name == "United Kingdom" ~ "UK", + name == "South Korea" ~ "S. Korea", + name == "United Arab Emirates" ~ "UAE", + name == "United States of America" ~ "U.S.", + name %in% c( + "Austria", "Netherlands", "Belgium", + "Luxembourg", "Portugal", "Singapore", + "Denmark", "Ireland") ~ "", + TRUE ~ name)) +``` + +### Fonts + +```{r} +#| include: false +knitr::opts_chunk$set(dev = "ragg_png") +``` + +```{r} +font_add_google("Poppins", "poppins") +font_add(family = "Modak", + regular = "/Users/karlazhong/Library/Fonts/Modak-Regular.ttf") +showtext_auto() +``` + +### The Gradient Scale on Top of the Map + +```{r} +# bar legend +vc_palette <- c("#53a6e8", "#6b9bd1", "#7B95C5","#8a8eb8", "#9B88AC","#ab809f", "#B87993","#c87284", "#D86C7B","#e56569", "#B0022A") +limit_range <- c(0, 55) +legend_data <- data.frame(x = seq(limit_range[1], limit_range[2], length.out = 500)) +legend_data$y_height <- 0.2 + (legend_data$x / 50) * 2 + +legend_plot <- ggplot(legend_data) + + geom_segment(aes(x = x, xend = x, y = 0, yend = y_height, color = x), linewidth = 1) + + scale_color_gradientn( + colors = vc_palette, + limits = limit_range, + oob = scales::squish, + ) + + annotate("text", x = 1, y = -1, label = "0%", size = 2.5, fontface = "bold", color = "#333333") + + annotate("text", x = 10, y = -1, label = "10%", size = 2.5, fontface = "bold", color = "#333333") + + annotate("text", x = 20, y = -1, label = "20%", size = 2.5, fontface = "bold", color = "#333333") + + annotate("text", x = 30, y = -1, label = "30%", size = 2.5, fontface = "bold", color = "#333333") + + annotate("text", x = 40, y = -1, label = "40%", size = 2.5, fontface = "bold", color = "#333333") + + annotate("text", x = 50, y = -1, label = "50%", size = 2.5, fontface = "bold", color = "#333333") + + annotate("segment", x = 0, xend = 0, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 5, xend = 5, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 10, xend = 10, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 15, xend = 15, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 20, xend = 20, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 25, xend = 25, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 30, xend = 30, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 35, xend = 35, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 40, xend = 40, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 45, xend = 45, y = 0, yend = -0.3, color = "#333333") + + annotate("segment", x = 50, xend = 50, y = 0, yend = -0.3, color = "#333333") + + ylim(-1, 4) + + xlim(10, 60) + + scale_y_continuous(expand = c(0, 0), limits = c(-5, 4)) + + scale_x_continuous(expand = c(0, 0)) + + theme_void() + + theme(legend.position = "none") + +scale_grob <- ggplotGrob(legend_plot) +``` + +### Numbers on Bubbles + +```{r} +# inside the lens +bubble_list_eu <- tibble::tribble( + ~name_label, ~value_label, + "Hungary", "52%", + "Czechia", "41%", + "UK", "24%", + "Italy", "18%", + "Greece", "16%", + "Switzerland", "6%") +bubble_list_sea <- tibble::tribble( + ~name_label, ~value_label, + "Philippines", "24%", + "Indonesia", "14%", + "Taiwan", "10%", + "Malaysia", "9%", + "Hong Kong", "8%", + "Thailand", "8%") +bubble_geo_eu <- world_inflation |> + right_join(bubble_list_eu, by = c("name" = "name_label")) |> + st_point_on_surface() +bubble_geo_sea <- world_inflation |> + right_join(bubble_list_sea, by = c("name" = "name_label")) |> + st_point_on_surface() + +# adjust bubble position +row_greece <- which(bubble_geo_eu$name_label == "Greece") +new_grc_coords <- st_point(c(21.65, 40.25)) +bubble_geo_eu$geometry[row_greece] <- st_sfc(new_grc_coords) |> + st_set_crs(st_crs(bubble_geo_eu)) +st_geometry(bubble_geo_eu)[bubble_geo_eu$name == "Czechia"] <- st_sfc( + st_point(c(18.0, 50.0)), crs = st_crs(bubble_geo_eu)) + +# outside of the lens +bubble_list_rest <- tibble::tribble( + ~name_label, ~value_label, + "Chile", "34%", + "New Zealand", "23%", + "S. Korea", "15%", + "Israel", "13%", + "Qatar", "9%", + "Japan", "8%", + "UAE", "6%") +bubble_geo_rest <- world_inflation |> + right_join(bubble_list_rest, by = c("name" = "name_label")) |> + st_point_on_surface() + +# Argentina +bubble_arg <- tibble::tribble( + ~ name_label, ~ value_label, + "Argentina", "2,614%") +bubble_geo_arg <- world_inflation |> + right_join(bubble_arg, by = c("name" = "name_label")) |> + st_point_on_surface() + +# Türkiye +bubble_tur <- tibble::tribble( + ~ name_label, ~ value_label, + "Türkiye", "464%") +bubble_geo_tur <- world_inflation |> + right_join(bubble_tur, by = c("name" = "name_label")) |> + st_point_on_surface() + +# adjust the bubbles' position +st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "Qatar"] <- st_sfc( + st_point(c(51.2, 27.5)), crs = st_crs(bubble_geo_rest)) +st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "UAE"] <- st_sfc( + st_point(c(54, 22)), crs = st_crs(bubble_geo_rest)) +st_geometry(bubble_geo_tur)[bubble_geo_tur$name == "Türkiye"] <- st_sfc( + st_point(c(44.0, 41.0)), crs = st_crs(bubble_geo_tur)) +st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "New Zealand"] <- st_sfc( + st_point(c(160.0, -46.0)), crs = st_crs(bubble_geo_rest)) +st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "Chile"] <- st_sfc( + st_point(c(-72.0, -23.0)), crs = st_crs(bubble_geo_rest)) +st_geometry(bubble_geo_arg)[bubble_geo_arg$name == "Argentina"] <- st_sfc( + st_point(c(-60.0, -39.0)), crs = st_crs(bubble_geo_arg)) +st_geometry(bubble_geo_sea)[bubble_geo_sea$name == "Malaysia"] <- st_sfc( + st_point(c(116.0, 5.0)), crs = st_crs(bubble_geo_sea)) +st_geometry(bubble_geo_sea)[bubble_geo_sea$name == "Indonesia"] <- st_sfc( + st_point(c(106.0, -6.6)), crs = st_crs(bubble_geo_sea)) +st_geometry(bubble_geo_sea)[bubble_geo_sea$name == "Philippines"] <- st_sfc( + st_point(c(120.0, 14.6)), crs = st_crs(bubble_geo_sea)) +``` + +### Base Map + Scale + Base Countries' Bubbles - Plot1 + +```{r} +plot1 <- ggplot(world_inflation) + + # Map Layer + geom_sf(aes(fill = `5-yr cum\nchange (%)`), color = "grey70", size = 0.2) + + # The Gradient Scale on the map + scale_fill_gradientn( + colors = vc_palette, + limits = limit_range, + oob = scales::squish, + na.value = "#fffce9", + ) + + # The Gradient Bar + annotation_custom( + grob = scale_grob, + xmin = -10500000, xmax = 10500000, + ymin = 6500000, ymax = 16000000 + ) + + # bubbles rest + geom_point( + data = bubble_geo_rest, + stat = "sf_coordinates", + aes(geometry = geometry, + fill = `5-yr cum\nchange (%)`, + ), + size = 4.5, # Adjust bubble size here + color = "#fffce9", # The border of the bubble + shape = 21, # Shape 21 allows both fill and color (border) + stroke = 0.15, # Thickness of the white border + ) + + # text inside bubbles rest + geom_text( + data = bubble_geo_rest, + stat = "sf_coordinates", + aes(geometry = geometry, label = value_label), + color = "#fffce9", + size = 1.7, + fontface = "plain", + family = "poppins" + )+ + # bubble Argentina + geom_point( + data = bubble_geo_arg, + stat = "sf_coordinates", + aes(geometry = geometry, + fill = `5-yr cum\nchange (%)`), + size = 11, # Adjust bubble size here + color = "#fffce9", # The border of the bubble + shape = 21, # Shape 21 allows both fill and color (border) + stroke = 0.15, # Thickness of the white border + ) + + # text inside bubble Argentina + geom_text( + data = bubble_geo_arg, + stat = "sf_coordinates", + aes(geometry = geometry, label = value_label), + color = "#fffce9", + size = 2.5, + fontface = "plain", + family = "poppins" + )+ + # bubble Türkiye + geom_point( + data = bubble_geo_tur, + stat = "sf_coordinates", + aes(geometry = geometry, + fill = `5-yr cum\nchange (%)`), + size = 6, # Adjust bubble size here + color = "#fffce9", # The border of the bubble + shape = 21, # Shape 21 allows both fill and color (border) + stroke = 0.15, # Thickness of the white border + ) + + # text inside bubble Türkiye + geom_text( + data = bubble_geo_tur, + stat = "sf_coordinates", + aes(geometry = geometry, label = value_label), + color = "#fffce9", + size = 1.7, + fontface = "plain", + family = "poppins" + ) + + # Theme and Projection + coord_sf(crs = "+proj=robin") + # Robinson Projection + theme_void() + # Removes axes and standard grid + theme( + # Background Colors + plot.background = element_rect(fill = "#fffce9", color = NA), + panel.background = element_rect(fill = "#fffce9", color = NA), + # Legend Positioning + legend.position = "none" + ) + + # Title (the "Consumer Inflation" header) + labs(title = "Consumer Inflation", + subtitle = "2 0 2 0 - 2 0 2 5") + + theme( + plot.title = element_text( + hjust = 0.5, + face = "plain", + size = 30, + margin = margin(t = 10), + family = "Modak"), + plot.subtitle = element_text( + hjust = 0.5, + face = "bold", + size = 12, + margin = margin(t = 4, b = 70), + family = "poppins", + )) + +print(plot1) +``` + +### Country Labels and Numbers + +```{r} +country_label_base <- tibble::tribble( + ~ name_label, + "Argentina", "Türkiye", "Egypt", "Russia", "Colombia", "Chile", "Brazil", + "India", "Mexico", "S. Africa", "New Zealand", "Australia", "Canada", "S. Korea", + "Saudi Arabia", "Israel", "Qatar", "Japan", "China", "UAE", "U.S.") +country_label_geo_base <- world_inflation |> + right_join(country_label_base, by = c("name" = "name_label")) |> + st_point_on_surface() +# adjusting the position +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Argentina"] <- st_sfc( + st_point(c(-36.0, -39.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Türkiye"] <- st_sfc( + st_point(c(60.0, 41.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Egypt"] <- st_sfc( + st_point(c(17.0, 27.1)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Russia"] <- st_sfc( + st_point(c(102.0, 62.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Colombia"] <- st_sfc( + st_point(c(-90.5, 4.1)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Chile"] <- st_sfc( + st_point(c(-83.0, -23.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Brazil"] <- st_sfc( + st_point(c(-46.0, -8.4)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "India"] <- st_sfc( + st_point(c(92.0, 22.35)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Mexico"] <- st_sfc( + st_point(c(-117.0, 23.5)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "S. Africa"] <- st_sfc( + st_point(c(41.0, -29.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "New Zealand"] <- st_sfc( + st_point(c(137.0, -47.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Australia"] <- st_sfc( + st_point(c(138.0, -26.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Canada"] <- st_sfc( + st_point(c(-100.5, 56.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "S. Korea"] <- st_sfc( + st_point(c(127.0, 31.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Saudi Arabia"] <- st_sfc( + st_point(c(30.0, 19.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Israel"] <- st_sfc( + st_point(c(25.0, 34.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Qatar"] <- st_sfc( + st_point(c(62.4, 29.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "China"] <- st_sfc( + st_point(c(107.0, 35.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "Japan"] <- st_sfc( + st_point(c(155.0, 42.5)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "UAE"] <- st_sfc( + st_point(c(64.0, 21.0)), crs = st_crs(country_label_geo_base)) +st_geometry(country_label_geo_base)[country_label_geo_base$name == "U.S."] <- st_sfc( + st_point(c(-94.0, 40.0)), crs = st_crs(country_label_geo_base)) + +country_label_eu <- tibble::tribble( + ~ name_label, + "Spain", "France", "Finland", "Sweden", "Poland", "Germany", "Norway", "Hungary", "Czechia", "UK", "Italy", "Greece", "Switzerland") +country_label_geo_eu <- world_inflation |> + right_join(country_label_eu, by = c("name" = "name_label")) |> + st_point_on_surface() +# adjusting the position +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Spain"] <- st_sfc( + st_point(c(3.0, 40.5)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "France"] <- st_sfc( + st_point(c(-5.0, 46.2)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Finland"] <- st_sfc( + st_point(c(36.0, 61.0)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Sweden"] <- st_sfc( + st_point(c(17.0, 60.0)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Norway"] <- st_sfc( + st_point(c(6.0, 59.0)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Poland"] <- st_sfc( + st_point(c(26.5, 52.2)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Germany"] <- st_sfc( + st_point(c(9.5, 49.8)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Hungary"] <- st_sfc( + st_point(c(26.0, 46.0)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Czechia"] <- st_sfc( + st_point(c(25.5, 49.0)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "UK"] <- st_sfc( + st_point(c(3.0, 54.7)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Italy"] <- st_sfc( + st_point(c(8.56, 41.87)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Greece"] <- st_sfc( + st_point(c(23.0, 41.0)), crs = st_crs(country_label_geo_eu)) +st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Switzerland"] <- st_sfc( + st_point(c(8.2, 45.0)), crs = st_crs(country_label_geo_eu)) + + + +country_label_sea <- tibble::tribble( + ~ name_label, + "Philippines", "Indonesia", "Taiwan", "Malaysia", "Hong Kong", "Thailand") +country_label_geo_sea <- world_inflation |> + right_join(country_label_sea, by = c("name" = "name_label")) |> + st_point_on_surface() +# adjusting the position +st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Taiwan"] <- st_sfc( + st_point(c(130.0, 23.82)), crs = st_crs(country_label_geo_sea)) +st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Philippines"] <- st_sfc( + st_point(c(130.88, 14.0)), crs = st_crs(country_label_geo_sea)) +st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Indonesia"] <- st_sfc( + st_point(c(116.5, -6.48)), crs = st_crs(country_label_geo_sea)) +st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Malaysia"] <- st_sfc( + st_point(c(126.69, 5.0)), crs = st_crs(country_label_geo_sea)) +st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Hong Kong"] <- st_sfc( + st_point(c(114.18, 18.5)), crs = st_crs(country_label_geo_sea)) +st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Thailand"] <- st_sfc( + st_point(c(111.00, 13.5)), crs = st_crs(country_label_geo_sea)) + +number_label_base <- tibble::tribble( + ~ name_label, + "Egypt", "Russia", "Colombia", "Brazil", "India", "Mexico", "S. Africa", + "U.S.", "Australia", "Canada", "Saudi Arabia", "China") +number_label_geo_base <- world_inflation |> + right_join(number_label_base, by = c("name" = "name_label")) |> + mutate(`5-yr cum\nchange (%)` = paste0(`5-yr cum\nchange (%)`, "%")) |> + st_point_on_surface() +# adjust the position +st_geometry(number_label_geo_base)[number_label_geo_base$name == "Russia"] <- st_sfc( + st_point(c(85.0, 62.0)), crs = st_crs(number_label_geo_base)) +st_geometry(number_label_geo_base)[number_label_geo_base$name == "Brazil"] <- st_sfc( + st_point(c(-57.0, -8.4)), crs = st_crs(number_label_geo_base)) +st_geometry(number_label_geo_base)[number_label_geo_base$name == "China"] <- st_sfc( + st_point(c(96.0, 35.0)), crs = st_crs(number_label_geo_base)) +st_geometry(number_label_geo_base)[number_label_geo_base$name == "Saudi Arabia"] <- st_sfc( + st_point(c(44.57, 23.0)), crs = st_crs(number_label_geo_base)) +st_geometry(number_label_geo_base)[number_label_geo_base$name == "U.S."] <- st_sfc( + st_point(c(-105.0, 40.0)), crs = st_crs(number_label_geo_base)) +st_geometry(number_label_geo_base)[number_label_geo_base$name == "Canada"] <- st_sfc( + st_point(c(-116.0, 56.0)), crs = st_crs(number_label_geo_base)) +st_geometry(number_label_geo_base)[number_label_geo_base$name == "Australia"] <- st_sfc( + st_point(c(123.0, -26.0)), crs = st_crs(number_label_geo_base)) + +number_label_eu <- tibble::tribble( + ~ name_label, + "Spain", "France", "Finland", "Sweden", "Poland", "Germany", "Norway") +number_label_geo_eu <- world_inflation |> + right_join(number_label_eu, by = c("name" = "name_label")) |> + mutate(`5-yr cum\nchange (%)` = paste0(`5-yr cum\nchange (%)`, "%")) |> + st_point_on_surface() +# adjust the position +st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Gremany"] <- st_sfc( + st_point(c(10.0, 60.0)), crs = st_crs(number_label_geo_eu)) +st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Norway"] <- st_sfc( + st_point(c(8.5, 61.0)), crs = st_crs(number_label_geo_eu)) +st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Finland"] <- st_sfc( + st_point(c(26.0, 62.0)), crs = st_crs(number_label_geo_eu)) +st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Poland"] <- st_sfc( + st_point(c(19.14, 53.0)), crs = st_crs(number_label_geo_eu)) +``` + +### plot1(base plot) + Country Labels and Numbers - plot2 + +```{r} +plot2 <- plot1 + + # country names + geom_text( + data = country_label_geo_base, + stat = "sf_coordinates", + aes(geometry = geometry, label = name), + color = "#333333", + size = 2, # Adjust text size + fontface = "bold", # "plain", "bold", "italic" + family = "roboto", + inherit.aes = FALSE + ) + + # number labels + geom_text( + data = number_label_geo_base, + stat = "sf_coordinates", + aes(geometry = geometry, label = `5-yr cum\nchange (%)`), + color = "#fffce9", + size = 1.6, # Adjust text size + fontface = "plain", # "plain", "bold", "italic" + family = "poppins", + inherit.aes = FALSE + ) +print(plot2) +``` + +### Magnified EU and SEA and the Bubbles in the Lenses + +build the magnifying function and add the bubble + number + country name layer + +```{r} +sf_use_s2(FALSE) + +create_lens_eu <- function(data, bubble_data, center_lon, center_lat, radius_km) { + + # A. PRE-CROP: Cut the map to a rough square box first. + # This prevents "global wrapping" errors that cause the solid purple circle. + # We create a bounding box +/- 25 degrees around the center. + buff <- 25 + bbox <- st_bbox(c(xmin = center_lon - buff, xmax = center_lon + buff, + ymin = center_lat - buff, ymax = center_lat + buff), + crs = st_crs(data)) + + # Suppress warnings for the crop + data_cropped <- suppressWarnings(st_crop(data, bbox)) + + # define projection (Azimuthal Equidistant) + lens_crs <- paste0("+proj=aeqd +lat_0=", center_lat, " +lon_0=", center_lon) + + # create circle + center_pt <- st_sfc(st_point(c(center_lon, center_lat)), crs = 4326) + center_pt_proj <- st_transform(center_pt, lens_crs) + circle_border <- st_buffer(center_pt_proj, dist = radius_km * 1000) + data_proj <- st_transform(data_cropped, lens_crs) + data_proj <- st_make_valid(data_proj) + lens_data <- st_intersection(data_proj, circle_border) + lens_data <- st_collection_extract(lens_data, "POLYGON") + + # Process Bubble Data (Transform -> Clip) + bubbles_proj_eu <- st_transform(bubble_geo_eu, lens_crs) + lens_bubbles_eu <- st_intersection(bubbles_proj_eu, circle_border) + + # Create Plot + ggplot() + + # Background (Beige) + geom_sf(data = circle_border, fill = "#fffce9", color = NA) + + # Map Data : + geom_sf(data = lens_data, + aes(fill = `5-yr cum\nchange (%)`), + color = "grey70", size = 0.25) + + # bubbles + geom_point( + data = bubble_geo_eu, + stat = "sf_coordinates", + aes(geometry = geometry, + fill = `5-yr cum\nchange (%)`), + size = 4.5, # Adjust bubble size here + color = "#fffce9", # The border of the bubble + shape = 21, # Shape 21 allows both fill and color (border) + stroke = 0.15 # Thickness of the white border + ) + + # numbers inside bubbles + geom_text( + data = bubble_geo_eu, + stat = "sf_coordinates", + aes(geometry = geometry, label = value_label), + color = "#fffce9", + size = 1.5, + fontface = "plain", + family = "poppins", + ) + + # country labels + geom_text( + data = country_label_geo_eu, + stat = "sf_coordinates", + aes(geometry = geometry, label = name), + color = "#333333", + size = 1.6, + fontface = "bold", + family = "poppins", + ) + + # number labels + geom_text( + data = number_label_geo_eu, + stat = "sf_coordinates", + aes(geometry = geometry, label = `5-yr cum\nchange (%)`), + color = "#fffce9", + size = 1.6, + fontface = "plain", + family = "poppins", + ) + + # Scale + scale_fill_gradientn( + colors = vc_palette, + limits = limit_range, + oob = scales::squish, + na.value = "#fffce9" + ) + + # Border + geom_sf(data = circle_border, fill = NA, color = "grey50", linewidth = 0.1) + + # Theme + coord_sf(datum = NA) + + theme_void() + + theme(legend.position = "none" + ) +} + +create_lens_sea <- function(data, bubble_data, center_lon, center_lat, radius_km) { + + # A. PRE-CROP: Cut the map to a rough square box first. + # This prevents "global wrapping" errors that cause the solid purple circle. + # We create a bounding box +/- 25 degrees around the center. + buff <- 25 + bbox <- st_bbox(c(xmin = center_lon - buff, xmax = center_lon + buff, + ymin = center_lat - buff, ymax = center_lat + buff), + crs = st_crs(data)) + + # Suppress warnings for the crop + data_cropped <- suppressWarnings(st_crop(data, bbox)) + + # define projection (Azimuthal Equidistant) + lens_crs <- paste0("+proj=aeqd +lat_0=", center_lat, " +lon_0=", center_lon) + + # create circle + center_pt <- st_sfc(st_point(c(center_lon, center_lat)), crs = 4326) + center_pt_proj <- st_transform(center_pt, lens_crs) + circle_border <- st_buffer(center_pt_proj, dist = radius_km * 1000) + data_proj <- st_transform(data_cropped, lens_crs) + data_proj <- st_make_valid(data_proj) + lens_data <- st_intersection(data_proj, circle_border) + lens_data <- st_collection_extract(lens_data, "POLYGON") + + # Process Bubble Data (Transform -> Clip) + bubbles_proj_sea <- st_transform(bubble_geo_sea, lens_crs) + lens_bubbles_sea <- st_intersection(bubbles_proj_sea, circle_border) + + # Create Plot + ggplot() + + # Background (Beige) + geom_sf(data = circle_border, fill = "#fffce9", color = NA) + + # Map Data : + geom_sf(data = lens_data, + aes(fill = `5-yr cum\nchange (%)`), + color = "grey70", size = 0.25) + + # bubbles + geom_point( + data = bubble_geo_sea, + stat = "sf_coordinates", + aes(geometry = geometry, + fill = `5-yr cum\nchange (%)`), + size = 4.5, # Adjust bubble size here + color = "#fffce9", # The border of the bubble + shape = 21, # Shape 21 allows both fill and color (border) + stroke = 0.15 # Thickness of the white border + ) + + # text inside bubbles + geom_text( + data = bubble_geo_sea, + stat = "sf_coordinates", + aes(geometry = geometry, label = value_label), + color = "#fffce9", + size = 1.5, + fontface = "plain", + family = "poppins" + ) + + # country labels + geom_text( + data = country_label_geo_sea, + stat = "sf_coordinates", + aes(geometry = geometry, label = name), + color = "#333333", + size = 1.6, + fontface = "bold", + family = "poppins" + ) + + # Scale + scale_fill_gradientn( + colors = vc_palette, + limits = limit_range, + oob = scales::squish, + na.value = "#fffce9" + ) + + # Border + geom_sf(data = circle_border, fill = NA, color = "grey50", linewidth = 0.2) + + # Theme + coord_sf(datum = NA) + + theme_void() + + theme(legend.position = "none" + ) +} +``` + +```{r} +p_lens_eu <- create_lens_eu( + data = world_inflation, + bubble_data = bubble_geo_eu, + center_lon = 7, # 7 + center_lat = 50, # 49 + radius_km = 2000 +) +p_lens_sea <- create_lens_sea( + data = world_inflation, + bubble_data = bubble_geo_sea, + center_lon = 113, + center_lat = 9, + radius_km = 2200 +) +``` + +### plot2 + the Magnifying Lenses - plot3 + +```{r} +plot_3 <- ggdraw(plot2) + + draw_plot(p_lens_eu, x = -0.045, y = 0.375, width = 1, height = 0.3, scale = 1.25) + + draw_plot(p_lens_sea, x = 0.27, y = 0.14, width = 1, height = 0.3, scale = 0.8) +print(plot_3) +``` + +### plot3 + the Texts and Arrows - final_plot + +```{r} +texts <- tibble(label = c( + "Consumer Inflation Cumulative\nChange, 2020-2025", + "President Milei's fiscal\noverhaul has lowered\nArgentina's annualized\ninflation rate to 21%\nas of June 2025.", + "Post-pandemic inflation\ndidn't hit Asia as hard\nas it hit Europe."), + x = c(0.24, 0.43, 0.65), + y = c(0.797, 0.16, 0.16), + hjust = c(0, 0, 0), + size = c(2, 1.5, 1.3), + font = "poppins", + fontface = c("bold", "italic", "italic"), + color = c("#333333", "#D86C7B", "#6b9bd1") +) + +final_plot <- plot_3 + + geom_text( + data = texts, + aes(x = x, y = y, label = label, hjust = hjust), + color = texts$color, + size = texts$size, + fontface = texts$fontface, + family = "poppins", + lineheight = 0.9, + inherit.aes = FALSE # Essential to ignore map data + ) + + geom_curve( + aes(x = 0.425, y = 0.18, xend = 0.40, yend = 0.13), + curvature = 0.3, # Negative = Curves Right (concave down) + color = "#D86C7B", + size = 0.3, + arrow = arrow(length = unit(0.01, "npc"), type = "closed"), + inherit.aes = FALSE + ) + + geom_curve( + aes(x = 0.69, y = 0.19, xend = 0.717, yend = 0.24), + curvature = -0.3, # Negative = Curves Right (looks best for this angle) + color = "#6b9bd1", + size = 0.3, + arrow = arrow(length = unit(0.01, "npc"), type = "closed"), + inherit.aes = FALSE + ) + +print(final_plot) +``` diff --git a/_projects/2025/100536001/100536001.html b/_projects/2025/100536001/100536001.html new file mode 100644 index 00000000..f6982c42 --- /dev/null +++ b/_projects/2025/100536001/100536001.html @@ -0,0 +1,2340 @@ + + + + +
+ + + + + + + + + + + + + + + +I have choose the graph from Visual Capitalist, “Consumer Inflation from 2020 to 2025”. The dataset is from Deutsche Bank, record consumer inflation from 2020 to June 2025.
+
+
+# import data
+inflation2025 <- read_csv("global inflation 2025_Deutsche Bank - Sheet1.csv")
+
+# clean data
+cum_inflation_2025 <- inflation2025 |>
+ select(-`cum change since 2012 (%)`,
+ -`cum change since 2020 (%)`,
+ -`Rank based on change from 2012 Economy`) |>
+ mutate(Economy = case_when(Economy == "United States" ~ "United States of America",
+ Economy == "Czech Republic" ~ "Czechia",
+ TRUE ~ Economy))
+
+# sf data object
+world_map <- ne_countries(scale = "medium", returnclass = "sf") |>
+ filter(admin != "Antarctica")
+world_inflation <- world_map |>
+ left_join(cum_inflation_2025, by = c("name" = "Economy")) |>
+ # change names that are shown/not shown on the map
+ mutate(name = case_when(name == "South Africa" ~ "S. Africa",
+ name == "Turkey" ~ "Türkiye",
+ name == "United Kingdom" ~ "UK",
+ name == "South Korea" ~ "S. Korea",
+ name == "United Arab Emirates" ~ "UAE",
+ name == "United States of America" ~ "U.S.",
+ name %in% c(
+ "Austria", "Netherlands", "Belgium",
+ "Luxembourg", "Portugal", "Singapore",
+ "Denmark", "Ireland") ~ "",
+ TRUE ~ name))
+font_add_google("Poppins", "poppins")
+font_add(family = "Modak",
+ regular = "/Users/karlazhong/Library/Fonts/Modak-Regular.ttf")
+showtext_auto()
+# bar legend
+vc_palette <- c("#53a6e8", "#6b9bd1", "#7B95C5","#8a8eb8", "#9B88AC","#ab809f", "#B87993","#c87284", "#D86C7B","#e56569", "#B0022A")
+limit_range <- c(0, 55)
+legend_data <- data.frame(x = seq(limit_range[1], limit_range[2], length.out = 500))
+legend_data$y_height <- 0.2 + (legend_data$x / 50) * 2
+
+legend_plot <- ggplot(legend_data) +
+ geom_segment(aes(x = x, xend = x, y = 0, yend = y_height, color = x), linewidth = 1) +
+ scale_color_gradientn(
+ colors = vc_palette,
+ limits = limit_range,
+ oob = scales::squish,
+ ) +
+ annotate("text", x = 1, y = -1, label = "0%", size = 2.5, fontface = "bold", color = "#333333") +
+ annotate("text", x = 10, y = -1, label = "10%", size = 2.5, fontface = "bold", color = "#333333") +
+ annotate("text", x = 20, y = -1, label = "20%", size = 2.5, fontface = "bold", color = "#333333") +
+ annotate("text", x = 30, y = -1, label = "30%", size = 2.5, fontface = "bold", color = "#333333") +
+ annotate("text", x = 40, y = -1, label = "40%", size = 2.5, fontface = "bold", color = "#333333") +
+ annotate("text", x = 50, y = -1, label = "50%", size = 2.5, fontface = "bold", color = "#333333") +
+ annotate("segment", x = 0, xend = 0, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 5, xend = 5, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 10, xend = 10, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 15, xend = 15, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 20, xend = 20, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 25, xend = 25, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 30, xend = 30, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 35, xend = 35, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 40, xend = 40, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 45, xend = 45, y = 0, yend = -0.3, color = "#333333") +
+ annotate("segment", x = 50, xend = 50, y = 0, yend = -0.3, color = "#333333") +
+ ylim(-1, 4) +
+ xlim(10, 60) +
+ scale_y_continuous(expand = c(0, 0), limits = c(-5, 4)) +
+ scale_x_continuous(expand = c(0, 0)) +
+ theme_void() +
+ theme(legend.position = "none")
+
+scale_grob <- ggplotGrob(legend_plot)
+# inside the lens
+bubble_list_eu <- tibble::tribble(
+ ~name_label, ~value_label,
+ "Hungary", "52%",
+ "Czechia", "41%",
+ "UK", "24%",
+ "Italy", "18%",
+ "Greece", "16%",
+ "Switzerland", "6%")
+bubble_list_sea <- tibble::tribble(
+ ~name_label, ~value_label,
+ "Philippines", "24%",
+ "Indonesia", "14%",
+ "Taiwan", "10%",
+ "Malaysia", "9%",
+ "Hong Kong", "8%",
+ "Thailand", "8%")
+bubble_geo_eu <- world_inflation |>
+ right_join(bubble_list_eu, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+bubble_geo_sea <- world_inflation |>
+ right_join(bubble_list_sea, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+
+# adjust bubble position
+row_greece <- which(bubble_geo_eu$name_label == "Greece")
+new_grc_coords <- st_point(c(21.65, 40.25))
+bubble_geo_eu$geometry[row_greece] <- st_sfc(new_grc_coords) |>
+ st_set_crs(st_crs(bubble_geo_eu))
+st_geometry(bubble_geo_eu)[bubble_geo_eu$name == "Czechia"] <- st_sfc(
+ st_point(c(18.0, 50.0)), crs = st_crs(bubble_geo_eu))
+
+# outside of the lens
+bubble_list_rest <- tibble::tribble(
+ ~name_label, ~value_label,
+ "Chile", "34%",
+ "New Zealand", "23%",
+ "S. Korea", "15%",
+ "Israel", "13%",
+ "Qatar", "9%",
+ "Japan", "8%",
+ "UAE", "6%")
+bubble_geo_rest <- world_inflation |>
+ right_join(bubble_list_rest, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+
+# Argentina
+bubble_arg <- tibble::tribble(
+ ~ name_label, ~ value_label,
+ "Argentina", "2,614%")
+bubble_geo_arg <- world_inflation |>
+ right_join(bubble_arg, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+
+# Türkiye
+bubble_tur <- tibble::tribble(
+ ~ name_label, ~ value_label,
+ "Türkiye", "464%")
+bubble_geo_tur <- world_inflation |>
+ right_join(bubble_tur, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+
+# adjust the bubbles' position
+st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "Qatar"] <- st_sfc(
+ st_point(c(51.2, 27.5)), crs = st_crs(bubble_geo_rest))
+st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "UAE"] <- st_sfc(
+ st_point(c(54, 22)), crs = st_crs(bubble_geo_rest))
+st_geometry(bubble_geo_tur)[bubble_geo_tur$name == "Türkiye"] <- st_sfc(
+ st_point(c(44.0, 41.0)), crs = st_crs(bubble_geo_tur))
+st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "New Zealand"] <- st_sfc(
+ st_point(c(160.0, -46.0)), crs = st_crs(bubble_geo_rest))
+st_geometry(bubble_geo_rest)[bubble_geo_rest$name == "Chile"] <- st_sfc(
+ st_point(c(-72.0, -23.0)), crs = st_crs(bubble_geo_rest))
+st_geometry(bubble_geo_arg)[bubble_geo_arg$name == "Argentina"] <- st_sfc(
+ st_point(c(-60.0, -39.0)), crs = st_crs(bubble_geo_arg))
+st_geometry(bubble_geo_sea)[bubble_geo_sea$name == "Malaysia"] <- st_sfc(
+ st_point(c(116.0, 5.0)), crs = st_crs(bubble_geo_sea))
+st_geometry(bubble_geo_sea)[bubble_geo_sea$name == "Indonesia"] <- st_sfc(
+ st_point(c(106.0, -6.6)), crs = st_crs(bubble_geo_sea))
+st_geometry(bubble_geo_sea)[bubble_geo_sea$name == "Philippines"] <- st_sfc(
+ st_point(c(120.0, 14.6)), crs = st_crs(bubble_geo_sea))
+plot1 <- ggplot(world_inflation) +
+ # Map Layer
+ geom_sf(aes(fill = `5-yr cum\nchange (%)`), color = "grey70", size = 0.2) +
+ # The Gradient Scale on the map
+ scale_fill_gradientn(
+ colors = vc_palette,
+ limits = limit_range,
+ oob = scales::squish,
+ na.value = "#fffce9",
+ ) +
+ # The Gradient Bar
+ annotation_custom(
+ grob = scale_grob,
+ xmin = -10500000, xmax = 10500000,
+ ymin = 6500000, ymax = 16000000
+ ) +
+ # bubbles rest
+ geom_point(
+ data = bubble_geo_rest,
+ stat = "sf_coordinates",
+ aes(geometry = geometry,
+ fill = `5-yr cum\nchange (%)`,
+ ),
+ size = 4.5, # Adjust bubble size here
+ color = "#fffce9", # The border of the bubble
+ shape = 21, # Shape 21 allows both fill and color (border)
+ stroke = 0.15, # Thickness of the white border
+ ) +
+ # text inside bubbles rest
+ geom_text(
+ data = bubble_geo_rest,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = value_label),
+ color = "#fffce9",
+ size = 1.7,
+ fontface = "plain",
+ family = "poppins"
+ )+
+ # bubble Argentina
+ geom_point(
+ data = bubble_geo_arg,
+ stat = "sf_coordinates",
+ aes(geometry = geometry,
+ fill = `5-yr cum\nchange (%)`),
+ size = 11, # Adjust bubble size here
+ color = "#fffce9", # The border of the bubble
+ shape = 21, # Shape 21 allows both fill and color (border)
+ stroke = 0.15, # Thickness of the white border
+ ) +
+ # text inside bubble Argentina
+ geom_text(
+ data = bubble_geo_arg,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = value_label),
+ color = "#fffce9",
+ size = 2.5,
+ fontface = "plain",
+ family = "poppins"
+ )+
+ # bubble Türkiye
+ geom_point(
+ data = bubble_geo_tur,
+ stat = "sf_coordinates",
+ aes(geometry = geometry,
+ fill = `5-yr cum\nchange (%)`),
+ size = 6, # Adjust bubble size here
+ color = "#fffce9", # The border of the bubble
+ shape = 21, # Shape 21 allows both fill and color (border)
+ stroke = 0.15, # Thickness of the white border
+ ) +
+ # text inside bubble Türkiye
+ geom_text(
+ data = bubble_geo_tur,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = value_label),
+ color = "#fffce9",
+ size = 1.7,
+ fontface = "plain",
+ family = "poppins"
+ ) +
+ # Theme and Projection
+ coord_sf(crs = "+proj=robin") + # Robinson Projection
+ theme_void() + # Removes axes and standard grid
+ theme(
+ # Background Colors
+ plot.background = element_rect(fill = "#fffce9", color = NA),
+ panel.background = element_rect(fill = "#fffce9", color = NA),
+ # Legend Positioning
+ legend.position = "none"
+ ) +
+ # Title (the "Consumer Inflation" header)
+ labs(title = "Consumer Inflation",
+ subtitle = "2 0 2 0 - 2 0 2 5") +
+ theme(
+ plot.title = element_text(
+ hjust = 0.5,
+ face = "plain",
+ size = 30,
+ margin = margin(t = 10),
+ family = "Modak"),
+ plot.subtitle = element_text(
+ hjust = 0.5,
+ face = "bold",
+ size = 12,
+ margin = margin(t = 4, b = 70),
+ family = "poppins",
+ ))
+
+print(plot1)
+
country_label_base <- tibble::tribble(
+ ~ name_label,
+ "Argentina", "Türkiye", "Egypt", "Russia", "Colombia", "Chile", "Brazil",
+ "India", "Mexico", "S. Africa", "New Zealand", "Australia", "Canada", "S. Korea",
+ "Saudi Arabia", "Israel", "Qatar", "Japan", "China", "UAE", "U.S.")
+country_label_geo_base <- world_inflation |>
+ right_join(country_label_base, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+# adjusting the position
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Argentina"] <- st_sfc(
+ st_point(c(-36.0, -39.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Türkiye"] <- st_sfc(
+ st_point(c(60.0, 41.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Egypt"] <- st_sfc(
+ st_point(c(17.0, 27.1)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Russia"] <- st_sfc(
+ st_point(c(102.0, 62.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Colombia"] <- st_sfc(
+ st_point(c(-90.5, 4.1)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Chile"] <- st_sfc(
+ st_point(c(-83.0, -23.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Brazil"] <- st_sfc(
+ st_point(c(-46.0, -8.4)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "India"] <- st_sfc(
+ st_point(c(92.0, 22.35)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Mexico"] <- st_sfc(
+ st_point(c(-117.0, 23.5)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "S. Africa"] <- st_sfc(
+ st_point(c(41.0, -29.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "New Zealand"] <- st_sfc(
+ st_point(c(137.0, -47.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Australia"] <- st_sfc(
+ st_point(c(138.0, -26.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Canada"] <- st_sfc(
+ st_point(c(-100.5, 56.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "S. Korea"] <- st_sfc(
+ st_point(c(127.0, 31.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Saudi Arabia"] <- st_sfc(
+ st_point(c(30.0, 19.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Israel"] <- st_sfc(
+ st_point(c(25.0, 34.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Qatar"] <- st_sfc(
+ st_point(c(62.4, 29.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "China"] <- st_sfc(
+ st_point(c(107.0, 35.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "Japan"] <- st_sfc(
+ st_point(c(155.0, 42.5)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "UAE"] <- st_sfc(
+ st_point(c(64.0, 21.0)), crs = st_crs(country_label_geo_base))
+st_geometry(country_label_geo_base)[country_label_geo_base$name == "U.S."] <- st_sfc(
+ st_point(c(-94.0, 40.0)), crs = st_crs(country_label_geo_base))
+
+country_label_eu <- tibble::tribble(
+ ~ name_label,
+ "Spain", "France", "Finland", "Sweden", "Poland", "Germany", "Norway", "Hungary", "Czechia", "UK", "Italy", "Greece", "Switzerland")
+country_label_geo_eu <- world_inflation |>
+ right_join(country_label_eu, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+# adjusting the position
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Spain"] <- st_sfc(
+ st_point(c(3.0, 40.5)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "France"] <- st_sfc(
+ st_point(c(-5.0, 46.2)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Finland"] <- st_sfc(
+ st_point(c(36.0, 61.0)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Sweden"] <- st_sfc(
+ st_point(c(17.0, 60.0)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Norway"] <- st_sfc(
+ st_point(c(6.0, 59.0)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Poland"] <- st_sfc(
+ st_point(c(26.5, 52.2)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Germany"] <- st_sfc(
+ st_point(c(9.5, 49.8)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Hungary"] <- st_sfc(
+ st_point(c(26.0, 46.0)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Czechia"] <- st_sfc(
+ st_point(c(25.5, 49.0)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "UK"] <- st_sfc(
+ st_point(c(3.0, 54.7)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Italy"] <- st_sfc(
+ st_point(c(8.56, 41.87)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Greece"] <- st_sfc(
+ st_point(c(23.0, 41.0)), crs = st_crs(country_label_geo_eu))
+st_geometry(country_label_geo_eu)[country_label_geo_eu$name == "Switzerland"] <- st_sfc(
+ st_point(c(8.2, 45.0)), crs = st_crs(country_label_geo_eu))
+
+
+
+country_label_sea <- tibble::tribble(
+ ~ name_label,
+ "Philippines", "Indonesia", "Taiwan", "Malaysia", "Hong Kong", "Thailand")
+country_label_geo_sea <- world_inflation |>
+ right_join(country_label_sea, by = c("name" = "name_label")) |>
+ st_point_on_surface()
+# adjusting the position
+st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Taiwan"] <- st_sfc(
+ st_point(c(130.0, 23.82)), crs = st_crs(country_label_geo_sea))
+st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Philippines"] <- st_sfc(
+ st_point(c(130.88, 14.0)), crs = st_crs(country_label_geo_sea))
+st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Indonesia"] <- st_sfc(
+ st_point(c(116.5, -6.48)), crs = st_crs(country_label_geo_sea))
+st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Malaysia"] <- st_sfc(
+ st_point(c(126.69, 5.0)), crs = st_crs(country_label_geo_sea))
+st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Hong Kong"] <- st_sfc(
+ st_point(c(114.18, 18.5)), crs = st_crs(country_label_geo_sea))
+st_geometry(country_label_geo_sea)[country_label_geo_sea$name == "Thailand"] <- st_sfc(
+ st_point(c(111.00, 13.5)), crs = st_crs(country_label_geo_sea))
+
+number_label_base <- tibble::tribble(
+ ~ name_label,
+ "Egypt", "Russia", "Colombia", "Brazil", "India", "Mexico", "S. Africa",
+ "U.S.", "Australia", "Canada", "Saudi Arabia", "China")
+number_label_geo_base <- world_inflation |>
+ right_join(number_label_base, by = c("name" = "name_label")) |>
+ mutate(`5-yr cum\nchange (%)` = paste0(`5-yr cum\nchange (%)`, "%")) |>
+ st_point_on_surface()
+# adjust the position
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "Russia"] <- st_sfc(
+ st_point(c(85.0, 62.0)), crs = st_crs(number_label_geo_base))
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "Brazil"] <- st_sfc(
+ st_point(c(-57.0, -8.4)), crs = st_crs(number_label_geo_base))
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "China"] <- st_sfc(
+ st_point(c(96.0, 35.0)), crs = st_crs(number_label_geo_base))
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "Saudi Arabia"] <- st_sfc(
+ st_point(c(44.57, 23.0)), crs = st_crs(number_label_geo_base))
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "U.S."] <- st_sfc(
+ st_point(c(-105.0, 40.0)), crs = st_crs(number_label_geo_base))
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "Canada"] <- st_sfc(
+ st_point(c(-116.0, 56.0)), crs = st_crs(number_label_geo_base))
+st_geometry(number_label_geo_base)[number_label_geo_base$name == "Australia"] <- st_sfc(
+ st_point(c(123.0, -26.0)), crs = st_crs(number_label_geo_base))
+
+number_label_eu <- tibble::tribble(
+ ~ name_label,
+ "Spain", "France", "Finland", "Sweden", "Poland", "Germany", "Norway")
+number_label_geo_eu <- world_inflation |>
+ right_join(number_label_eu, by = c("name" = "name_label")) |>
+ mutate(`5-yr cum\nchange (%)` = paste0(`5-yr cum\nchange (%)`, "%")) |>
+ st_point_on_surface()
+# adjust the position
+st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Gremany"] <- st_sfc(
+ st_point(c(10.0, 60.0)), crs = st_crs(number_label_geo_eu))
+st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Norway"] <- st_sfc(
+ st_point(c(8.5, 61.0)), crs = st_crs(number_label_geo_eu))
+st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Finland"] <- st_sfc(
+ st_point(c(26.0, 62.0)), crs = st_crs(number_label_geo_eu))
+st_geometry(number_label_geo_eu)[number_label_geo_eu$name == "Poland"] <- st_sfc(
+ st_point(c(19.14, 53.0)), crs = st_crs(number_label_geo_eu))
+plot2 <- plot1 +
+ # country names
+ geom_text(
+ data = country_label_geo_base,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = name),
+ color = "#333333",
+ size = 2, # Adjust text size
+ fontface = "bold", # "plain", "bold", "italic"
+ family = "roboto",
+ inherit.aes = FALSE
+ ) +
+ # number labels
+ geom_text(
+ data = number_label_geo_base,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = `5-yr cum\nchange (%)`),
+ color = "#fffce9",
+ size = 1.6, # Adjust text size
+ fontface = "plain", # "plain", "bold", "italic"
+ family = "poppins",
+ inherit.aes = FALSE
+ )
+print(plot2)
+
build the magnifying function and add the bubble + number + country name layer
+sf_use_s2(FALSE)
+
+create_lens_eu <- function(data, bubble_data, center_lon, center_lat, radius_km) {
+
+ # A. PRE-CROP: Cut the map to a rough square box first.
+ # This prevents "global wrapping" errors that cause the solid purple circle.
+ # We create a bounding box +/- 25 degrees around the center.
+ buff <- 25
+ bbox <- st_bbox(c(xmin = center_lon - buff, xmax = center_lon + buff,
+ ymin = center_lat - buff, ymax = center_lat + buff),
+ crs = st_crs(data))
+
+ # Suppress warnings for the crop
+ data_cropped <- suppressWarnings(st_crop(data, bbox))
+
+ # define projection (Azimuthal Equidistant)
+ lens_crs <- paste0("+proj=aeqd +lat_0=", center_lat, " +lon_0=", center_lon)
+
+ # create circle
+ center_pt <- st_sfc(st_point(c(center_lon, center_lat)), crs = 4326)
+ center_pt_proj <- st_transform(center_pt, lens_crs)
+ circle_border <- st_buffer(center_pt_proj, dist = radius_km * 1000)
+ data_proj <- st_transform(data_cropped, lens_crs)
+ data_proj <- st_make_valid(data_proj)
+ lens_data <- st_intersection(data_proj, circle_border)
+ lens_data <- st_collection_extract(lens_data, "POLYGON")
+
+ # Process Bubble Data (Transform -> Clip)
+ bubbles_proj_eu <- st_transform(bubble_geo_eu, lens_crs)
+ lens_bubbles_eu <- st_intersection(bubbles_proj_eu, circle_border)
+
+ # Create Plot
+ ggplot() +
+ # Background (Beige)
+ geom_sf(data = circle_border, fill = "#fffce9", color = NA) +
+ # Map Data :
+ geom_sf(data = lens_data,
+ aes(fill = `5-yr cum\nchange (%)`),
+ color = "grey70", size = 0.25) +
+ # bubbles
+ geom_point(
+ data = bubble_geo_eu,
+ stat = "sf_coordinates",
+ aes(geometry = geometry,
+ fill = `5-yr cum\nchange (%)`),
+ size = 4.5, # Adjust bubble size here
+ color = "#fffce9", # The border of the bubble
+ shape = 21, # Shape 21 allows both fill and color (border)
+ stroke = 0.15 # Thickness of the white border
+ ) +
+ # numbers inside bubbles
+ geom_text(
+ data = bubble_geo_eu,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = value_label),
+ color = "#fffce9",
+ size = 1.5,
+ fontface = "plain",
+ family = "poppins",
+ ) +
+ # country labels
+ geom_text(
+ data = country_label_geo_eu,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = name),
+ color = "#333333",
+ size = 1.6,
+ fontface = "bold",
+ family = "poppins",
+ ) +
+ # number labels
+ geom_text(
+ data = number_label_geo_eu,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = `5-yr cum\nchange (%)`),
+ color = "#fffce9",
+ size = 1.6,
+ fontface = "plain",
+ family = "poppins",
+ ) +
+ # Scale
+ scale_fill_gradientn(
+ colors = vc_palette,
+ limits = limit_range,
+ oob = scales::squish,
+ na.value = "#fffce9"
+ ) +
+ # Border
+ geom_sf(data = circle_border, fill = NA, color = "grey50", linewidth = 0.1) +
+ # Theme
+ coord_sf(datum = NA) +
+ theme_void() +
+ theme(legend.position = "none"
+ )
+}
+
+create_lens_sea <- function(data, bubble_data, center_lon, center_lat, radius_km) {
+
+ # A. PRE-CROP: Cut the map to a rough square box first.
+ # This prevents "global wrapping" errors that cause the solid purple circle.
+ # We create a bounding box +/- 25 degrees around the center.
+ buff <- 25
+ bbox <- st_bbox(c(xmin = center_lon - buff, xmax = center_lon + buff,
+ ymin = center_lat - buff, ymax = center_lat + buff),
+ crs = st_crs(data))
+
+ # Suppress warnings for the crop
+ data_cropped <- suppressWarnings(st_crop(data, bbox))
+
+ # define projection (Azimuthal Equidistant)
+ lens_crs <- paste0("+proj=aeqd +lat_0=", center_lat, " +lon_0=", center_lon)
+
+ # create circle
+ center_pt <- st_sfc(st_point(c(center_lon, center_lat)), crs = 4326)
+ center_pt_proj <- st_transform(center_pt, lens_crs)
+ circle_border <- st_buffer(center_pt_proj, dist = radius_km * 1000)
+ data_proj <- st_transform(data_cropped, lens_crs)
+ data_proj <- st_make_valid(data_proj)
+ lens_data <- st_intersection(data_proj, circle_border)
+ lens_data <- st_collection_extract(lens_data, "POLYGON")
+
+ # Process Bubble Data (Transform -> Clip)
+ bubbles_proj_sea <- st_transform(bubble_geo_sea, lens_crs)
+ lens_bubbles_sea <- st_intersection(bubbles_proj_sea, circle_border)
+
+ # Create Plot
+ ggplot() +
+ # Background (Beige)
+ geom_sf(data = circle_border, fill = "#fffce9", color = NA) +
+ # Map Data :
+ geom_sf(data = lens_data,
+ aes(fill = `5-yr cum\nchange (%)`),
+ color = "grey70", size = 0.25) +
+ # bubbles
+ geom_point(
+ data = bubble_geo_sea,
+ stat = "sf_coordinates",
+ aes(geometry = geometry,
+ fill = `5-yr cum\nchange (%)`),
+ size = 4.5, # Adjust bubble size here
+ color = "#fffce9", # The border of the bubble
+ shape = 21, # Shape 21 allows both fill and color (border)
+ stroke = 0.15 # Thickness of the white border
+ ) +
+ # text inside bubbles
+ geom_text(
+ data = bubble_geo_sea,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = value_label),
+ color = "#fffce9",
+ size = 1.5,
+ fontface = "plain",
+ family = "poppins"
+ ) +
+ # country labels
+ geom_text(
+ data = country_label_geo_sea,
+ stat = "sf_coordinates",
+ aes(geometry = geometry, label = name),
+ color = "#333333",
+ size = 1.6,
+ fontface = "bold",
+ family = "poppins"
+ ) +
+ # Scale
+ scale_fill_gradientn(
+ colors = vc_palette,
+ limits = limit_range,
+ oob = scales::squish,
+ na.value = "#fffce9"
+ ) +
+ # Border
+ geom_sf(data = circle_border, fill = NA, color = "grey50", linewidth = 0.2) +
+ # Theme
+ coord_sf(datum = NA) +
+ theme_void() +
+ theme(legend.position = "none"
+ )
+}
+p_lens_eu <- create_lens_eu(
+ data = world_inflation,
+ bubble_data = bubble_geo_eu,
+ center_lon = 7, # 7
+ center_lat = 50, # 49
+ radius_km = 2000
+)
+p_lens_sea <- create_lens_sea(
+ data = world_inflation,
+ bubble_data = bubble_geo_sea,
+ center_lon = 113,
+ center_lat = 9,
+ radius_km = 2200
+)
+plot_3 <- ggdraw(plot2) +
+ draw_plot(p_lens_eu, x = -0.045, y = 0.375, width = 1, height = 0.3, scale = 1.25) +
+ draw_plot(p_lens_sea, x = 0.27, y = 0.14, width = 1, height = 0.3, scale = 0.8)
+print(plot_3)
+
texts <- tibble(label = c(
+ "Consumer Inflation Cumulative\nChange, 2020-2025",
+ "President Milei's fiscal\noverhaul has lowered\nArgentina's annualized\ninflation rate to 21%\nas of June 2025.",
+ "Post-pandemic inflation\ndidn't hit Asia as hard\nas it hit Europe."),
+ x = c(0.24, 0.43, 0.65),
+ y = c(0.797, 0.16, 0.16),
+ hjust = c(0, 0, 0),
+ size = c(2, 1.5, 1.3),
+ font = "poppins",
+ fontface = c("bold", "italic", "italic"),
+ color = c("#333333", "#D86C7B", "#6b9bd1")
+)
+
+final_plot <- plot_3 +
+ geom_text(
+ data = texts,
+ aes(x = x, y = y, label = label, hjust = hjust),
+ color = texts$color,
+ size = texts$size,
+ fontface = texts$fontface,
+ family = "poppins",
+ lineheight = 0.9,
+ inherit.aes = FALSE # Essential to ignore map data
+ ) +
+ geom_curve(
+ aes(x = 0.425, y = 0.18, xend = 0.40, yend = 0.13),
+ curvature = 0.3, # Negative = Curves Right (concave down)
+ color = "#D86C7B",
+ size = 0.3,
+ arrow = arrow(length = unit(0.01, "npc"), type = "closed"),
+ inherit.aes = FALSE
+ ) +
+ geom_curve(
+ aes(x = 0.69, y = 0.19, xend = 0.717, yend = 0.24),
+ curvature = -0.3, # Negative = Curves Right (looks best for this angle)
+ color = "#6b9bd1",
+ size = 0.3,
+ arrow = arrow(length = unit(0.01, "npc"), type = "closed"),
+ inherit.aes = FALSE
+ )
+
+print(final_plot)
+
`,e.githubCompareUpdatesUrl&&(t+=`View all changes to this article since it was first published.`),t+=` + If you see mistakes or want to suggest changes, please create an issue on GitHub.
+ `);const n=e.journal;return'undefined'!=typeof n&&'Distill'===n.title&&(t+=` +Diagrams and text are licensed under Creative Commons Attribution CC-BY 4.0 with the source available on GitHub, unless noted otherwise. The figures that have been reused from other sources don’t fall under this license and can be recognized by a note in their caption: “Figure from …”.
+ `),'undefined'!=typeof e.publishedDate&&(t+=` +For attribution in academic contexts, please cite this work as
+${e.concatenatedAuthors}, "${e.title}", Distill, ${e.publishedYear}.
+ BibTeX citation
+${m(e)}
+ `),t}var An=Math.sqrt,En=Math.atan2,Dn=Math.sin,Mn=Math.cos,On=Math.PI,Un=Math.abs,In=Math.pow,Nn=Math.LN10,jn=Math.log,Rn=Math.max,qn=Math.ceil,Fn=Math.floor,Pn=Math.round,Hn=Math.min;const zn=['Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'],Bn=['Jan.','Feb.','March','April','May','June','July','Aug.','Sept.','Oct.','Nov.','Dec.'],Wn=(e)=>10>e?'0'+e:e,Vn=function(e){const t=zn[e.getDay()].substring(0,3),n=Wn(e.getDate()),i=Bn[e.getMonth()].substring(0,3),a=e.getFullYear().toString(),d=e.getUTCHours().toString(),r=e.getUTCMinutes().toString(),o=e.getUTCSeconds().toString();return`${t}, ${n} ${i} ${a} ${d}:${r}:${o} Z`},$n=function(e){const t=Array.from(e).reduce((e,[t,n])=>Object.assign(e,{[t]:n}),{});return t},Jn=function(e){const t=new Map;for(var n in e)e.hasOwnProperty(n)&&t.set(n,e[n]);return t};class Qn{constructor(e){this.name=e.author,this.personalURL=e.authorURL,this.affiliation=e.affiliation,this.affiliationURL=e.affiliationURL,this.affiliations=e.affiliations||[]}get firstName(){const e=this.name.split(' ');return e.slice(0,e.length-1).join(' ')}get lastName(){const e=this.name.split(' ');return e[e.length-1]}}class Gn{constructor(){this.title='unnamed article',this.description='',this.authors=[],this.bibliography=new Map,this.bibliographyParsed=!1,this.citations=[],this.citationsCollected=!1,this.journal={},this.katex={},this.publishedDate=void 0}set url(e){this._url=e}get url(){if(this._url)return this._url;return this.distillPath&&this.journal.url?this.journal.url+'/'+this.distillPath:this.journal.url?this.journal.url:void 0}get githubUrl(){return this.githubPath?'https://github.com/'+this.githubPath:void 0}set previewURL(e){this._previewURL=e}get previewURL(){return this._previewURL?this._previewURL:this.url+'/thumbnail.jpg'}get publishedDateRFC(){return Vn(this.publishedDate)}get updatedDateRFC(){return Vn(this.updatedDate)}get publishedYear(){return this.publishedDate.getFullYear()}get publishedMonth(){return Bn[this.publishedDate.getMonth()]}get publishedDay(){return this.publishedDate.getDate()}get publishedMonthPadded(){return Wn(this.publishedDate.getMonth()+1)}get publishedDayPadded(){return Wn(this.publishedDate.getDate())}get publishedISODateOnly(){return this.publishedDate.toISOString().split('T')[0]}get volume(){const e=this.publishedYear-2015;if(1>e)throw new Error('Invalid publish date detected during computing volume');return e}get issue(){return this.publishedDate.getMonth()+1}get concatenatedAuthors(){if(2 tag. We found the following text: '+t);const n=document.createElement('span');n.innerHTML=e.nodeValue,e.parentNode.insertBefore(n,e),e.parentNode.removeChild(e)}}}}).observe(this,{childList:!0})}}var Ti='undefined'==typeof window?'undefined'==typeof global?'undefined'==typeof self?{}:self:global:window,_i=f(function(e,t){(function(e){function t(){this.months=['jan','feb','mar','apr','may','jun','jul','aug','sep','oct','nov','dec'],this.notKey=[',','{','}',' ','='],this.pos=0,this.input='',this.entries=[],this.currentEntry='',this.setInput=function(e){this.input=e},this.getEntries=function(){return this.entries},this.isWhitespace=function(e){return' '==e||'\r'==e||'\t'==e||'\n'==e},this.match=function(e,t){if((void 0==t||null==t)&&(t=!0),this.skipWhitespace(t),this.input.substring(this.pos,this.pos+e.length)==e)this.pos+=e.length;else throw'Token mismatch, expected '+e+', found '+this.input.substring(this.pos);this.skipWhitespace(t)},this.tryMatch=function(e,t){return(void 0==t||null==t)&&(t=!0),this.skipWhitespace(t),this.input.substring(this.pos,this.pos+e.length)==e},this.matchAt=function(){for(;this.input.length>this.pos&&'@'!=this.input[this.pos];)this.pos++;return!('@'!=this.input[this.pos])},this.skipWhitespace=function(e){for(;this.isWhitespace(this.input[this.pos]);)this.pos++;if('%'==this.input[this.pos]&&!0==e){for(;'\n'!=this.input[this.pos];)this.pos++;this.skipWhitespace(e)}},this.value_braces=function(){var e=0;this.match('{',!1);for(var t=this.pos,n=!1;;){if(!n)if('}'==this.input[this.pos]){if(0 =k&&(++x,i=k);if(d[x]instanceof n||d[T-1].greedy)continue;w=T-x,y=e.slice(i,k),v.index-=i}if(v){g&&(h=v[1].length);var S=v.index+h,v=v[0].slice(h),C=S+v.length,_=y.slice(0,S),L=y.slice(C),A=[x,w];_&&A.push(_);var E=new n(o,u?a.tokenize(v,u):v,b,v,f);A.push(E),L&&A.push(L),Array.prototype.splice.apply(d,A)}}}}}return d},hooks:{all:{},add:function(e,t){var n=a.hooks.all;n[e]=n[e]||[],n[e].push(t)},run:function(e,t){var n=a.hooks.all[e];if(n&&n.length)for(var d,r=0;d=n[r++];)d(t)}}},i=a.Token=function(e,t,n,i,a){this.type=e,this.content=t,this.alias=n,this.length=0|(i||'').length,this.greedy=!!a};if(i.stringify=function(e,t,n){if('string'==typeof e)return e;if('Array'===a.util.type(e))return e.map(function(n){return i.stringify(n,t,e)}).join('');var d={type:e.type,content:i.stringify(e.content,t,n),tag:'span',classes:['token',e.type],attributes:{},language:t,parent:n};if('comment'==d.type&&(d.attributes.spellcheck='true'),e.alias){var r='Array'===a.util.type(e.alias)?e.alias:[e.alias];Array.prototype.push.apply(d.classes,r)}a.hooks.run('wrap',d);var l=Object.keys(d.attributes).map(function(e){return e+'="'+(d.attributes[e]||'').replace(/"/g,'"')+'"'}).join(' ');return'<'+d.tag+' class="'+d.classes.join(' ')+'"'+(l?' '+l:'')+'>'+d.content+''+d.tag+'>'},!t.document)return t.addEventListener?(t.addEventListener('message',function(e){var n=JSON.parse(e.data),i=n.language,d=n.code,r=n.immediateClose;t.postMessage(a.highlight(d,a.languages[i],i)),r&&t.close()},!1),t.Prism):t.Prism;var d=document.currentScript||[].slice.call(document.getElementsByTagName('script')).pop();return d&&(a.filename=d.src,document.addEventListener&&!d.hasAttribute('data-manual')&&('loading'===document.readyState?document.addEventListener('DOMContentLoaded',a.highlightAll):window.requestAnimationFrame?window.requestAnimationFrame(a.highlightAll):window.setTimeout(a.highlightAll,16))),t.Prism}();e.exports&&(e.exports=n),'undefined'!=typeof Ti&&(Ti.Prism=n),n.languages.markup={comment://,prolog:/<\?[\w\W]+?\?>/,doctype://i,cdata://i,tag:{pattern:/<\/?(?!\d)[^\s>\/=$<]+(?:\s+[^\s>\/=]+(?:=(?:("|')(?:\\\1|\\?(?!\1)[\w\W])*\1|[^\s'">=]+))?)*\s*\/?>/i,inside:{tag:{pattern:/^<\/?[^\s>\/]+/i,inside:{punctuation:/^<\/?/,namespace:/^[^\s>\/:]+:/}},"attr-value":{pattern:/=(?:('|")[\w\W]*?(\1)|[^\s>]+)/i,inside:{punctuation:/[=>"']/}},punctuation:/\/?>/,"attr-name":{pattern:/[^\s>\/]+/,inside:{namespace:/^[^\s>\/:]+:/}}}},entity:/?[\da-z]{1,8};/i},n.hooks.add('wrap',function(e){'entity'===e.type&&(e.attributes.title=e.content.replace(/&/,'&'))}),n.languages.xml=n.languages.markup,n.languages.html=n.languages.markup,n.languages.mathml=n.languages.markup,n.languages.svg=n.languages.markup,n.languages.css={comment:/\/\*[\w\W]*?\*\//,atrule:{pattern:/@[\w-]+?.*?(;|(?=\s*\{))/i,inside:{rule:/@[\w-]+/}},url:/url\((?:(["'])(\\(?:\r\n|[\w\W])|(?!\1)[^\\\r\n])*\1|.*?)\)/i,selector:/[^\{\}\s][^\{\};]*?(?=\s*\{)/,string:{pattern:/("|')(\\(?:\r\n|[\w\W])|(?!\1)[^\\\r\n])*\1/,greedy:!0},property:/(\b|\B)[\w-]+(?=\s*:)/i,important:/\B!important\b/i,function:/[-a-z0-9]+(?=\()/i,punctuation:/[(){};:]/},n.languages.css.atrule.inside.rest=n.util.clone(n.languages.css),n.languages.markup&&(n.languages.insertBefore('markup','tag',{style:{pattern:/(
+
+
+ ${e.map(l).map((e)=>`
`)}}const Mi=`
+d-citation-list {
+ contain: layout style;
+}
+
+d-citation-list .references {
+ grid-column: text;
+}
+
+d-citation-list .references .title {
+ font-weight: 500;
+}
+`;class Oi extends HTMLElement{static get is(){return'd-citation-list'}connectedCallback(){this.hasAttribute('distill-prerendered')||(this.style.display='none')}set citations(e){x(this,e)}}var Ui=f(function(e){var t='undefined'==typeof window?'undefined'!=typeof WorkerGlobalScope&&self instanceof WorkerGlobalScope?self:{}:window,n=function(){var e=/\blang(?:uage)?-(\w+)\b/i,n=0,a=t.Prism={util:{encode:function(e){return e instanceof i?new i(e.type,a.util.encode(e.content),e.alias):'Array'===a.util.type(e)?e.map(a.util.encode):e.replace(/&/g,'&').replace(/e.length)break tokenloop;if(!(y instanceof n)){c.lastIndex=0;var v=c.exec(y),w=1;if(!v&&f&&x!=d.length-1){if(c.lastIndex=i,v=c.exec(e),!v)break;for(var S=v.index+(g?v[1].length:0),C=v.index+v[0].length,T=x,k=i,p=d.length;T
+
+`);class Ni extends ei(Ii(HTMLElement)){renderContent(){if(this.languageName=this.getAttribute('language'),!this.languageName)return void console.warn('You need to provide a language attribute to your Footnotes
+
+`,!1);class Fi extends qi(HTMLElement){connectedCallback(){super.connectedCallback(),this.list=this.root.querySelector('ol'),this.root.style.display='none'}set footnotes(e){if(this.list.innerHTML='',e.length){this.root.style.display='';for(const t of e){const e=document.createElement('li');e.id=t.id+'-listing',e.innerHTML=t.innerHTML;const n=document.createElement('a');n.setAttribute('class','footnote-backlink'),n.textContent='[\u21A9]',n.href='#'+t.id,e.appendChild(n),this.list.appendChild(e)}}else this.root.style.display='none'}}const Pi=ti('d-hover-box',`
+
+
+