DATA 608 Story 7
Gillian McGovern
2025-12-06
Overview
The US Geological Survey publishes a list of Strategic Minerals (https://www.usgs.gov/news/national-news-release/us-geological-survey-releases-2022-list-critical-minerals ). Having a secure supply of these minerals is essential to our security and economic prosperity. However many of these minerals are sourced from outside of the US. This assignment is to develop a reference catalog of the source or sources of each of these minerals and a judgement on the reliability of each source under stressed circumstance (e.g. war, economic crisis, etc.)
Notes:
You will need to identify a source or sources for each of the minerals in the 2022 List of Critical Minerals
You will need to categorize each source country as an ally, a competitor or a neutral party.
You will need to develop data visualizations that tell the story of source dependency and shortfall impact.
This assignment is due at the end of week fourteen of the semester
Data Sources
The trends in US exports/imports is from the US Census Bureau.
The net import reliance commodity data and mineral stats (2024) came from USGS and US Census Bureau.
The Geopolitical Rish Index GPR from Princeton University.
Libraries
#Libraries
library(geomtextpath)
library(knitr)
library(readr)
library(tidyverse)
library(corrplot)
library(dplyr)
library(GGally)
library(caret)
library(pROC)
library(glmnet)
library(MASS)
library(car)
library(faraway)
library(arm)
library(performance)
library(see)
library(reshape2)
library(readr)
library(tidymodels)
library(rms)
library(statebins)
library(tidyverse)
library(httr)
library(dplyr)
library(stringr)
library(rvest)
library(janitor)
library(stringr)
library(tidytext)
library(tibble)
library(textdata)
library(tidyr)
library(readr)
library(purrr)
library(forcats)
library(ggplot2)
library(colorspace)
library(grid)
library(ggnewscale)
library(ggtext)
library(tidyverse)
library(shadowtext)
library(patchwork)
library(ggplot2)
library(dplyr)
library(plotly)
library(rnaturalearth)
library(rnaturalearthdata)
library(choroplethr)
library(ggrepel)Data Import
# Read in the data
critical_minerals_2022 <- c("Aluminum", "Antimony", "Arsenic", "Barite", "Beryllium", "Bismuth", "Cerium", "Cesium", "Chromium", "Cobalt", "Dysprosium", "Erbium", "Europium", "Fluorspar", "Gadolinium", "Gallium", "Germanium", "Graphite", "Hafnium", "Holmium", "Indium", "Iridium", "Lanthanum", "Lithium", "Lutetium", "Magnesium", "Manganese", "Neodymium", "Nickel", "Niobium", "Palladium", "Platinum", "Praseodymium", "Rhodium", "Rubidium", "Ruthenium", "Samarium", "Scandium", "Tantalum", "Tellurium", "Terbium", "Thulium", "Tin", "Titanium", "Tungsten", "Vanadium", "Ytterbium", "Yttrium", "Zinc", "Zirconium")
# Trends in US exports/imports from us census bureau
us_exports_imports_trends <- read.csv("https://raw.githubusercontent.com/gillianmcgovern0/cuny-data-608/refs/heads/main/US_exports_imports_with_world_trends_country.csv")# from USGS
net_import_reliance_2024_commodity <- read.table("https://raw.githubusercontent.com/gillianmcgovern0/cuny-data-608/refs/heads/main/NIR%20Chart_Full%20Data_data.csv", sep = "\t", header = TRUE, fileEncoding = "UCS-2LE")
# from USGS
us_mineral_import_stats_2024 <- read.table("https://raw.githubusercontent.com/gillianmcgovern0/cuny-data-608/refs/heads/main/Estimated%20United%20States%20Salient%20Critical%20Minerals%20Statistics%20in%202024.csv", sep = "\t", header = TRUE, fileEncoding = "UCS-2LE")
head(us_mineral_import_stats_2024)## Critical.mineral Primary.Production Secondary.Production
## 1 Aluminum (bauxite) 0 0
## 2 Antimony 0 3,500
## 3 Arsenic 0 <NA>
## 4 Barite W 0
## 5 Beryllium 180 <NA>
## 6 Bismuth 0 80
## Apparent.Consumption Primary.import.source Net.Import.Reliance
## 1 1,800,000 Jamaica >75
## 2 24,000 China 85
## 3 9,100 China 100
## 4 W India >75
## 5 170 Kazakhstan E
## 6 760 China 89
## Contsumption.Notes Import.source.notes
## 1 Reported consumption. Average 2020 to 2023.
## 2 Average 2020 to 2023. Includes Hong Kong.
## 3 Estimated consumption. Average 2020 to 2023. Includes Hong Kong.
## 4 Average 2020 to 2023.
## 5 Average 2020 to 2023.
## 6 Average 2020 to 2023. Includes Hong Kong.
## Prod.notes
## 1
## 2
## 3
## 4
## 5
## 6 Refinery production.
## Net.import.reliance.as.a.percentage.of.apparent.consumption
## 1 75.1
## 2 85.0
## 3 100.0
## 4 75.1
## 5 NA
## 6 89.0# Geopolitical Rish Index GPR from princeton
gpr_data <- read.csv("https://raw.githubusercontent.com/gillianmcgovern0/cuny-data-608/refs/heads/main/data_gpr_export.csv")
head(gpr_data)## month GPR GPRT GPRA GPRH GPRHT GPRHA SHARE_GPR N10 SHARE_GPRH N3H
## 1 1/1/00 NA NA NA 87.93 64.72 110.45 NA NA 3.17 7724
## 2 2/1/00 NA NA NA 86.57 71.94 96.25 NA NA 3.12 7173
## 3 3/1/00 NA NA NA 72.14 57.48 84.50 NA NA 2.60 7762
## 4 4/1/00 NA NA NA 54.42 37.33 65.86 NA NA 1.96 7488
## 5 5/1/00 NA NA NA 64.41 48.20 74.37 NA NA 2.32 7360
## 6 6/1/00 NA NA NA 83.61 70.01 93.98 NA NA 3.02 7294
## GPRH_NOEW GPR_NOEW GPRH_AND GPR_AND GPRH_BASIC GPR_BASIC SHAREH_CAT_1
## 1 92.19 NA 116.95 NA 84.11 NA 0.52
## 2 91.03 NA 131.07 NA 79.70 NA 0.47
## 3 77.07 NA 112.94 NA 65.70 NA 0.45
## 4 61.99 NA 99.78 NA 53.79 NA 0.39
## 5 64.24 NA 105.35 NA 55.61 NA 0.52
## 6 77.47 NA 124.27 NA 76.15 NA 0.47
## SHAREH_CAT_2 SHAREH_CAT_3 SHAREH_CAT_4 SHAREH_CAT_5 SHAREH_CAT_6 SHAREH_CAT_7
## 1 0.01 0.70 0 0.00 1.32 0.95
## 2 0.13 0.77 0 0.01 1.13 0.84
## 3 0.08 0.57 0 0.04 1.26 0.46
## 4 0.00 0.32 0 0.00 0.64 0.73
## 5 0.04 0.35 0 0.00 0.69 0.88
## 6 0.05 0.80 0 0.03 1.25 0.74
## SHAREH_CAT_8 GPRC_ARG GPRC_AUS GPRC_BEL GPRC_BRA GPRC_CAN GPRC_CHE GPRC_CHL
## 1 0 NA NA NA NA NA NA NA
## 2 0 NA NA NA NA NA NA NA
## 3 0 NA NA NA NA NA NA NA
## 4 0 NA NA NA NA NA NA NA
## 5 0 NA NA NA NA NA NA NA
## 6 0 NA NA NA NA NA NA NA
## GPRC_CHN GPRC_COL GPRC_DEU GPRC_DNK GPRC_EGY GPRC_ESP GPRC_FIN GPRC_FRA
## 1 NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA
## GPRC_GBR GPRC_HKG GPRC_HUN GPRC_IDN GPRC_IND GPRC_ISR GPRC_ITA GPRC_JPN
## 1 NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA
## GPRC_KOR GPRC_MEX GPRC_MYS GPRC_NLD GPRC_NOR GPRC_PER GPRC_PHL GPRC_POL
## 1 NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA
## GPRC_PRT GPRC_RUS GPRC_SAU GPRC_SWE GPRC_THA GPRC_TUN GPRC_TUR GPRC_TWN
## 1 NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA
## GPRC_UKR GPRC_USA GPRC_VEN GPRC_VNM GPRC_ZAF GPRHC_ARG GPRHC_AUS GPRHC_BEL
## 1 NA NA NA NA NA 0.03 0.08 0.09
## 2 NA NA NA NA NA 0.01 0.15 0.15
## 3 NA NA NA NA NA 0.01 0.13 0.10
## 4 NA NA NA NA NA 0.00 0.08 0.03
## 5 NA NA NA NA NA 0.00 0.12 0.03
## 6 NA NA NA NA NA 0.00 0.07 0.12
## GPRHC_BRA GPRHC_CAN GPRHC_CHE GPRHC_CHL GPRHC_CHN GPRHC_COL GPRHC_DEU
## 1 0.01 0.09 0.04 0.01 0.23 0.03 0.53
## 2 0.03 0.10 0.08 0.01 0.10 0.00 0.64
## 3 0.01 0.18 0.03 0.00 0.14 0.01 0.46
## 4 0.00 0.08 0.01 0.00 0.11 0.05 0.21
## 5 0.05 0.26 0.01 0.03 0.11 0.05 0.41
## 6 0.00 0.05 0.03 0.01 1.49 0.05 0.69
## GPRHC_DNK GPRHC_EGY GPRHC_ESP GPRHC_FIN GPRHC_FRA GPRHC_GBR GPRHC_HKG
## 1 0.01 0.05 0.56 0.03 0.67 1.54 0
## 2 0.03 0.20 0.39 0.00 0.96 1.88 0
## 3 0.00 0.09 0.39 0.00 0.54 1.35 0
## 4 0.04 0.01 0.29 0.03 0.39 1.12 0
## 5 0.03 0.04 0.26 0.00 0.49 1.11 0
## 6 0.05 0.05 0.14 0.00 0.99 1.60 0
## GPRHC_HUN GPRHC_IDN GPRHC_IND GPRHC_ISR GPRHC_ITA GPRHC_JPN GPRHC_KOR
## 1 0.03 0 0.27 0.00 0.05 0.09 0.01
## 2 0.04 0 0.39 0.01 0.20 0.04 0.00
## 3 0.04 0 0.28 0.04 0.18 0.10 0.06
## 4 0.00 0 0.12 0.00 0.09 0.15 0.03
## 5 0.03 0 0.22 0.00 0.12 0.07 0.00
## 6 0.00 0 0.30 0.00 0.21 0.73 0.04
## GPRHC_MEX GPRHC_MYS GPRHC_NLD GPRHC_NOR GPRHC_PER GPRHC_PHL GPRHC_POL
## 1 0.06 0 0.25 0.01 0.01 0.88 0.05
## 2 0.10 0 0.31 0.01 0.01 0.47 0.01
## 3 0.05 0 0.21 0.03 0.01 0.35 0.01
## 4 0.05 0 0.04 0.01 0.03 0.33 0.00
## 5 0.07 0 0.19 0.03 0.00 0.49 0.00
## 6 0.05 0 0.14 0.03 0.03 0.53 0.01
## GPRHC_PRT GPRHC_RUS GPRHC_SAU GPRHC_SWE GPRHC_THA GPRHC_TUN GPRHC_TUR
## 1 0.25 0.26 0 0.01 0.08 0.00 0.04
## 2 0.14 0.33 0 0.00 0.08 0.00 0.13
## 3 0.05 0.39 0 0.01 0.12 0.00 0.18
## 4 0.08 0.27 0 0.00 0.04 0.00 0.07
## 5 0.08 0.18 0 0.00 0.16 0.00 0.08
## 6 0.07 0.95 0 0.01 0.08 0.01 0.11
## GPRHC_TWN GPRHC_UKR GPRHC_USA GPRHC_VEN GPRHC_VNM GPRHC_ZAF var_name
## 1 0.00 0 2.72 0.05 0.01 1.15 month
## 2 0.00 0 2.73 0.03 0.00 1.14 GPR
## 3 0.00 0 2.15 0.03 0.00 0.86 GPRT
## 4 0.00 0 1.78 0.00 0.00 0.64 GPRA
## 5 0.00 0 1.97 0.01 0.00 0.79 GPRH
## 6 0.03 0 2.73 0.03 0.04 0.67 GPRHT
## var_label
## 1 Date (year/month)
## 2 Recent GPR (Index: 1985:2019=100)
## 3 Recent GPR Threats (Index: 1985:2019=100)
## 4 Recent GPR Acts (Index: 1985:2019=100)
## 5 Historical GPR (Index: 1900:2019=100)
## 6 Historical GPR Threats (Index: 1900:2019=100)# Global peace index
global_peace_index_data <- read.csv("https://raw.githubusercontent.com/gillianmcgovern0/cuny-data-608/refs/heads/main/global_peace_index_2025.csv")
head(global_peace_index_data)## rank region score.
## 1 1 Iceland 1.095
## 2 2 Ireland 1.260
## 3 3 New Zealand 1.282
## 4 4 Austria 1.294
## 5 4 Switzerland 1.294
## 6 6 Singapore 1.357Data Cleaning and Preparation
# Geopolitical Rish Index GPR from princeton
gpr_data1 <- gpr_data |>
select(month, GPR)
colnames(gpr_data1) <- c("date", "GPR")
gpr_data1 <- na.omit(gpr_data1)
# convert string to date
gpr_data1$date <- as.Date(gpr_data1$date, format = "%m/%d/%y")
head(gpr_data1)## date GPR
## 1021 1985-01-01 102.17
## 1022 1985-02-01 117.10
## 1023 1985-03-01 124.78
## 1024 1985-04-01 87.93
## 1025 1985-05-01 103.26
## 1026 1985-06-01 148.78# Just look at the US exports/imports with the world
us_exports_imports_trends_filtered <- us_exports_imports_trends %>%
filter(CTYNAME == "World, Not Seasonally Adjusted")
# Tidy the dataframe
us_exports_imports_trends_filtered_tidy <- us_exports_imports_trends_filtered %>%
pivot_longer(
cols = c(IJAN, IFEB, IMAR, IAPR, IMAY, IJUN, IJUL, IAUG, ISEP, IOCT, INOV, IDEC, EJAN, EFEB, EMAR, EAPR, EMAY, EJUN, EJUL, EAUG, ESEP, EOCT, ENOV, EDEC),
names_to = "month",
values_to = "usd_amount_millions"
)
us_exports_imports_trends_filtered_tidy <- us_exports_imports_trends_filtered_tidy %>%
separate(
col = month,
into = c("type", "month"),
sep = 1 # splits after the first character
)
us_exports_imports_trends_filtered_tidy_yearly <- us_exports_imports_trends_filtered_tidy %>%
dplyr::select(year, type, usd_amount_millions) %>%
group_by(year, type) %>%
summarise(avg_usd_amount_millions = mean(usd_amount_millions, na.rm = TRUE))## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.# remove 2025 since we dont have a full years worth of data
us_exports_imports_trends_filtered_tidy_yearly <- us_exports_imports_trends_filtered_tidy_yearly |>
filter(year != 2025)
head(us_exports_imports_trends_filtered_tidy_yearly)## # A tibble: 6 × 3
## # Groups: year [3]
## year type avg_usd_amount_millions
## <int> <chr> <dbl>
## 1 1987 E 21177.
## 2 1987 I 33853.
## 3 1988 E 26869.
## 4 1988 I 36746.
## 5 1989 E 30318.
## 6 1989 I 39434.# for last visualization
us_exports_imports_trends_filtered_tidy2 <- us_exports_imports_trends_filtered_tidy
us_exports_imports_trends_filtered_tidy2$date <- paste(us_exports_imports_trends_filtered_tidy2$year, us_exports_imports_trends_filtered_tidy2$month, "01", sep = "-")
# Convert the character string to a Date object
# %Y is 4-digit year, %b is abbreviated month name, %d is day number
us_exports_imports_trends_filtered_tidy2$date <- as.Date(us_exports_imports_trends_filtered_tidy2$date, format = "%Y-%b-%d")
head(us_exports_imports_trends_filtered_tidy2)## # A tibble: 6 × 9
## year CTY_CODE CTYNAME IYR EYR type month usd_amount_millions
## <int> <int> <chr> <dbl> <dbl> <chr> <chr> <dbl>
## 1 1987 15 World, Not Seaso… 406241 2.54e5 I JAN 30798.
## 2 1987 15 World, Not Seaso… 406241 2.54e5 I FEB 29810.
## 3 1987 15 World, Not Seaso… 406241 2.54e5 I MAR 32464.
## 4 1987 15 World, Not Seaso… 406241 2.54e5 I APR 32291.
## 5 1987 15 World, Not Seaso… 406241 2.54e5 I MAY 33170
## 6 1987 15 World, Not Seaso… 406241 2.54e5 I JUN 35358
## # ℹ 1 more variable: date <date># top imports
colnames(us_mineral_import_stats_2024) <- c("mineral", "primary_production", "secondary_production", "apparent_consumption", "primary_import_source", "net_import_reliance_perc_of_app_consumption", "consumption_notes", "import_source_notes", "prod_notes", "net_import_reliance_perc_of_app_consumption_actual_val")
head(us_mineral_import_stats_2024)## mineral primary_production secondary_production
## 1 Aluminum (bauxite) 0 0
## 2 Antimony 0 3,500
## 3 Arsenic 0 <NA>
## 4 Barite W 0
## 5 Beryllium 180 <NA>
## 6 Bismuth 0 80
## apparent_consumption primary_import_source
## 1 1,800,000 Jamaica
## 2 24,000 China
## 3 9,100 China
## 4 W India
## 5 170 Kazakhstan
## 6 760 China
## net_import_reliance_perc_of_app_consumption consumption_notes
## 1 >75 Reported consumption.
## 2 85
## 3 100 Estimated consumption.
## 4 >75
## 5 E
## 6 89
## import_source_notes prod_notes
## 1 Average 2020 to 2023.
## 2 Average 2020 to 2023. Includes Hong Kong.
## 3 Average 2020 to 2023. Includes Hong Kong.
## 4 Average 2020 to 2023.
## 5 Average 2020 to 2023.
## 6 Average 2020 to 2023. Includes Hong Kong. Refinery production.
## net_import_reliance_perc_of_app_consumption_actual_val
## 1 75.1
## 2 85.0
## 3 100.0
## 4 75.1
## 5 NA
## 6 89.0# Find the missing minerals
us_mineral_import_stats_2024_v2 <- us_mineral_import_stats_2024
is_present <- sapply(critical_minerals_2022, function(s) {
any(grepl(s, us_mineral_import_stats_2024_v2$mineral, ignore.case = TRUE))
})
missing_strings <- critical_minerals_2022[!is_present]
print(missing_strings)## [1] "Cerium" "Cesium" "Dysprosium" "Erbium" "Europium"
## [6] "Gadolinium" "Hafnium" "Holmium" "Iridium" "Lanthanum"
## [11] "Lutetium" "Neodymium" "Praseodymium" "Rhodium" "Rubidium"
## [16] "Ruthenium" "Samarium" "Terbium" "Thulium" "Ytterbium"# manual add missing minerals - from USGS (Google search)
us_mineral_import_stats_2024_map <- us_mineral_import_stats_2024 |>
dplyr::select(mineral, primary_import_source)
# some have 2 primary sources, so added both
# no clear answer for Cesium and Rubidium
minerals_to_add <- data.frame(
mineral = c("Cerium", "Dysprosium", "Erbium", "Europium", "Gadolinium", "Holmium", "Lanthanum", "Lutetium", "Neodymium", "Praseodymium", "Samarium", "Terbium", "Thulium", "Ytterbium", "Iridium", "Rhodium", "Ruthenium", "Iridium", "Rhodium", "Ruthenium" , "Hafnium", "Hafnium", "Hafnium"),
primary_import_source = c("China", "China", "China", "China", "China", "China", "China", "China", "China", "China", "China", "China", "China", "China", "South Africa", "South Africa", "South Africa", "Russia", "Russia", "Russia", "Germany", "France", "China")
)
us_mineral_import_stats_2024_map <- rbind(us_mineral_import_stats_2024_map, minerals_to_add)
pattern <- paste(critical_minerals_2022, collapse = "|")
us_mineral_import_stats_2024_map$contains_mineral <- str_detect(us_mineral_import_stats_2024_map$mineral, pattern)
us_mineral_import_stats_2024_map_filtered <- us_mineral_import_stats_2024_map |>
filter(contains_mineral == TRUE)
head(us_mineral_import_stats_2024_map)## mineral primary_import_source contains_mineral
## 1 Aluminum (bauxite) Jamaica TRUE
## 2 Antimony China TRUE
## 3 Arsenic China TRUE
## 4 Barite India TRUE
## 5 Beryllium Kazakhstan TRUE
## 6 Bismuth China TRUE# imports world map
us_mineral_import_stats_2024_map_count <- us_mineral_import_stats_2024_map |>
group_by(primary_import_source) |>
summarise(total_minerals = n())
# from online
world_map <- ne_countries(scale = "medium", returnclass = "sf")
merged_world_data <- left_join(us_mineral_import_stats_2024_map_count, world_map, by = c("primary_import_source" = "name"))
head(us_mineral_import_stats_2024_map_count)## # A tibble: 6 × 2
## primary_import_source total_minerals
## <chr> <int>
## 1 " Republic of Korea" 1
## 2 "Belgium" 1
## 3 "Brazil" 1
## 4 "Canada" 4
## 5 "Chile" 1
## 6 "China" 23head(merged_world_data)## # A tibble: 6 × 170
## primary_import_source total_minerals featurecla scalerank labelrank sovereignt
## <chr> <int> <chr> <int> <int> <chr>
## 1 " Republic of Korea" 1 <NA> NA NA <NA>
## 2 "Belgium" 1 Admin-0 c… 1 2 Belgium
## 3 "Brazil" 1 Admin-0 c… 1 2 Brazil
## 4 "Canada" 4 Admin-0 c… 1 2 Canada
## 5 "Chile" 1 Admin-0 c… 4 2 Chile
## 6 "China" 23 Admin-0 c… 3 2 China
## # ℹ 164 more variables: sov_a3 <chr>, adm0_dif <int>, level <int>, type <chr>,
## # tlc <chr>, admin <chr>, adm0_a3 <chr>, geou_dif <int>, geounit <chr>,
## # gu_a3 <chr>, su_dif <int>, subunit <chr>, su_a3 <chr>, brk_diff <int>,
## # name_long <chr>, brk_a3 <chr>, brk_name <chr>, brk_group <chr>,
## # abbrev <chr>, postal <chr>, formal_en <chr>, formal_fr <chr>,
## # name_ciawf <chr>, note_adm0 <chr>, note_brk <chr>, name_sort <chr>,
## # name_alt <chr>, mapcolor7 <int>, mapcolor8 <int>, mapcolor9 <int>, …# colnames(net_import_reliance_2024) <- c("mineral", "major_import_sources_2020-23", "percent", "notes", "net_import_reliance_perc_of_app_consumption")
#
#
# head(net_import_reliance_2024)Intro - trends in exports/imports
us_exports_imports_trends_filtered_tidy_yearly## # A tibble: 76 × 3
## # Groups: year [38]
## year type avg_usd_amount_millions
## <int> <chr> <dbl>
## 1 1987 E 21177.
## 2 1987 I 33853.
## 3 1988 E 26869.
## 4 1988 I 36746.
## 5 1989 E 30318.
## 6 1989 I 39434.
## 7 1990 E 32799.
## 8 1990 I 41276.
## 9 1991 E 35144.
## 10 1991 I 40704.
## # ℹ 66 more rowsset.seed(123)
# First graph - the set up
# hurricanes_1800s_1900s$colors <- ifelse(hurricanes_1800s_1900s$year < 2000, "highlight", "gray")
df <- data.frame(x1 = 2024, x2 = 2024, y1 = 272200.85, y2 = 171807.56)
df_point <- data.frame(x = 2024, y = 272200.85)
df_point2 <- data.frame(x = 2024, y = 171807.56)
df_2001_attack <- data.frame(x1 = 2001, x2 = 2001, y1 = 95083.18, y2 = 130000)
df_2003_Iraq_War <- data.frame(x1 = 2003, x2 = 2003, y1 = 104760.10, y2 = 134760.10)
df_2008_recession <- data.frame(x1 = 2008, x2 = 2008, y1 = 175303.39, y2 = 205303.39)
df_covid_19 <- data.frame(x1 = 2020, x2 = 2020, y1 = 194289.77, y2 = 234289.77)
df_Russia_Ukraine_War <- data.frame(x1 = 2022, x2 = 2022, y1 = 269977.74, y2 = 299977.74)
us_exports_imports_trends_filtered_tidy_yearly %>%
ggplot( aes(x=year, y=avg_usd_amount_millions, color = type)) +
geom_line(linewidth = 1) +
scale_color_manual(
values = c("I" = lighten("royalblue4", 0.4), "E" = "grey"),
labels = c("Exports", "Imports"),
name = ""
) +
labs(
title = "Trade in Goods with World, Not Seasonally Adjusted",
subtitle = "The U.S. heavily relies on imports from other countries.",
caption = "Data from US Census Bureau",
y = "Millions of U.S. Dollars",
x = "Year"
) +
scale_y_continuous(
limits = c(0, 400000)
) +
scale_x_continuous(
limits = c(1985, 2035)
) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
linetype = "dashed",
linewidth = 0.5,
data = df) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
linetype = "solid",
linewidth = 0.75,
color = "black",
data = df_2001_attack) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
linetype = "solid",
linewidth = 0.75,
color = "black",
data = df_2003_Iraq_War) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
linetype = "solid",
linewidth = 0.75,
color = "black",
data = df_2008_recession) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
linetype = "solid",
linewidth = 0.75,
color = "black",
data = df_covid_19) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
linetype = "solid",
linewidth = 0.75,
color = "black",
data = df_Russia_Ukraine_War) +
annotate(geom="text", x=2001, y=150000,
size=3.5,
label="9/11") +
annotate(geom="text", x=2003, y=180000,
size=3.5,
label="2003\nIraq\nWar") +
annotate(geom="text", x=2008, y=240000,
size=3.5,
label="2008\nRecession") +
annotate(geom="text", x=2020, y=250000,
size=3.5,
label="COVID") +
annotate(geom="text", x=2022, y=330000,
size=3.5,
label="Russia-Ukraine\nWar") +
annotate(geom="text", x=2026, y=223200.85,
size=3.5,
hjust = 0,
fontface = "bold",
label="46% More\nImports than\nExports") +
annotate(geom="point", x=2024, y=272200.85, size=3, shape=21, fill="royalblue4") +
annotate(geom="point", x=2024, y=171807.56, size=3, shape=21, fill="grey") +
theme(legend.position = "none") +
# geom_text_repel(box.padding = 0.5, max.overlaps = Inf) +
theme_classic()
# p + geom_point(data = df_point, color = "red", size = 4, pch = 16)most critical minerals - bar chart
# Find the top 10 minerals by importance - 2024
us_mineral_import_stats_2024_sorted <- us_mineral_import_stats_2024 |>
arrange(desc(net_import_reliance_perc_of_app_consumption_actual_val))
us_mineral_import_stats_2024_sorted_sliced <- us_mineral_import_stats_2024_sorted |>
slice(1:10)
us_mineral_import_stats_2024_sorted_sliced_vector <- us_mineral_import_stats_2024_sorted_sliced[["mineral"]]
us_mineral_import_stats_2024_sorted <- us_mineral_import_stats_2024_sorted %>%
mutate(nir_100 = (mineral %in% us_mineral_import_stats_2024_sorted_sliced_vector))
# Plot
ggplot(na.omit(us_mineral_import_stats_2024_sorted), aes(x = reorder(mineral, net_import_reliance_perc_of_app_consumption_actual_val), y = net_import_reliance_perc_of_app_consumption_actual_val, fill = nir_100)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("TRUE" = "lightblue4", "FALSE" = lighten("lightblue4", 0.6))) +
scale_y_continuous(
name = "Net Importance Reliance",
) +
coord_flip() +
theme(
text = element_text(color = "gray30"),
axis.text.x = element_text(color = "gray30"),
axis.title.y = element_blank(),
axis.line.y = element_blank(),
axis.ticks.length = unit(0, "pt"),
axis.text.y = element_text(
size = 8,
),
) +
geom_text(aes(label = prettyNum(round(net_import_reliance_perc_of_app_consumption_actual_val))),
color = "white",
size = 3.6,
hjust = 1.3) +
labs(
title = "Net Importance Reliance as a Percentage of Apparent Consumption for Top 10 Minerals, 2024",
subtitle = "The U.S. is 100% net reliant for three critical minerals.",
caption = "Data from U.S. Census Bureau. NOTE: This does not contain every mineral from the 2022 list (used 2024 data from U.S.Census Bureau)."
) +
theme(legend.position = "none")
World graph - amount of important minerals shades
# dont use
# # us_mineral_import_stats_2024_map_count$primary_import_source <- tolower(us_mineral_import_stats_2024_map_count$primary_import_source)
# us_mineral_import_stats_2024_map_count2 <- us_mineral_import_stats_2024_map_count
# colnames(us_mineral_import_stats_2024_map_count2) <- c("region", "total_minerals")
# head(us_mineral_import_stats_2024_map_count2)
# country_choropleth(us_mineral_import_stats_2024_map_count2,
# value.name = "total_minerals",
# title = "Leading Import Primary Source for Critical Minerals, 2024",
# legend = "Number of Critical Minerals",
# num_colors = 1) # Create a world map that shows which countries have the most minerals the US needs
library(sf)## Linking to GEOS 3.13.0, GDAL 3.8.5, PROJ 9.5.1; sf_use_s2() is TRUEmerged_world_data <- st_as_sf(merged_world_data)
world_map <- ne_countries(scale = "medium", returnclass = "sf")
ggplot() +
geom_sf(data = world_map, color = "darkgrey", size = 0.5) +
geom_sf(data = merged_world_data, aes(fill = total_minerals)) +
# geom_sf_label(data = merged_world_data, aes(label = total_minerals)) +# Set border color and thickness
scale_fill_gradient(low="thistle1", high="violetred4", na.value = "black") +
labs(title = "Leading Primary Import Source for Critical Minerals, 2024",
fill = "Number of Critical Minerals",
caption = "Data from U.S. Census Bureau. Note: Some data had to be manually taken from USGS.") +
theme_void() # A clean theme without axis lines
Same graph layered by A, C, N category
# [1] " Republic of Korea" "Belgium" "Brazil" "Canada" "Chile" "China" "Gabon"
# [8] "India" "Israel" "Jamaica" "Japan" "Kazakhstan" "Mexico" "Norway"
# [15] "Peru" "Russia" "South Africa"
# ally, competitor, neutral party
nato_countries_ally <- c("Albania", "Belgium", "Bulgaria", "Canada", "Croatia",
"Czech Republic", "Denmark", "Estonia", "Finland", "France",
"Germany", "Greece", "Hungary", "Iceland", "Italy",
"Latvia", "Lithuania", "Luxembourg", "Montenegro", "Netherlands",
"North Macedonia", "Norway", "Poland", "Portugal", "Romania",
"Slovakia", "Slovenia", "Spain", "Sweden", "Turkey",
"United Kingdom", "United States")
competitors <- c("China", "Russia")
global_peace_index_data## rank region score.
## 1 1 Iceland 1.095
## 2 2 Ireland 1.260
## 3 3 New Zealand 1.282
## 4 4 Austria 1.294
## 5 4 Switzerland 1.294
## 6 6 Singapore 1.357
## 7 7 Portugal 1.371
## 8 8 Denmark 1.393
## 9 9 Slovenia 1.409
## 10 10 Finland 1.420
## 11 11 Czechia 1.435
## 12 12 Japan 1.440
## 13 13 Malaysia 1.469
## 14 14 Canada 1.491
## 15 14 Netherlands 1.491
## 16 16 Belgium 1.492
## 17 17 Hungary 1.500
## 18 18 Australia 1.505
## 19 19 Croatia 1.519
## 20 20 Germany 1.533
## 21 21 Bhutan 1.536
## 22 22 Lithuania 1.558
## 23 22 Latvia 1.558
## 24 24 Estonia 1.559
## 25 25 Spain 1.578
## 26 26 Mauritius 1.586
## 27 27 Qatar 1.593
## 28 28 Slovakia 1.609
## 29 29 Bulgaria 1.610
## 30 30 United Kingdom 1.634
## 31 31 Kuwait 1.642
## 32 32 Norway 1.644
## 33 33 Italy 1.662
## 34 34 Montenegro 1.685
## 35 35 Sweden 1.709
## 36 36 Poland 1.713
## 37 37 Mongolia 1.719
## 38 38 Romania 1.721
## 39 38 Vietnam 1.721
## 40 40 Taiwan 1.730
## 41 41 South Korea 1.736
## 42 42 Oman 1.738
## 43 43 Botswana 1.743
## 44 44 Timor-Leste 1.758
## 45 45 Greece 1.764
## 46 46 Argentina 1.768
## 47 47 Laos 1.783
## 48 48 Uruguay 1.784
## 49 49 Indonesia 1.786
## 50 50 Namibia 1.789
## 51 51 North Macedonia 1.799
## 52 52 Albania 1.812
## 53 52 United Arab Emirates 1.812
## 54 54 Costa Rica 1.843
## 55 55 The Gambia 1.855
## 56 56 Kazakhstan 1.875
## 57 57 Sierra Leone 1.887
## 58 58 Armenia 1.893
## 59 59 Bosnia and Herzegovina 1.895
## 60 59 Madagascar 1.895
## 61 61 Ghana 1.898
## 62 62 Chile 1.899
## 63 63 Kosovo 1.908
## 64 64 Serbia 1.914
## 65 64 Zambia 1.914
## 66 66 Moldova 1.918
## 67 67 Uzbekistan 1.926
## 68 68 Cyprus 1.933
## 69 69 Senegal 1.936
## 70 70 Liberia 1.939
## 71 71 Malawi 1.955
## 72 72 Jordan 1.957
## 73 73 Tanzania 1.965
## 74 74 France 1.967
## 75 75 Paraguay 1.981
## 76 76 Angola 1.987
## 77 76 Nepal 1.987
## 78 78 Kyrgyz Republic 1.988
## 79 79 Dominican Republic 1.996
## 80 79 Tajikistan 1.996
## 81 81 Tunisia 1.998
## 82 82 Equatorial Guinea 2.004
## 83 83 Bolivia 2.005
## 84 84 Panama 2.006
## 85 85 Morocco 2.012
## 86 86 Thailand 2.017
## 87 87 Cambodia 2.019
## 88 87 Turkmenistan 2.019
## 89 89 Trinidad and Tobago 2.020
## 90 90 Saudi Arabia 2.035
## 91 91 Rwanda 2.036
## 92 92 Algeria 2.042
## 93 93 Jamaica 2.047
## 94 94 Cote d' Ivoire 2.066
## 95 95 Azerbaijan 2.067
## 96 96 Peru 2.073
## 97 97 Sri Lanka 2.075
## 98 98 China 2.093
## 99 99 Eswatini 2.094
## 100 100 Bahrain 2.099
## 101 101 Guinea-Bissau 2.112
## 102 102 Cuba 2.123
## 103 103 Republic of the Congo 2.132
## 104 104 El Salvador 2.136
## 105 105 Philippines 2.148
## 106 106 Guyana 2.149
## 107 107 Egypt 2.157
## 108 108 Guatemala 2.174
## 109 109 Georgia 2.185
## 110 110 Mauritania 2.204
## 111 111 Nicaragua 2.207
## 112 112 Benin 2.211
## 113 113 Uganda 2.217
## 114 114 Zimbabwe 2.223
## 115 115 India 2.229
## 116 116 Papua New Guinea 2.230
## 117 117 Gabon 2.238
## 118 118 Guinea 2.253
## 119 119 Belarus 2.267
## 120 119 Lesotho 2.267
## 121 121 Mozambique 2.273
## 122 122 Djibouti 2.276
## 123 123 Bangladesh 2.318
## 124 124 Honduras 2.347
## 125 124 South Africa 2.347
## 126 126 Togo 2.381
## 127 127 Kenya 2.392
## 128 128 United States of America 2.443
## 129 129 Ecuador 2.459
## 130 130 Brazil 2.472
## 131 131 Libya 2.478
## 132 132 Eritrea 2.542
## 133 133 Burundi 2.574
## 134 134 Chad 2.593
## 135 135 Mexico 2.636
## 136 136 Lebanon 2.674
## 137 137 Cameroon 2.683
## 138 138 Ethiopia 2.688
## 139 139 Venezuela 2.692
## 140 140 Colombia 2.695
## 141 141 Haiti 2.731
## 142 142 Iran 2.750
## 143 143 Niger 2.759
## 144 144 Pakistan 2.797
## 145 145 Palestine 2.811
## 146 146 Turkiye 2.852
## 147 147 Iraq 2.862
## 148 148 Nigeria 2.869
## 149 149 North Korea 2.911
## 150 150 Central African Republic 2.912
## 151 151 Somalia 2.983
## 152 152 Burkina Faso 3.016
## 153 153 Myanmar 3.045
## 154 154 Mali 3.061
## 155 155 Israel 3.108
## 156 156 South Sudan 3.117
## 157 157 Syria 3.184
## 158 158 Afghanistan 3.229
## 159 159 Yemen 3.262
## 160 160 Democratic Republic of the Congo 3.292
## 161 161 Sudan 3.323
## 162 162 Ukraine 3.434
## 163 163 Russia 3.441merged_world_data2 <- merged_world_data %>%
mutate(
category = case_when(
primary_import_source %in% nato_countries_ally ~ "Ally",
primary_import_source %in% competitors ~ "Competitor",
TRUE ~ "Neutral" # The 'TRUE' condition acts as the 'otherwise'
)
)
merged_world_data <- st_as_sf(merged_world_data)
world_map <- ne_countries(scale = "medium", returnclass = "sf")
ggplot() +
geom_sf(data = world_map, color = "darkgrey", size = 0.5) +
geom_sf(data = merged_world_data2, aes(fill = total_minerals)) +
# geom_sf_label(data = merged_world_data2, aes(label = category)) +# Set border color and thickness
scale_fill_gradient(low="thistle1", high="violetred4", na.value = "black") +
geom_sf_label(data = merged_world_data2, aes(label = category), fill = "white") +# Set border color and thickness
labs(title = "Leading Primary Import Source for Critical Minerals, 2024",
subtitle = "Some countries that are the primary source of critical minerals are allies, yet some are competitors of the U.S.\nChina, a competitor, has the highest amount of critical minerals.",
fill = "Number of Critical Minerals",
caption = "Data from U.S. Census Bureau. An Ally is a member of NATO.\nA competitor is a country listed as a threat from The Annual Threat Assessment.\nA Neutral Party is not a labelled ally nor a competitor.") +
theme_void() # A clean theme without axis lines
Conclusion: trends in threat of crisis
# trends - threat of crisis on the rise
# gpr_data1
gpr_data1$year <- as.integer(format(gpr_data1$date, "%Y"))
gpr_data1$colors <- ifelse(gpr_data1$year > 2019, "highlight", "gray")
gpr_data1 %>%
ggplot( aes(x=date, y=GPR, color = colors)) +
geom_line(linewidth = .75) +
scale_color_manual(values = c("highlight" = lighten("steelblue", 0.2), "gray" = "gray")) +
labs(
title = "Geopolitical Risk (GPR) Index",
subtitle = "From official documentation, the GPR index spikes around wars. Higher geopolitical risk\nforeshadows lower investment, stock prices, and employment. Higher geopolitical risk is\nalso associated with higher probability of economic disasters and with\nlarger downside risks to the global economy.",
caption = "Data from Caldara, Dario and Matteo Iacoviello (2022),\n“Measuring Geopolitical Risk,” American Economic Review,\nApril, 112(4), pp.1194-1225.",
y = "Index",
x = "Date"
) +
guides(fill = "none") +
# geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"),
# linetype = "solid",
# linewidth = 0.75,
# color = "black",
# data = df_2001_attack2) +
annotate(geom="point", x=as.Date("2001-09-01"), y=498.65, size=2.5, shape=21, fill="grey") +
annotate(geom="text", x=as.Date("2001-09-01"), y=538.65,
size=3.5,
label="9/11") +
annotate(geom="point", x=as.Date("2003-03-01"), y=358.71, size=2.5, shape=21, fill="grey") +
annotate(geom="text", x=as.Date("2003-03-01"), y=428.71,
size=3.5,
label="2003\nIraq\nWar") +
annotate(geom="point", x=as.Date("2008-09-01"), y=88.54, size=2.5, shape=21, fill="grey") +
annotate(geom="text", x=as.Date("2008-09-01"), y=148.54,
size=3.5,
label="2008\nRecession") +
annotate(geom="point", x=as.Date("2020-02-01"), y=75.96, size=2.5, shape=21, fill="steelblue") +
annotate(geom="text", x=as.Date("2020-02-01"), y=125.96,
size=3.5,
label="COVID") +
annotate(geom="point", x=as.Date("2022-02-01"), y=216.16, size=2.5, shape=21, fill="steelblue") +
annotate(geom="text", x=as.Date("2021-01-01"), y=256.16,
size=3.5,
label="Russia-Ukraine\nWar") +
annotate(geom="point", x=as.Date("1990-08-01"), y=250.45, size=2.5, shape=21, fill="grey") +
annotate(geom="text", x=as.Date("1990-08-01"), y=300.45,
size=3.5,
label="Gulf\nWar") +
theme_classic() +
annotate(geom="text", x=as.Date("2015-08-01"), y=375, fontface = "bold",
label="GPR has been on the rise for recent years.") +
theme(legend.position = "none")
# set up the data frame
us_exports_imports_trends_filtered_tidy3 <- us_exports_imports_trends_filtered_tidy2 |>
filter(year > 2019 & year < 2025)
us_exports_imports_trends_filtered_tidy3_imports <- us_exports_imports_trends_filtered_tidy3 |>
filter(type == "I")
gpr_data1$year <- as.integer(format(gpr_data1$date, "%Y"))
gpr_data2 <- gpr_data1 |>
filter(year > 2019 & year < 2025)
merged_df <- cbind(us_exports_imports_trends_filtered_tidy3_imports, gpr_data2)
merged_df <- merged_df[,c(8, 9, 11, 12, 13)]
head(merged_df)## usd_amount_millions date GPR year colors
## 1 195796.2 2020-01-01 138.42 2020 highlight
## 2 178108.0 2020-02-01 75.96 2020 highlight
## 3 193922.8 2020-03-01 81.54 2020 highlight
## 4 165611.9 2020-04-01 69.34 2020 highlight
## 5 163494.1 2020-05-01 68.51 2020 highlight
## 6 179138.1 2020-06-01 71.23 2020 highlight# relationship between crisis factor and number of exports
p <- ggplot(merged_df, aes(x=usd_amount_millions, y=GPR, fill=year)) +
geom_jitter(
# aes(size = total_hurricane_typhoons_tornadoes_count),
# size = total_hurricane_typhoons_tornadoes_count,
pch = 21, # Type of point that allows us to have both color (border) and fill.
# color = "red",
# fill = "red",
stroke = 1 # The width of the border, i.e. stroke
) +
annotate("label", x = 250000, y = 275, label = "As the reliance on imports increases over time,\nso does the risk of a world crisis.", size = 3.5, fill =
"white", color = "black", label.size = 1, label.color="white") +
labs(
title = "As Crisis Risk Increases, Reliance Increases Too",
subtitle = "We must be careful, because as the risk of world crisis increases over the years, so does\nthe reliance on foreign countries, even comprtitors. The impact of a crisis with a primary\nsource country that's also a competitor could be major.",
y = "GPR",
x = "Millions of U.S. Dollars Spent for U.S. Imports"
) +
scale_fill_gradient(low = "skyblue", high = "slateblue4", name="Year", breaks = c(2020, 2021, 2022, 2023, 2024), labels = c(2020, 2021, 2022, 2023, 2024)) +
geom_segment(aes(x = 163494.1, y = 50, xend = 288127.3, yend = 150),
arrow = arrow(length = unit(0.5, "cm"), type = "closed"),
color = "red",
size = 1,
linetype = "solid"
) +
theme(legend.position = "bottom")
p