State of the noosphere: 2012-2019
About
Making plots for data in Nature Index 2020 by Anatoly Karlin.
Init
options(digits = 3)
library(pacman)
p_load(kirkegaard, ggrepel)
theme_set(theme_bw())Data
#via Karlin
#https://www.unz.com/akarlin/nature-index-2020/
nature_index = read_csv("data/data.csv") %>%
#add ISO
mutate(
ISO = pu_translate(Country)
)## Parsed with column specification:
## cols(
## X = col_double(),
## Country = col_character(),
## year = col_double(),
## percent = col_double()
## )#various data country data
#from Time Preferences study
time_pref_data = read_rds("data/time_pref_data_out.rds")
assert_that(!any(duplicated(time_pref_data$ISO)))## [1] TRUE#join
d = left_join(nature_index, time_pref_data %>% select(-Country), by = "ISO") %>%
#mutate region
mutate(
UN_macroregion = case_when(
Country == "China" ~ "China",
TRUE ~ UN_macroregion %>% as.character()
)
)
#merge by UN groups
d_macroregion = d %>%
plyr::ddply(c("year", "UN_macroregion"), function(dd) {
#sum the percents
tibble(
percent = sum(dd$percent)
)
})
#West vs. China vs. Rest
d %<>% mutate(
west_rest = case_when(
Country == "China" ~ "China",
UN_macroregion %in% c("N & W Europe + offshoots", "Eastern Europe", "Southern Europe") ~ "West",
TRUE ~ "Rest"
)
)
d_west_rest = d %>%
plyr::ddply(c("year", "west_rest"), function(dd) {
#sum the percents
tibble(
percent = sum(dd$percent)
)
})
#relative to 2012, countries
d_relative = d %>%
plyr::ddply("Country", function(dd) {
tibble(
year = dd$year,
index = (dd$percent / dd$percent[1]) * 100,
UN_macroregion = dd$UN_macroregion,
west_rest = dd$west_rest
)
})
#macroregions relative
d_relative_macroregions = d_macroregion %>%
plyr::ddply("UN_macroregion", function(dd) {
tibble(
year = dd$year,
index = (dd$percent / dd$percent[1]) * 100
)
})Plot
#absolute countries
y_scale = scale_y_continuous("Percent of publications, %", breaks = seq(0, 80, 10))
#absolute countries
d %>%
#filter NA
filter(!is.na(Country)) %>%
ggplot(aes(year, percent, color = Country)) +
geom_line() +
y_scale +
scale_color_discrete("Region", guide = F) +
geom_text_repel(data = d %>% filter(year == 2019),
mapping = aes(label = Country),
nudge_x = -.5,
segment.colour = "grey") +
ggtitle("Top 25 countries on Nature index 2012-2019",
"Absolute proportions")
GG_save("figs/absolute_countries.png")
#absolute macroregions
d_macroregion %>%
ggplot(aes(year, percent, color = UN_macroregion)) +
geom_line() +
y_scale +
scale_color_discrete("Region", guide = F) +
geom_text_repel(data = d_macroregion %>% filter(year == 2019),
mapping = aes(label = UN_macroregion),
nudge_x = -.5,
segment.colour = "grey") +
ggtitle("Regions on Nature index 2012-2019",
"Absolute proportions")
GG_save("figs/absolute_regions.png")
#West vs. China vs. rest
d_west_rest %>%
ggplot(aes(year, percent, color = west_rest)) +
geom_line() +
y_scale +
scale_color_discrete("Region", guide = F) +
geom_text_repel(data = d_west_rest %>% filter(year == 2019),
mapping = aes(label = west_rest),
nudge_x = -.5,
segment.colour = "grey") +
ggtitle("West vs. China vs. Rest on Nature index 2012-2019",
"Absolute proportions")
GG_save("figs/absolute_west_rest.png")
#relative proportions, countries
d_relative %>%
#filter NA
filter(!is.na(Country)) %>%
ggplot(aes(year, index, color = Country)) +
geom_line() +
scale_y_continuous("Performance relative to 2012, %") +
scale_color_discrete("Region", guide = F) +
geom_text_repel(data = d_relative %>% filter(year == 2019),
mapping = aes(label = Country),
nudge_x = -.5,
segment.colour = "grey") +
ggtitle("Top 25 countries on Nature index 2012-2019",
"Relative to 2012")
GG_save("figs/relative_countries.png")
#relative proportions, regions
d_relative_macroregions %>%
ggplot(aes(year, index, color = UN_macroregion)) +
geom_line() +
geom_text_repel(data = d_relative_macroregions %>% filter(year == 2019),
mapping = aes(label = UN_macroregion),
nudge_x = -.5,
segment.colour = "grey") +
scale_y_continuous("Performance relative to 2012, %", breaks = seq(0, 800, 20)) +
scale_color_discrete("Region", guide = F) +
ggtitle("Regions on Nature index 2012-2019",
"Relative to 2012")
GG_save("figs/relative_regions.png")Meta
write_sessioninfo()## R version 4.0.0 (2020-04-24)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Linux Mint 19.3
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=de_DE.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=de_DE.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=de_DE.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] ggrepel_0.8.2 kirkegaard_2020-05-16 metafor_2.4-0
## [4] Matrix_1.2-18 psych_1.9.12.31 magrittr_1.5
## [7] assertthat_0.2.1 weights_1.0.1 mice_3.9.0
## [10] gdata_2.18.0 Hmisc_4.4-0 Formula_1.2-3
## [13] survival_3.1-12 lattice_0.20-41 forcats_0.5.0
## [16] stringr_1.4.0 dplyr_0.8.5 purrr_0.3.4
## [19] readr_1.3.1 tidyr_1.0.3 tibble_3.0.1
## [22] ggplot2_3.3.0 tidyverse_1.3.0 pacman_0.5.1
##
## loaded via a namespace (and not attached):
## [1] nlme_3.1-147 fs_1.4.1 lubridate_1.7.8
## [4] RColorBrewer_1.1-2 httr_1.4.1 tools_4.0.0
## [7] backports_1.1.7 R6_2.4.1 rpart_4.1-15
## [10] DBI_1.1.0 colorspace_1.4-1 nnet_7.3-14
## [13] withr_2.2.0 tidyselect_1.1.0 gridExtra_2.3
## [16] mnormt_1.5-7 compiler_4.0.0 cli_2.0.2
## [19] rvest_0.3.5 htmlTable_1.13.3 xml2_1.3.2
## [22] labeling_0.3 scales_1.1.1 checkmate_2.0.0
## [25] digest_0.6.25 foreign_0.8-76 rmarkdown_2.1
## [28] base64enc_0.1-3 jpeg_0.1-8.1 pkgconfig_2.0.3
## [31] htmltools_0.4.0 dbplyr_1.4.3 htmlwidgets_1.5.1
## [34] rlang_0.4.6 readxl_1.3.1 rstudioapi_0.11
## [37] farver_2.0.3 generics_0.0.2 jsonlite_1.6.1
## [40] gtools_3.8.2 acepack_1.4.1 Rcpp_1.0.4.6
## [43] munsell_0.5.0 fansi_0.4.1 lifecycle_0.2.0
## [46] stringi_1.4.6 yaml_2.2.1 plyr_1.8.6
## [49] grid_4.0.0 parallel_4.0.0 crayon_1.3.4
## [52] haven_2.2.0 splines_4.0.0 hms_0.5.3
## [55] knitr_1.28 pillar_1.4.4 reprex_0.3.0
## [58] glue_1.4.1 evaluate_0.14 latticeExtra_0.6-29
## [61] data.table_1.12.8 modelr_0.1.7 png_0.1-7
## [64] vctrs_0.3.0 cellranger_1.1.0 gtable_0.3.0
## [67] xfun_0.13 broom_0.5.6 cluster_2.1.0
## [70] ellipsis_0.3.1