Homework_5_MinhTam_Huynh
2023-10-04
packages <- c("tidyverse", "modelsummary", "forcats", "RColorBrewer",
"fst", "viridis", "knitr", "kableExtra", "rmarkdown", "ggridges", "viridis", "questionr")
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 --
## v dplyr 1.1.2 v readr 2.1.4
## v forcats 1.0.0 v stringr 1.5.0
## v ggplot2 3.4.3 v tibble 3.2.1
## v lubridate 1.9.2 v tidyr 1.3.0
## v purrr 1.0.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## i Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Loading required package: viridisLite
##
##
## Attaching package: 'kableExtra'
##
##
## The following object is masked from 'package:dplyr':
##
## group_rows## [[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] "kableExtra" "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] "rmarkdown" "kableExtra" "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" "kableExtra" "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"
##
## [[11]]
## [1] "ggridges" "rmarkdown" "kableExtra" "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] "questionr" "ggridges" "rmarkdown" "kableExtra" "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"ess <- read_fst("All-ESS-Data.fst")
ess$year <- NA
replacements <- c(2002, 2004, 2006, 2008, 2010, 2012, 2014, 2016, 2018, 2020)
for(i in 1:10){
ess$year[ess$essround == i] <- replacements[i]
}TASK 1
finland_data <- ess %>%
filter(cntry == "FI") %>%
mutate(
freehms = ifelse(freehms %in% c(7, 8, 9), NA, freehms),
netusoft = ifelse(netusoft %in% c(7, 8, 9), NA, netusoft),
domicil = ifelse(domicil %in% c(7, 8, 9), NA, domicil),
)
datasummary_skim(finland_data %>% select(freehms, netusoft, domicil))| Unique (#) | Missing (%) | Mean | SD | Min | Median | Max | ||
|---|---|---|---|---|---|---|---|---|
| freehms | 6 | 1 | 2.1 | 1.1 | 1.0 | 2.0 | 5.0 | |
| netusoft | 6 | 73 | 4.4 | 1.3 | 1.0 | 5.0 | 5.0 | |
| domicil | 6 | 0 | 3.1 | 1.4 | 1.0 | 3.0 | 5.0 |
What I note from this data summary is that a large proportion of Finnish people are accepting of gay and lesbian freedom, tend to use the internet most days, and tend to live in a town or small city. These findings are generally what I expected based on my preconceptions of Finland.
TASK 2
lg_by_year <- finland_data %>%
group_by(year) %>%
summarize(mean_support = mean(freehms, na.rm = TRUE))
lg_by_year## # A tibble: 10 x 2
## year mean_support
## <dbl> <dbl>
## 1 2002 2.39
## 2 2004 2.29
## 3 2006 2.34
## 4 2008 2.15
## 5 2010 2.08
## 6 2012 1.99
## 7 2014 1.96
## 8 2016 1.84
## 9 2018 1.80
## 10 2020 1.72ggplot(lg_by_year, aes(x = year, y = mean_support)) +
geom_line(color = "cadetblue1", size = 1) +
geom_point(color = "pink", size = 3) + #I just enjoy these colors.
labs(title = "Disapproval of Lesbian and Gay Freedom (2002-2020)",
x = "Survey Year",
y = "Trust (5 = Strongly Disapprove)") +
ylim(0, 5) + # Setting the y-axis limits from 0 to 10
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## i Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Beginning from 2002, I notice that acceptance levels for gay and lesbian
freedom in Finland has gradually moved from a mean of 2.4 (between
acceptance and neutrality) towards a mean of 1.7, closer to strong
acceptance This trend is around what I expected of Finland, considering
the relative progressiveness of other Nordic countries in their
region.
TASK 3
ess_selected <- ess %>%
filter(cntry %in% c("FI", "PL", "DE")) %>%
mutate(freehms = ifelse(freehms %in% c(7, 8, 9), NA, freehms))
datasummary_skim(ess_selected %>% select(freehms))| Unique (#) | Missing (%) | Mean | SD | Min | Median | Max | ||
|---|---|---|---|---|---|---|---|---|
| freehms | 6 | 2 | 2.1 | 1.1 | 1.0 | 2.0 | 5.0 |
task3plot <- ggplot(ess_selected, aes(x = reorder(cntry, -freehms, FUN=median), y = freehms, fill = cntry)) +
geom_boxplot(alpha=0.3) +
theme(legend.position="none") +
scale_fill_brewer(palette="PRGn") +
labs(title = "Disapproval of Gay & Lesbian Freedom",
subtitle = "(Germany, Finland, Poland)",
x = "Country",
y = "Scale (5 = Strongly Disagree)")
task3plot## Warning: Removed 1533 rows containing non-finite values (`stat_boxplot()`).
Interestingly, each country has the same median of 2.0, with distinct
box ranges. Where Germany’s median represents the high-end of their IQR
box, Finland’s represents the middle range, and Poland’s median
represents their low-end. When presenting these findings to an
acquaintance in Germany, she was somewhat surprised to see Germany’s
relative acceptance towards gays and lesbians, as this result didn’t
correspond to her personal experience.
TASK 4
#Producing a crosstab for religiosity and gay & lesbian support in Finland.
finland_data <- finland_data %>%
mutate(religion = case_when(
rlgblg == 2 ~ "No",
rlgblg == 1 ~ "Yes",
rlgblg %in% c(7, 8, 9) ~ NA_character_,
TRUE ~ as.character(rlgblg)
))
lg_rlg <- datasummary_crosstab(freehms ~ rlgblg, data = finland_data)
lg_rlg| freehms | 1 | 2 | 7 | 8 | All | |
|---|---|---|---|---|---|---|
| 1 | N | 3336 | 3495 | 0 | 3 | 7523 |
| % row | 44.3 | 46.5 | 0.0 | 0.0 | 100.0 | |
| 2 | N | 3521 | 2450 | 3 | 5 | 6556 |
| % row | 53.7 | 37.4 | 0.0 | 0.1 | 100.0 | |
| 3 | N | 1617 | 834 | 0 | 4 | 2842 |
| % row | 56.9 | 29.3 | 0.0 | 0.1 | 100.0 | |
| 4 | N | 894 | 328 | 0 | 1 | 1402 |
| % row | 63.8 | 23.4 | 0.0 | 0.1 | 100.0 | |
| 5 | N | 643 | 230 | 0 | 1 | 1046 |
| % row | 61.5 | 22.0 | 0.0 | 0.1 | 100.0 | |
| All | N | 10113 | 7377 | 3 | 17 | 19532 |
| % row | 51.8 | 37.8 | 0.0 | 0.1 | 100.0 |
#Producing a crosstab for educational attainment and gay & lesbian support in Finland.
finland_data <- finland_data %>%
mutate(
edulvla = case_when(
essround < 5 & edulvla == 55 ~ NA_real_,
TRUE ~ edulvla
),
edulvlb = case_when(
essround >= 5 & edulvlb == 5555 ~ NA_real_,
TRUE ~ edulvlb
),
educ_level = case_when(
essround < 5 & edulvla == 5 ~ "BA",
essround >= 5 & edulvlb > 600 ~ "BA",
TRUE ~ "No BA"
)
)
table(finland_data$educ_level)##
## BA No BA
## 5455 14077lg_edu <- datasummary_crosstab(freehms ~ educ_level, data = finland_data)
lg_edu| freehms | BA | No BA | All | |
|---|---|---|---|---|
| 1 | N | 2627 | 4896 | 7523 |
| % row | 34.9 | 65.1 | 100.0 | |
| 2 | N | 1751 | 4805 | 6556 |
| % row | 26.7 | 73.3 | 100.0 | |
| 3 | N | 603 | 2239 | 2842 |
| % row | 21.2 | 78.8 | 100.0 | |
| 4 | N | 305 | 1097 | 1402 |
| % row | 21.8 | 78.2 | 100.0 | |
| 5 | N | 159 | 887 | 1046 |
| % row | 15.2 | 84.8 | 100.0 | |
| All | N | 5455 | 14077 | 19532 |
| % row | 27.9 | 72.1 | 100.0 |
Generally speaking, in Finland, one is more likely to agree with gay and lesbian freedoms when one is relatively less religious. There is a large proportion of Finnish people without BAs who support queer freedom, but there is a larger proportion of Finnish people without BAs who don’t support queer freedom. This overall high proportion of Finnish people without BAs may be due to other outstanding factors in the country.
TASK 5
table(finland_data$freehms, finland_data$educ_level) %>%
cprop()##
## BA No BA All
## 1 48.2 35.2 38.8
## 2 32.2 34.5 33.8
## 3 11.1 16.1 14.7
## 4 5.6 7.9 7.2
## 5 2.9 6.4 5.4
## Total 100.0 100.0 100.0df <- finland_data %>%
filter(!is.na(educ_level) & !is.na(freehms))
df <- df %>%
mutate(educ_level = case_when(
educ_level == 1 ~ "Yes",
educ_level == 0 ~ "No",
TRUE ~ as.character(educ_level)
))
table(df$educ_level)##
## BA No BA
## 5445 13924table(df$freehms, df$educ_level) %>%
cprop() %>%
as.data.frame() %>%
filter(Var1 != "Total",
Var2 != "All") %>%
ggplot(aes(x=Var1, y=Freq, fill=Var2)) +
geom_col(position = "dodge") +
labs(title="Support for Gay & Lesbian Freedom in Finland",
subtitle = "According to level of educational attainment",
y = "Conditional Percentage",
x = "Support (5 = Strongly Disagree)",
fill = "At least BA vs. Not")
Although one may be marginally more likely to agree with gay and lesbian
freedom in Finland if you have a BA, acceptance overall is high for
Finnish people with or without a BA. Among Finnish people who disagree
with gay freedoms, one is marginally more likely to not have a BA.
Overall, there are many more people without BAs in Finland than with
ones, therefore any conjectures about the statistical relationship
between educational attainment and social attitudes in Finland may be
highly spurious.