JoslinSoto_Nicole_Project_202
2023-10-24
R
packages <- c("tidyverse", "modelsummary", "forcats", "RColorBrewer",
"fst", "viridis", "knitr", "rmarkdown", "ggridges", "viridis", "questionr", "flextable", "infer")
new_packages <- packages[!(packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)
lapply(packages, library, character.only = TRUE)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Loading required package: viridisLite
##
##
## Attaching package: 'flextable'
##
##
## The following object is masked from 'package:purrr':
##
## compose## [[1]]
## [1] "lubridate" "forcats" "stringr" "dplyr" "purrr" "readr"
## [7] "tidyr" "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [13] "grDevices" "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "modelsummary" "lubridate" "forcats" "stringr" "dplyr"
## [6] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [11] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [16] "datasets" "methods" "base"
##
## [[3]]
## [1] "modelsummary" "lubridate" "forcats" "stringr" "dplyr"
## [6] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [11] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [16] "datasets" "methods" "base"
##
## [[4]]
## [1] "RColorBrewer" "modelsummary" "lubridate" "forcats" "stringr"
## [6] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [11] "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [16] "utils" "datasets" "methods" "base"
##
## [[5]]
## [1] "fst" "RColorBrewer" "modelsummary" "lubridate" "forcats"
## [6] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [11] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [16] "grDevices" "utils" "datasets" "methods" "base"
##
## [[6]]
## [1] "viridis" "viridisLite" "fst" "RColorBrewer" "modelsummary"
## [6] "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [11] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [16] "stats" "graphics" "grDevices" "utils" "datasets"
## [21] "methods" "base"
##
## [[7]]
## [1] "knitr" "viridis" "viridisLite" "fst" "RColorBrewer"
## [6] "modelsummary" "lubridate" "forcats" "stringr" "dplyr"
## [11] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [16] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [21] "datasets" "methods" "base"
##
## [[8]]
## [1] "rmarkdown" "knitr" "viridis" "viridisLite" "fst"
## [6] "RColorBrewer" "modelsummary" "lubridate" "forcats" "stringr"
## [11] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [16] "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [21] "utils" "datasets" "methods" "base"
##
## [[9]]
## [1] "ggridges" "rmarkdown" "knitr" "viridis" "viridisLite"
## [6] "fst" "RColorBrewer" "modelsummary" "lubridate" "forcats"
## [11] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [16] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [21] "grDevices" "utils" "datasets" "methods" "base"
##
## [[10]]
## [1] "ggridges" "rmarkdown" "knitr" "viridis" "viridisLite"
## [6] "fst" "RColorBrewer" "modelsummary" "lubridate" "forcats"
## [11] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [16] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [21] "grDevices" "utils" "datasets" "methods" "base"
##
## [[11]]
## [1] "questionr" "ggridges" "rmarkdown" "knitr" "viridis"
## [6] "viridisLite" "fst" "RColorBrewer" "modelsummary" "lubridate"
## [11] "forcats" "stringr" "dplyr" "purrr" "readr"
## [16] "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [21] "graphics" "grDevices" "utils" "datasets" "methods"
## [26] "base"
##
## [[12]]
## [1] "flextable" "questionr" "ggridges" "rmarkdown" "knitr"
## [6] "viridis" "viridisLite" "fst" "RColorBrewer" "modelsummary"
## [11] "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [16] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [21] "stats" "graphics" "grDevices" "utils" "datasets"
## [26] "methods" "base"
##
## [[13]]
## [1] "infer" "flextable" "questionr" "ggridges" "rmarkdown"
## [6] "knitr" "viridis" "viridisLite" "fst" "RColorBrewer"
## [11] "modelsummary" "lubridate" "forcats" "stringr" "dplyr"
## [16] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [21] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [26] "datasets" "methods" "base"R Markdown
setwd("C:/Users/Erika/Desktop/SOC_202_YAY"
)
library(fst)
ess <- read_fst("All-ESS-Data.fst")netherlands_data <- ess %>%
filter(cntry == "NL") Task 1 & 2
write_fst(netherlands_data, "C:/Users/Erika/Desktop/SOC_202_YAY/netherlands_data.fst")
rm(list=ls()); gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 1258477 67.3 2276007 121.6 2276007 121.6
## Vcells 2128281 16.3 1256989930 9590.1 1354099347 10331.0Task 3
df <- read_fst("C:/Users/Erika/Desktop/SOC_202_YAY/netherlands_data.fst")Task 4
df$year <- NA
replacements <- c(2002, 2004, 2006, 2008, 2010, 2012, 2014, 2016, 2018, 2020)
for(i in 1:10){
df$year[df$essround == i] <- replacements[i]
}
netherlands_data <- dfnetherlands_data_table_subset <- netherlands_data %>%
mutate(
clsprty = ifelse(clsprty == 2, 0, ifelse(clsprty %in% c(7, 8, 9), NA, clsprty)),
stfdem = ifelse(stfdem %in% c(77, 88, 99), NA, stfdem),
trstplt = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt)
)
summary_table <- datasummary_skim(netherlands_data_table_subset %>% select(clsprty, stfdem, trstplt), output = "flextable")## Warning: The histogram argument is only supported for (a) output types "default",
## "html", "kableExtra", or "gt"; (b) writing to file paths with extensions
## ".html", ".jpg", or ".png"; and (c) Rmarkdown, knitr or Quarto documents
## compiled to PDF (via kableExtra) or HTML (via kableExtra or gt). Use
## `histogram=FALSE` to silence this warning.summary_table
| Unique (#) | Missing (%) | Mean | SD | Min | Median | Max |
|---|---|---|---|---|---|---|---|
clsprty | 3 | 1 | 0.6 | 0.5 | 0.0 | 1.0 | 1.0 |
stfdem | 12 | 2 | 6.1 | 1.8 | 0.0 | 6.0 | 10.0 |
trstplt | 12 | 1 | 5.0 | 1.9 | 0.0 | 5.0 | 10.0 |
netherlands_data_v2 <- netherlands_data_table_subset %>%
rename(
`Feeling Close to a Party` = clsprty,
`Satisfaction with Democracy` = stfdem,
`Trust in Politicians` = trstplt
)
summary_table_v2 <- datasummary_skim(netherlands_data_v2 %>% select(`Feeling Close to a Party`,`Satisfaction with Democracy`, `Trust in Politicians`), output = "flextable")## Warning: The histogram argument is only supported for (a) output types "default",
## "html", "kableExtra", or "gt"; (b) writing to file paths with extensions
## ".html", ".jpg", or ".png"; and (c) Rmarkdown, knitr or Quarto documents
## compiled to PDF (via kableExtra) or HTML (via kableExtra or gt). Use
## `histogram=FALSE` to silence this warning.summary_table_v2
| Unique (#) | Missing (%) | Mean | SD | Min | Median | Max |
|---|---|---|---|---|---|---|---|
Feeling Close to a Party | 3 | 1 | 0.6 | 0.5 | 0.0 | 1.0 | 1.0 |
Satisfaction with Democracy | 12 | 2 | 6.1 | 1.8 | 0.0 | 6.0 | 10.0 |
Trust in Politicians | 12 | 1 | 5.0 | 1.9 | 0.0 | 5.0 | 10.0 |
flextable::save_as_docx(summary_table_v2, path = "summary_table_v2.docx",
width = 7.0, height = 7.0)
set_flextable_defaults(fonts_ignore=TRUE)
print(summary_table_v2, preview = "pdf")## a flextable object.
## col_keys: ` `, `Unique (#)`, `Missing (%)`, `Mean`, `SD`, `Min`, `Median`, `Max`
## header has 1 row(s)
## body has 3 row(s)
## original dataset sample:
## Unique (#) Missing (%) Mean SD Min Median Max
## 1 Feeling Close to a Party 3 1 0.6 0.5 0.0 1.0 1.0
## 2 Satisfaction with Democracy 12 2 6.1 1.8 0.0 6.0 10.0
## 3 Trust in Politicians 12 1 5.0 1.9 0.0 5.0 10.0Task 5
avg_trstprl_by_year <- aggregate(trstplt ~ year + clsprty, data=netherlands_data_table_subset, mean)
p1 <- ggplot(avg_trstprl_by_year, aes(x=year, y=trstplt, color=as.factor(clsprty))) +
geom_line(aes(group=clsprty)) +
labs(title="Mean of Trust in Politicians by Survey Year",
subtitle = "for those that feel close to a party vs. not in the Netherlands",
x="Survey Year",
y="Average Trust in Politicians") +
scale_color_discrete(name="Feel Close to a Party", labels=c("No", "Yes")) +
theme_minimal()
p1
netherlands_data_table_subset$yrbrn[netherlands_data_table_subset$yrbrn %in% c(7777, 8888)] <- NA
avg_stfdem_by_yrbrn <- aggregate(stfdem ~ yrbrn, data=subset(netherlands_data_table_subset, clsprty == 0 & yrbrn >= 1980 & yrbrn <= 2000), FUN=mean)
p2 <- ggplot(avg_stfdem_by_yrbrn, aes(x=yrbrn, y=stfdem)) +
geom_point(aes(), size=3) + # Adds individual points
geom_smooth(aes(), se=FALSE) + # Adds smoothed line
labs(title="Mean of Satisfaction of Democracy by Year of Birth",
subtitle = "for those who do not feel close to any party in France",
x="Birth Year",
y="Average",
color="Legend") +
theme_minimal()
p2## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Task 6
ggsave(filename = "plot1.pdf", plot = p1, device = "pdf", width = 6, height = 4)
ggsave(filename = "plot2.pdf", plot = p2, device = "pdf", width = 6, height = 4)## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'Task 7
sd_clsprty <- sd(netherlands_data_table_subset$clsprty, na.rm = TRUE)
n_clsprty <- sum(!is.na(netherlands_data_table_subset$clsprty))
se_clsprty <- sd_clsprty / sqrt(n_clsprty)
se_clsprty## [1] 0.003669571Task 8
confidence_interval <- netherlands_data_table_subset %>%
specify(response = stfdem) %>% # replace variable of interest here
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "mean") %>%
get_confidence_interval(level = 0.95)## Warning: Removed 417 rows containing missing values.print(confidence_interval)## # A tibble: 1 × 2
## lower_ci upper_ci
## <dbl> <dbl>
## 1 6.04 6.09Task 9
setwd("C:/Users/Erika/Desktop/SOC_202_YAY"
)
library(fst)
ess <- read_fst("All-ESS-Data.fst") millennials_data <- ess %>%
filter(cntry == "NL", yrbrn > 1980 & yrbrn < 1997)
boomers_data <- ess %>%
filter(cntry == "NL", yrbrn > 1945 & yrbrn < 1965)millennials_data_cleaned <- millennials_data %>%
mutate(
ipeqopt = ifelse(ipeqopt %in% c(7, 8, 9), NA, ipeqopt),
imprich = ifelse(imprich %in% c(7, 8, 9), NA, imprich),
impfree = ifelse(impfree %in% c(7, 8, 9), NA, impfree)
) %>%
group_by(yrbrn) %>%
summarise(
avg_imprich = mean(imprich, na.rm = TRUE),
avg_ipeqopt = mean(ipeqopt, na.rm = TRUE),
avg_impfree = mean(impfree, na.rm = TRUE)
)
boomers_data_cleaned <- boomers_data %>%
mutate(
ipeqopt = ifelse(ipeqopt %in% c(7, 8, 9), NA, ipeqopt),
imprich = ifelse(imprich %in% c(7, 8, 9), NA, imprich),
impfree = ifelse(impfree %in% c(7, 8, 9), NA, impfree)
) %>%
group_by(yrbrn) %>%
summarise(
avg_imprich = mean(imprich, na.rm = TRUE),
avg_ipeqopt = mean(ipeqopt, na.rm = TRUE),
avg_impfree = mean(impfree, na.rm = TRUE)
)ggplot() +
geom_point(data = millennials_data_cleaned, aes(x = yrbrn, y = avg_imprich), color = "black", alpha = 0.6) +
geom_point(data = boomers_data_cleaned, aes(x = yrbrn, y = avg_imprich), color = "black", alpha = 0.6) +
geom_smooth(data = millennials_data_cleaned, aes(x = yrbrn, y = avg_imprich), method = "lm", formula = y ~ poly(x, 1), color = "black") +
geom_smooth(data = boomers_data_cleaned, aes(x = yrbrn, y = avg_imprich), method = "lm", formula = y ~ poly(x, 1), color = "black") +
labs(
title = "Average imprich Score by Birth Year (Millennials vs. Boomers)",
x = "Year of Birth",
y = "Average imprich"
) +
scale_color_manual(values = c("black", "black")) +
theme_bw()