library(tidyverse)
library(scales)
library(patchwork)
library(ggstance)
library(here)
# Wrap factor levels
# via Hadley: https://github.com/tidyverse/stringr/issues/107#issuecomment-233723948
str_wrap_factor <- function(x, ...) {
levels(x) <- str_wrap(levels(x), ...)
x
}
# Turn off grouping message
options(dplyr.summarise.inform = FALSE)
# Project-specific functions
source(here("R", "graphics.R"))
# General settings
source(here("analysis", "options.R"))
# Make all the randomness reproducible
set.seed(1234)
sim_excel_clean <- read_rds(here("data", "derived_data", "sim_excel_final.rds"))
sim_clean <- read_rds(here("data", "derived_data", "sim_final.rds"))
Based on data from Giving USA, philanthropy in the United states continues to increase, both in aggregate and per capita.
giving_aggregate_raw <- read_csv(here("data", "raw_data", "data-FTjUv.csv"))
giving_aggregate <- giving_aggregate_raw %>%
mutate(total = `Total donations` * 1000000000)
giving_per_capita_raw <- read_csv(here("data", "raw_data", "data-xextT.csv"))
giving_per_capita <- giving_per_capita_raw
ggplot(giving_aggregate, aes(x = Year, y = `Total donations`)) +
geom_line(size = 1, color = clrs_ngo$vi_blue_dark) +
scale_x_continuous(breaks = seq(1980, 2015, 5)) +
scale_y_continuous(labels = dollar, breaks = seq(100, 450, 50)) +
coord_cartesian(ylim = c(100, 450)) +
labs(x = NULL, y = "Billions of dollars") +
theme_ngo()
ggplot(giving_per_capita, aes(x = Year, y = `Average giving`)) +
geom_line(size = 1, color = clrs_ngo$vi_blue_dark) +
scale_x_continuous(breaks = seq(2000, 2014, 2)) +
scale_y_continuous(labels = dollar, breaks = seq(1750, 2750, 250)) +
coord_cartesian(ylim = c(1750, 2750)) +
labs(x = NULL, y = "Average annual donation") +
theme_ngo()
plot_income_issue <- sim_clean %>%
group_by(org_issue, persona_income) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Issue area") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_issue, 15)),
x = avg_share, color = fct_rev(persona_income))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002)),
breaks = seq(0, 0.06, 0.02)) +
scale_color_manual(values = c(clrs_ngo$vi_turquoise, clrs_ngo$vi_purple), guide = FALSE) +
coord_cartesian(xlim = c(0, 0.06)) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(facet)) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_income_funding <- sim_clean %>%
group_by(org_funding, persona_income) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Funding sources") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_funding, 10)),
x = avg_share, color = fct_rev(persona_income))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.06)) +
scale_color_manual(values = c(clrs_ngo$vi_turquoise, clrs_ngo$vi_purple), guide = FALSE) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(facet)) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_income_relationship <- sim_clean %>%
mutate(persona_income = fct_recode(persona_income,
"< $61,372/year" = "Lower income",
"> $61,372/year" = "Higher income")) %>%
group_by(org_relationship, persona_income) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Relationship with host government") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_relationship, 10)),
x = avg_share, color = fct_rev(persona_income))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.003))) +
coord_cartesian(xlim = c(0, 0.1)) +
scale_color_manual(values = c(clrs_ngo$vi_turquoise, clrs_ngo$vi_purple),
guide = guide_legend(reverse = TRUE, nrow = 1,
override.aes = list(size = 0.25))) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(str_wrap(facet, 50))) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_income_relationship_extreme <- sim_excel_clean %>%
mutate(persona_income = fct_recode(persona_income,
"$50,000/year" = "Lower income",
"$100,000/year" = "Higher income"),
org_relationship = fct_recode(org_relationship,
"Under crackdown" = "Crackdown")) %>%
group_by(org_relationship, persona_income) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Relationship with host government") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_relationship, 10)),
x = avg_share, color = fct_rev(persona_income))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.1)) +
scale_color_manual(values = c(clrs_ngo$pl_yellow, clrs_ngo$pl_purple_light),
guide = guide_legend(reverse = TRUE, nrow = 1,
override.aes = list(size = 0.25))) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(str_wrap(facet, 50))) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_income <- ((plot_income_issue + labs(x = NULL)) +
(plot_income_funding + labs(x = NULL))) /
(plot_income_relationship + plot_income_relationship_extreme)
plot_income
ggsave(plot_income, filename = here("analysis", "output", "figures", "income-all.pdf"),
width = 6, height = 4.5, units = "in", device = cairo_pdf)
ggsave(plot_income, filename = here("analysis", "output", "figures", "income-all.png"),
width = 6, height = 4.5, units = "in", type = "cairo", dpi = 300)
plot_education_issue <- sim_clean %>%
group_by(org_issue, persona_education) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Issue area") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_issue, 15)),
x = avg_share, color = fct_rev(persona_education))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.06)) +
scale_color_manual(values = c(clrs_ngo$pl_purple_dark, clrs_ngo$pl_orange), guide = FALSE) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(facet)) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_education_funding <- sim_clean %>%
group_by(org_funding, persona_education) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Funding sources") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_funding, 10)),
x = avg_share, color = fct_rev(persona_education))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.06)) +
scale_color_manual(values = c(clrs_ngo$pl_purple_dark, clrs_ngo$pl_orange), guide = FALSE) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(facet)) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_education_relationship <- sim_clean %>%
group_by(org_relationship, persona_education) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Relationship with host government") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_relationship, 10)),
x = avg_share, color = fct_rev(persona_education))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.1)) +
scale_color_manual(values = c(clrs_ngo$pl_purple_dark, clrs_ngo$pl_orange),
guide = guide_legend(reverse = TRUE, ncol = 1,
override.aes = list(size = 0.25)),
labels = label_wrap(15)) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(str_wrap(facet, 20))) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_education <- plot_education_issue + plot_education_funding +
plot_education_relationship + guide_area() +
plot_layout(guides = "collect", ncol = 4)
plot_education
plot_religion_issue <- sim_clean %>%
group_by(org_issue, persona_religion) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Issue area") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_issue, 15)),
x = avg_share, color = fct_rev(persona_religion))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.06)) +
scale_color_manual(values = c(clrs_ngo$vi_blue_light, clrs_ngo$vi_yellow), guide = FALSE) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(facet)) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_religion_funding <- sim_clean %>%
group_by(org_funding, persona_religion) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Funding sources") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_funding, 10)),
x = avg_share, color = fct_rev(persona_religion))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.06)) +
scale_color_manual(values = c(clrs_ngo$vi_blue_light, clrs_ngo$vi_yellow), guide = FALSE) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(facet)) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_religion_relationship <- sim_clean %>%
group_by(org_relationship, persona_religion) %>%
summarize(avg_share = mean(share)) %>%
mutate(facet = "Relationship with host government") %>%
ggplot(aes(y = fct_rev(str_wrap_factor(org_relationship, 10)),
x = avg_share, color = fct_rev(persona_religion))) +
geom_pointrangeh(size = 0.75, fatten = 1.5,
aes(xmin = 0, xmax = ..x..), position = position_dodge(width = 0.5)) +
scale_x_continuous(labels = percent_format(accuracy = 1), expand = expansion(add = c(0, 0.002))) +
coord_cartesian(xlim = c(0, 0.1)) +
scale_color_manual(values = c(clrs_ngo$vi_blue_light, clrs_ngo$vi_yellow),
guide = guide_legend(reverse = TRUE, ncol = 1,
override.aes = list(size = 0.25)),
labels = label_wrap(20)) +
labs(x = "Average donation share", y = NULL, color = NULL) +
facet_wrap(vars(str_wrap(facet, 20))) +
theme_ngo() +
theme(panel.grid.major.y = element_blank())
plot_religion <- plot_religion_issue + plot_religion_funding +
plot_religion_relationship + guide_area() +
plot_layout(guides = "collect", ncol = 4)
plot_religion
plot_education_religion <- (plot_education_issue + labs(x = NULL)) +
(plot_education_funding + labs(x = NULL)) +
(plot_education_relationship + labs(x = NULL)) +
guide_area() +
plot_religion_issue +
plot_religion_funding +
plot_religion_relationship +
plot_layout(guides = "collect", ncol = 4)
plot_education_religion
ggsave(plot_education_religion,
filename = here("analysis", "output", "figures", "education-religion-all.pdf"),
width = 6.5, height = 4.5, units = "in", device = cairo_pdf)
ggsave(plot_education_religion,
filename = here("analysis", "output", "figures", "education-religion-all.png"),
width = 6.5, height = 4.5, units = "in", type = "cairo", dpi = 300)
## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 4.0.2 (2020-06-22)
## os macOS Catalina 10.15.6
## system x86_64, darwin17.0
## ui X11
## language (EN)
## collate en_US.UTF-8
## ctype en_US.UTF-8
## tz America/New_York
## date 2020-10-01
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date lib source
## assertthat 0.2.1 2019-03-21 [1] CRAN (R 4.0.0)
## backports 1.1.9 2020-08-24 [1] CRAN (R 4.0.2)
## base64enc 0.1-3 2015-07-28 [1] CRAN (R 4.0.0)
## blob 1.2.1 2020-01-20 [1] CRAN (R 4.0.0)
## broom 0.7.0 2020-07-09 [1] CRAN (R 4.0.2)
## callr 3.4.3 2020-03-28 [1] CRAN (R 4.0.0)
## cellranger 1.1.0 2016-07-27 [1] CRAN (R 4.0.0)
## cli 2.0.2 2020-02-28 [1] CRAN (R 4.0.0)
## colorspace 1.4-1 2019-03-18 [1] CRAN (R 4.0.0)
## crayon 1.3.4 2017-09-16 [1] CRAN (R 4.0.0)
## DBI 1.1.0 2019-12-15 [1] CRAN (R 4.0.0)
## dbplyr 1.4.4 2020-05-27 [1] CRAN (R 4.0.2)
## desc 1.2.0 2018-05-01 [1] CRAN (R 4.0.0)
## devtools 2.3.1 2020-07-21 [1] CRAN (R 4.0.2)
## digest 0.6.25 2020-02-23 [1] CRAN (R 4.0.0)
## dplyr * 1.0.2 2020-08-18 [1] CRAN (R 4.0.2)
## ellipsis 0.3.1 2020-05-15 [1] CRAN (R 4.0.0)
## evaluate 0.14 2019-05-28 [1] CRAN (R 4.0.0)
## fansi 0.4.1 2020-01-08 [1] CRAN (R 4.0.0)
## farver 2.0.3 2020-01-16 [1] CRAN (R 4.0.0)
## forcats * 0.5.0 2020-03-01 [1] CRAN (R 4.0.0)
## fs 1.5.0 2020-07-31 [1] CRAN (R 4.0.2)
## generics 0.0.2 2018-11-29 [1] CRAN (R 4.0.0)
## ggplot2 * 3.3.2 2020-06-19 [1] CRAN (R 4.0.2)
## ggstance * 0.3.4 2020-04-02 [1] CRAN (R 4.0.0)
## glue 1.4.2 2020-08-27 [1] CRAN (R 4.0.2)
## gtable 0.3.0 2019-03-25 [1] CRAN (R 4.0.0)
## haven 2.3.1 2020-06-01 [1] CRAN (R 4.0.2)
## here * 0.1 2017-05-28 [1] CRAN (R 4.0.0)
## hms 0.5.3 2020-01-08 [1] CRAN (R 4.0.0)
## htmltools 0.5.0 2020-06-16 [1] CRAN (R 4.0.0)
## httr 1.4.2 2020-07-20 [1] CRAN (R 4.0.2)
## jsonlite 1.7.0 2020-06-25 [1] CRAN (R 4.0.2)
## knitr 1.29 2020-06-23 [1] CRAN (R 4.0.2)
## labeling 0.3 2014-08-23 [1] CRAN (R 4.0.0)
## lifecycle 0.2.0 2020-03-06 [1] CRAN (R 4.0.0)
## lubridate 1.7.9 2020-06-08 [1] CRAN (R 4.0.2)
## magrittr 1.5 2014-11-22 [1] CRAN (R 4.0.0)
## memoise 1.1.0 2017-04-21 [1] CRAN (R 4.0.0)
## modelr 0.1.8 2020-05-19 [1] CRAN (R 4.0.2)
## munsell 0.5.0 2018-06-12 [1] CRAN (R 4.0.0)
## pander 0.6.3 2018-11-06 [1] CRAN (R 4.0.0)
## patchwork * 1.0.1 2020-06-22 [1] CRAN (R 4.0.2)
## pillar 1.4.6 2020-07-10 [1] CRAN (R 4.0.2)
## pkgbuild 1.1.0 2020-07-13 [1] CRAN (R 4.0.2)
## pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 4.0.0)
## pkgload 1.1.0 2020-05-29 [1] CRAN (R 4.0.2)
## prettyunits 1.1.1 2020-01-24 [1] CRAN (R 4.0.0)
## processx 3.4.3 2020-07-05 [1] CRAN (R 4.0.0)
## ps 1.3.4 2020-08-11 [1] CRAN (R 4.0.2)
## purrr * 0.3.4 2020-04-17 [1] CRAN (R 4.0.0)
## R6 2.4.1 2019-11-12 [1] CRAN (R 4.0.0)
## Rcpp 1.0.5 2020-07-06 [1] CRAN (R 4.0.2)
## readr * 1.3.1 2018-12-21 [1] CRAN (R 4.0.0)
## readxl 1.3.1 2019-03-13 [1] CRAN (R 4.0.0)
## remotes 2.2.0 2020-07-21 [1] CRAN (R 4.0.2)
## reprex 0.3.0 2019-05-16 [1] CRAN (R 4.0.0)
## rlang 0.4.7 2020-07-09 [1] CRAN (R 4.0.2)
## rmarkdown 2.3 2020-06-18 [1] CRAN (R 4.0.2)
## rprojroot 1.3-2 2018-01-03 [1] CRAN (R 4.0.0)
## rstudioapi 0.11 2020-02-07 [1] CRAN (R 4.0.0)
## rvest 0.3.6 2020-07-25 [1] CRAN (R 4.0.2)
## scales * 1.1.1 2020-05-11 [1] CRAN (R 4.0.0)
## sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 4.0.0)
## stringi 1.4.6 2020-02-17 [1] CRAN (R 4.0.0)
## stringr * 1.4.0 2019-02-10 [1] CRAN (R 4.0.0)
## testthat 2.3.2 2020-03-02 [1] CRAN (R 4.0.0)
## tibble * 3.0.3 2020-07-10 [1] CRAN (R 4.0.2)
## tidyr * 1.1.2 2020-08-27 [1] CRAN (R 4.0.2)
## tidyselect 1.1.0 2020-05-11 [1] CRAN (R 4.0.0)
## tidyverse * 1.3.0 2019-11-21 [1] CRAN (R 4.0.0)
## usethis 1.6.1 2020-04-29 [1] CRAN (R 4.0.0)
## vctrs 0.3.4 2020-08-29 [1] CRAN (R 4.0.2)
## viridisLite 0.3.0 2018-02-01 [1] CRAN (R 4.0.0)
## withr 2.2.0 2020-04-20 [1] CRAN (R 4.0.0)
## xfun 0.16 2020-07-24 [1] CRAN (R 4.0.2)
## xml2 1.3.2 2020-04-23 [1] CRAN (R 4.0.0)
## yaml 2.2.1 2020-02-01 [1] CRAN (R 4.0.0)
##
## [1] /Library/Frameworks/R.framework/Versions/4.0/Resources/library
## # http://dirk.eddelbuettel.com/blog/2017/11/27/#011_faster_package_installation_one
## VER=
## CCACHE=ccache
## CC=$(CCACHE) gcc$(VER)
## CXX=$(CCACHE) g++$(VER)
## CXX11=$(CCACHE) g++$(VER)
## CXX14=$(CCACHE) g++$(VER)
## FC=$(CCACHE) gfortran$(VER)
## F77=$(CCACHE) gfortran$(VER)
##
## CXX14FLAGS=-O3 -march=native -mtune=native -fPIC
Social trust across issue area