sim_clean <- read_rds(here("data", "derived_data", "sim_final.rds"))
results <- read_rds(here("data", "raw_data", "final_data.rds"))
org_attributes <- tribble(
~`Issue area`, ~`Relationship with government`, ~`Funding`, ~`Funding sources`, ~`Organizational practices`, ~`Organization`,
"Emergency response", "Friendly", "Small private donors", "Small private donors", "Financial transparency", "Amnesty International",
"Environment", "Criticized", "Government grants", "Wealthy donors", "Accountability", "Greenpeace",
"Human rights", "Crackdown", "", "Government grants", "", "Oxfam",
"Refugee relief", "", "", "", "", "Red Cross"
)
persona_attributes <- tribble(
~`Demographics`, ~`Politics and public affairs`, ~`Social views`,
"Higher income (> US median ($61,372)), high school graduate, frequent religious attendance", "Liberal (1), follows national and international news often, has traveled internationally", "High social trust: Trusts political institutions, trusts charities, thinks people should be more charitable, frequently volunteers, donates once a month, has a history of personal activism, is a member of an association",
"Lower income (< US median), high school graduate, frequent religious attendance", "Conservative (7), follows news, has traveled", "Low social trust: Does not trust political institutions or charities, thinks people should be less charitable, does not volunteer or donate often, has no history of personal activism, is not a member of an association",
"Higher income, college graduate, frequent religious attendance", "Liberal, does not follow news, has not traveled", "",
"Lower income, college graduate, frequent religious attendance", "Conservative, does not follow news, has not traveled", "",
"Higher income, high school graduate, rare religious attendance", "", "",
"Lower income, high school graduate, rare religious attendance", "", "",
"Higher income, college graduate, rare religious attendance", "", "",
"Lower income, college graduate, rare religious attendance", "", ""
)
org_attributes %>%
select(Organization, `Issue area`, `Organizational practices`, `Funding sources`, `Relationship with government`) %>%
pandoc.table.return(caption = 'Organization attributes varied in the experiment {#tbl:organization-attributes-full}',
justify = "lllll", split.tables = Inf) %T>%
cat() %>%
cat(file = here("analysis", "output", "tables", "tbl-organization-attributes-full.md"))
Organization | Issue area | Organizational practices | Funding sources | Relationship with government |
---|---|---|---|---|
Amnesty International | Emergency response | Financial transparency | Small private donors | Friendly |
Greenpeace | Environment | Accountability | Wealthy donors | Criticized |
Oxfam | Human rights | Government grants | Crackdown | |
Red Cross | Refugee relief |
org_attributes %>%
select(`Issue area`, `Relationship with government`, `Funding`) %>%
pandoc.table.return(caption = 'Organization attributes varied in the simulation, resulting in 24 hypothetical organizations {#tbl:organization-attributes}',
justify = "lll") %T>%
cat() %>%
cat(file = here("analysis", "output", "tables", "tbl-organization-attributes.md"))
Issue area | Relationship with government | Funding |
---|---|---|
Emergency response | Friendly | Small private donors |
Environment | Criticized | Government grants |
Human rights | Crackdown | |
Refugee relief |
persona_attributes %>%
pandoc.table.return(caption = 'Individual attributes varied in the simulation, resulting in 64 persona profiles {#tbl:persona-attributes}',
justify = "lll", split.tables = Inf) %T>%
cat() %>%
cat(file = here("analysis", "output", "tables", "tbl-persona-attributes.md"))
Demographics | Politics and public affairs | Social views |
---|---|---|
Higher income (> US median ($61,372)), high school graduate, frequent religious attendance | Liberal (1), follows national and international news often, has traveled internationally | High social trust: Trusts political institutions, trusts charities, thinks people should be more charitable, frequently volunteers, donates once a month, has a history of personal activism, is a member of an association |
Lower income (< US median), high school graduate, frequent religious attendance | Conservative (7), follows news, has traveled | Low social trust: Does not trust political institutions or charities, thinks people should be less charitable, does not volunteer or donate often, has no history of personal activism, is not a member of an association |
Higher income, college graduate, frequent religious attendance | Liberal, does not follow news, has not traveled | |
Lower income, college graduate, frequent religious attendance | Conservative, does not follow news, has not traveled | |
Higher income, high school graduate, rare religious attendance | ||
Lower income, high school graduate, rare religious attendance | ||
Higher income, college graduate, rare religious attendance | ||
Lower income, college graduate, rare religious attendance |
example_personas <- c("persona2", "persona63")
example_persona_details <- sim_clean %>%
filter(persona_id %in% example_personas) %>%
select(starts_with("persona")) %>%
slice(1:2)
example_persona_details %>%
select(-persona_id) %>%
pivot_longer(cols = !persona) %>%
pivot_wider(names_from = "persona", values_from = "value") %>%
select(-name) %>%
pandoc.table(justify = "ll")
Persona 2 | Persona 63 |
---|---|
Lower income | Higher income |
High school graduate | College graduate |
Rarely attends religious services | Attends at least monthly |
Liberal | Conservative |
Follows the news; has travelled abroad | Doesn’t follow news; has not travelled abroad |
Less trusting; donates and volunteers less often | More trusting; donates and volunteers often |
example_persona_results <- sim_clean %>%
filter(persona_id %in% example_personas) %>%
mutate(org_funding = str_to_sentence(str_remove(org_funding, "Mostly funded by "))) %>%
mutate(org_clean = glue("{organization}: {org_issue}, {org_funding}, {org_relationship}")) %>%
mutate(persona_desc = recode(
persona_id,
"persona2" = "Lower income high school graduate who rarely attends religious services; liberal who reads and travels; doesn't trust or donate",
"persona63" = "Higher income college graduate who attends religious services; conservative who doesn't read or travel; trusts and donates")
) %>%
mutate(persona_clean = glue("{persona}: {persona_desc}")) %>%
select(persona_clean, share, org_clean) %>%
pivot_wider(names_from = "persona_clean", values_from = "share") %>%
adorn_totals(where = "row", name = "**Total**")
example_persona_results_small <- example_persona_results %>%
slice(c(1, 2, 3, 7, 8, 9, 16, 17, 25)) %>%
mutate(across(where(is.numeric), ~ percent_format(accuracy = 0.1)(.))) %>%
add_row(org_clean = "…", .after = 3) %>%
add_row(org_clean = "…", .after = 7) %>%
add_row(org_clean = "…", .after = 10) %>%
mutate(across(everything(), ~replace_na(., "…"))) %>%
rename(Organization = org_clean)
example_persona_results_small %>%
pandoc.table.return(caption = 'Sample simulation output {#tbl:sim-output}',
justify = "lcc", split.tables = Inf) %T>%
cat() %>%
cat(file = here("analysis", "output", "tables", "tbl-sim-output.md"))
Organization | Persona 2: Lower income high school graduate who rarely attends religious services; liberal who reads and travels; doesn’t trust or donate | Persona 63: Higher income college graduate who attends religious services; conservative who doesn’t read or travel; trusts and donates |
---|---|---|
Org 1: Emergency response, Small donors, Friendly | 11.4% | 3.3% |
Org 2: Emergency response, Government grants, Friendly | 7.2% | 11.1% |
Org 3: Emergency response, Small donors, Criticized | 1.1% | 1.3% |
… | … | … |
Org 7: Environment, Small donors, Friendly | 10.2% | 1.6% |
Org 8: Environment, Government grants, Friendly | 6.5% | 5.2% |
Org 9: Environment, Small donors, Criticized | 1.0% | 0.6% |
… | … | … |
Org 16: Human rights, Government grants, Criticized | 0.7% | 6.8% |
Org 17: Human rights, Small donors, Under crackdown | 0.9% | 2.0% |
… | … | … |
Total | 100.0% | 100.0% |
vars_to_summarize <- tribble(
~category, ~variable, ~clean_name,
"Demographics", "Q5.12", "Gender",
"Demographics", "Q5.17", "Age",
"Demographics", "Q5.13", "Marital status",
"Demographics", "Q5.14", "Education",
"Demographics", "Q5.15", "Income",
"Attitudes toward charity", "Q2.5", "Frequency of donating to charity",
"Attitudes toward charity", "Q2.6", "Amount of donations to charity last year",
"Attitudes toward charity", "Q2.7_f", "Importance of trusting charities",
"Attitudes toward charity", "Q2.8_f", "Level of trust in charities",
"Attitudes toward charity", "Q2.10", "Frequency of volunteering",
"Politics, ideology, and religion", "Q2.1", "Frequency of following national news",
"Politics, ideology, and religion", "Q5.7", "Traveled to a developing country",
"Politics, ideology, and religion", "Q5.1", "Voted in last election",
"Politics, ideology, and religion", "Q5.6_f", "Trust in political institutions and the state",
"Politics, ideology, and religion", "Q5.2_f", "Political ideology",
"Politics, ideology, and religion", "Q5.4", "Involvement in activist causes",
"Politics, ideology, and religion", "Q5.8", "Frequency of attending religious services",
"Politics, ideology, and religion", "Q5.9", "Importance of religion"
)
summarize_factor <- function(x) {
output <- table(x) %>%
as_tibble() %>%
magrittr::set_colnames(., c("level", "count")) %>%
mutate(level = factor(level, levels = levels(x))) %>%
mutate(prop = count / sum(count),
nice_prop = scales::percent(prop))
return(list(output))
}
participant_summary <- results %>%
select(one_of(vars_to_summarize$variable)) %>%
summarize_all(summarize_factor) %>%
pivot_longer(cols = everything(), names_to = "variable", values_to = "details") %>%
left_join(vars_to_summarize, by = "variable") %>%
unnest(details) %>%
mutate(level = as.character(level)) %>%
mutate(level = case_when(
variable == "Q2.7_f" & level == "1" ~ "1 (not important)",
variable == "Q2.7_f" & level == "7" ~ "7 (important)",
variable == "Q2.8_f" & level == "1" ~ "1 (no trust)",
variable == "Q2.8_f" & level == "7" ~ "7 (complete trust)",
variable == "Q5.6_f" & level == "1" ~ "1 (no trust)",
variable == "Q5.6_f" & level == "7" ~ "7 (complete trust)",
variable == "Q5.2_f" & level == "1" ~ "1 (extremely liberal)",
variable == "Q5.2_f" & level == "7" ~ "7 (extremely conservative)",
variable == "Q5.15" & level == "Less than median" ~ "Less than 2017 national median ($61,372)",
variable == "Q5.17" & level == "Less than median" ~ "Less than 2017 national median (36)",
TRUE ~ level
)) %>%
mutate(clean_name_shrunk = ifelse(clean_name == lag(clean_name), "", clean_name),
clean_name_shrunk = ifelse(is.na(clean_name_shrunk),
clean_name[1],
clean_name_shrunk),
category_shrunk = ifelse(category == lag(category), "", category),
category_shrunk = ifelse(is.na(category_shrunk),
category[1],
category_shrunk))
participant_summary %>%
select("Category" = category_shrunk, "Question" = clean_name_shrunk,
"Response" = level, "N" = count, "%" = nice_prop) %>%
pandoc.table.return(caption = 'Summary of individual respondent characteristics {#tbl:sample-details}',
justify = "lllcc", split.tables = Inf) %T>%
cat() %>%
cat(file = here("analysis", "output", "tables", "tbl-sample-details.md"))
Category | Question | Response | N | % |
---|---|---|---|---|
Demographics | Gender | Male | 517 | 50.89% |
Female | 485 | 47.74% | ||
Transgender | 8 | 0.79% | ||
Prefer not to say | 3 | 0.30% | ||
Other | 3 | 0.30% | ||
Age | Less than 2017 national median (36) | 179 | 18% | |
More than median | 837 | 82% | ||
Marital status | Married | 403 | 39.7% | |
Widowed | 21 | 2.1% | ||
Divorced | 104 | 10.2% | ||
Separated | 35 | 3.4% | ||
Never married | 453 | 44.6% | ||
Education | Less than high school | 25 | 2.5% | |
High school graduate | 270 | 26.6% | ||
Some college | 287 | 28.2% | ||
2 year degree | 138 | 13.6% | ||
4 year degree | 206 | 20.3% | ||
Graduate or professional degree | 82 | 8.1% | ||
Doctorate | 8 | 0.8% | ||
Income | Less than 2017 national median ($61,372) | 585 | 58% | |
More than median | 431 | 42% | ||
Attitudes toward charity | Frequency of donating to charity | More than once a month, less than once a year | 566 | 56% |
At least once a month | 450 | 44% | ||
Amount of donations to charity last year | $1-$49 | 337 | 33.17% | |
$50-$99 | 245 | 24.11% | ||
$100-$499 | 233 | 22.93% | ||
$500-$999 | 107 | 10.53% | ||
$1000-$4,999 | 65 | 6.40% | ||
$5000-$9,999 | 18 | 1.77% | ||
$10,000+ | 11 | 1.08% | ||
Importance of trusting charities | 1 (not important) | 7 | 0.69% | |
2 | 9 | 0.89% | ||
3 | 21 | 2.07% | ||
4 | 98 | 9.65% | ||
5 | 168 | 16.54% | ||
6 | 157 | 15.45% | ||
7 (important) | 556 | 54.72% | ||
Level of trust in charities | 1 (no trust) | 14 | 1.38% | |
2 | 20 | 1.97% | ||
3 | 68 | 6.69% | ||
4 | 257 | 25.30% | ||
5 | 328 | 32.28% | ||
6 | 169 | 16.63% | ||
7 (complete trust) | 160 | 15.75% | ||
Frequency of volunteering | Haven’t volunteered in past 12 months | 423 | 41.6% | |
Rarely | 20 | 2.0% | ||
More than once a month, less than once a year | 322 | 31.7% | ||
At least once a month | 251 | 24.7% | ||
Politics, ideology, and religion | Frequency of following national news | Rarely | 88 | 9% |
Once a week | 216 | 21% | ||
At least once a day | 712 | 70% | ||
Traveled to a developing country | Yes | 250 | 25% | |
No | 766 | 75% | ||
Voted in last election | Yes | 742 | 73% | |
No | 274 | 27% | ||
Trust in political institutions and the state | 1 (no trust) | 123 | 12.11% | |
2 | 155 | 15.26% | ||
3 | 207 | 20.37% | ||
4 | 276 | 27.17% | ||
5 | 151 | 14.86% | ||
6 | 49 | 4.82% | ||
7 (complete trust) | 55 | 5.41% | ||
Political ideology | 1 (extremely liberal) | 87 | 8.56% | |
2 | 87 | 8.56% | ||
3 | 112 | 11.02% | ||
4 | 363 | 35.73% | ||
5 | 175 | 17.22% | ||
6 | 80 | 7.87% | ||
7 (extremely conservative) | 112 | 11.02% | ||
Involvement in activist causes | Not involved | 569 | 56% | |
Involved | 447 | 44% | ||
Frequency of attending religious services | Not sure | 11 | 1% | |
Rarely | 600 | 59% | ||
At least once a month | 405 | 40% | ||
Importance of religion | Not important | 338 | 33% | |
Important | 678 | 67% |
## ─ 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)
## 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)
## 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)
## janitor * 2.0.1 2020-04-12 [1] CRAN (R 4.0.0)
## 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)
## 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)
## 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)
## snakecase 0.11.0 2019-05-25 [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)
## 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