Kim_Eric_Homework_2
Seokang Eric Kim
2024-01-25
First things first
packages <- c("tidyverse", "fst", "modelsummary", "viridis")
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.4 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ 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
## 필요한 패키지를 로딩중입니다: viridisLite## [[1]]
## [1] "lubridate" "forcats" "stringr" "dplyr" "purrr" "readr"
## [7] "tidyr" "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [13] "grDevices" "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "fst" "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [7] "readr" "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [13] "graphics" "grDevices" "utils" "datasets" "methods" "base"
##
## [[3]]
## [1] "modelsummary" "fst" "lubridate" "forcats" "stringr"
## [6] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [11] "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [16] "utils" "datasets" "methods" "base"
##
## [[4]]
## [1] "viridis" "viridisLite" "modelsummary" "fst" "lubridate"
## [6] "forcats" "stringr" "dplyr" "purrr" "readr"
## [11] "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [16] "graphics" "grDevices" "utils" "datasets" "methods"
## [21] "base"getwd()## [1] "C:/Users/Eric Kim/Desktop/UofT/2024 Winter/SOC222/R"Task 1
Provide code and answer.
Prompt: in the tutorial, we calculated the average trust in others for France and visualized it. Using instead the variable ‘Trust in Parliament’ (trstplt) and the country of Spain (country file provided on course website), visualize the average trust by survey year. You can truncate the y-axis if you wish. Provide appropriate titles and labels given the changes. What are your main takeaways based on the visual (e.g., signs of increase, decrease, or stall)?
spain_data <- read.fst("spain_data.fst")spain_data <- spain_data %>%
mutate(
trstplt = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt),
)table(spain_data$trstplt)##
## 0 1 2 3 4 5 6 7 8 9 10
## 5165 1830 2329 2441 2085 2890 1154 639 355 80 71spain_data$year <- NA
replacements <- c(2002, 2004, 2006, 2008, 2010, 2012, 2014, 2016, 2018, 2020)
for(i in 1:10){
spain_data$year[spain_data$essround == i] <- replacements[i]
}table(spain_data$year)##
## 2002 2004 2006 2008 2010 2012 2014 2016 2018 2020
## 1729 1663 1876 2576 1885 1889 1925 1958 1668 2283trust_by_year <- spain_data %>%
group_by(year) %>%
summarize(mean_trust = mean(trstplt, na.rm = TRUE))
trust_by_year## # A tibble: 10 × 2
## year mean_trust
## <dbl> <dbl>
## 1 2002 3.41
## 2 2004 3.66
## 3 2006 3.49
## 4 2008 3.32
## 5 2010 2.72
## 6 2012 1.91
## 7 2014 2.23
## 8 2016 2.40
## 9 2018 2.55
## 10 2020 1.94ggplot(trust_by_year, aes(x = year, y = mean_trust)) +
geom_line(color = "blue", size = 1) +
geom_point(color = "red", size = 3) +
labs(title = "Trust in Parliament in Spain (2002-2020)",
x = "Survey Year",
y = "Average Trust (0-4 scale)") +
ylim(0, 4) +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Answer: The variable “trstplt” (Trust in Parliament) for the country Spain has peaked in 2004, and demonstrated a sign of significant decrease starting from 2005, recording its lowest trust in parliament in 2012. After hitting its new lowest in 2012, Spain’s trust in parliament began increasing gradually until 2018. However, there seems to be another potentiality of drawing steep curve (i.e., sign of significant decrease) looking at the difference between the year 2018 and 2020.
Task 2
Provide answer only.
Prompt and question: Based on the figure we produced above called task2_plot, tell us: what are your main takeaways regarding France relative to Italy and Norway? Make sure to be concrete and highlight at least two important comparative trends visualized in the graph.
Answer: The trend for France, in comparison to that of Italy and Norway, displays a relatively steeper curve, indicating that France has been experiencing a greater decline in terms of feeling closer to a party compared to Italy or Norway over decades since the mid-1940s.
Another observation is that France had a considerable proportion of people saying ‘yes’ to feeling close to a party in the 1920s, but in the 2000s, it was getting lower than Italy. According to the figure, France displays the largest proportion gap in feeling closer to a party between its peak in the 1930s (approx. 0.6) and its lowest in the 2000s (approx. 0.2).
Moreover, France does not seem to be displaying a couple of extreme outliers (i.e., dots indicating the proportion for each singular year) compared to Italy and Norway).
In conclusion, France, without demonstrating extreme outliers, has not only been experiencing the steepest decline over decades in feeling closer to a party compared to Italy or Norway but has also been experiencing the largest gap between its peak and its lowest.
Task 3
Provide code and answer.
Question: What is the marginal percentage of Italian men who feel close to a particular political party?
italy_data <- read.fst("italy_data.fst")italy_data <- italy_data %>%
mutate(
gndr = case_when(
gndr == 1 ~ "Male",
TRUE ~ NA_character_
),
lrscale = case_when(
lrscale %in% 0:3 ~ "Left",
lrscale %in% 7:10 ~ "Right",
TRUE ~ NA_character_
)
) lrscale_percentages <- italy_data %>%
filter(!is.na(lrscale), !is.na(gndr)) %>%
group_by(gndr, lrscale) %>%
summarise(count = n(), .groups = 'drop') %>%
mutate(percentage = count / sum(count) * 100)
lrscale_percentages## # A tibble: 2 × 4
## gndr lrscale count percentage
## <chr> <chr> <int> <dbl>
## 1 Male Left 924 46.0
## 2 Male Right 1084 54.0lrscale_plot <- ggplot(lrscale_percentages, aes(x = lrscale, y = percentage, fill = lrscale)) +
geom_bar(stat = "identity", position = position_dodge()) +
facet_wrap(~ gndr, scales = "fixed") +
scale_fill_brewer(palette = "Set1") + #
labs(
title = "Political Orientation (Left vs. Right) for Males in Italy",
x = "Political Orientation",
y = "Percentage of Respondents",
fill = "Orientation"
) +
theme_minimal() +
theme(legend.position = "bottom")
lrscale_plot
Answer: According to the output, of all Italian males, approx. 46% lean politically left and approx. 54% lean politically right.
Task 4
Provide code and output only.
Prompt: In the tutorial, we calculated then visualized the percentage distribution for left vs. right by gender for France. Your task is to replicate the second version of the visualization but for the country of Sweden instead.
sweden_data <- read.fst("sweden_data.fst")sweden_data <- sweden_data %>%
mutate(
gndr = case_when(
gndr == 1 ~ "Male",
gndr == 2 ~ "Female",
TRUE ~ NA_character_
),
lrscale = case_when(
lrscale %in% 0:3 ~ "Left",
lrscale %in% 7:10 ~ "Right",
TRUE ~ NA_character_
)
) lrscale_percentages <- sweden_data %>%
filter(!is.na(lrscale), !is.na(gndr)) %>%
group_by(gndr, lrscale) %>%
summarise(count = n(), .groups = 'drop') %>%
mutate(percentage = count / sum(count) * 100)
lrscale_percentages## # A tibble: 4 × 4
## gndr lrscale count percentage
## <chr> <chr> <int> <dbl>
## 1 Female Left 2296 23.0
## 2 Female Right 2530 25.3
## 3 Male Left 2062 20.6
## 4 Male Right 3107 31.1lrscale_plot <- ggplot(lrscale_percentages, aes(x = lrscale, y = percentage, fill = lrscale)) +
geom_bar(stat = "identity", position = position_dodge()) + # Dodged bar chart
facet_wrap(~ gndr, scales = "fixed") +
scale_fill_brewer(palette = "Set1") +
labs(
title = "Political Orientation (Left vs. Right) by Gender in Sweden",
x = "Political Orientation",
y = "Percentage of Respondents",
fill = "Orientation"
) +
theme_minimal() +
theme(legend.position = "bottom")
lrscale_plot
Task 5
Provide code and answer: In Hungary, what is the conditional probability of NOT feeling close to any particular party given that the person lives in a rural area?
hungary_data <- read.fst("hungary_data.fst")hungary_data <- hungary_data %>%
# Modify 'clsprty' column: set values of 2 to 0, and values in 7, 8, 9 to NA. Retain other values as is.
mutate(
clsprty = ifelse(clsprty == 2, 0, ifelse(clsprty %in% c(7, 8, 9), NA, clsprty))
) %>%
# Modify 'yrbrn' column: set specific values (7777, 8888, 9999) to NA.
mutate(
yrbrn = ifelse(yrbrn %in% c(7777, 8888, 9999), NA, yrbrn)
)clsprty_proportions <- hungary_data %>%
filter(!is.na(yrbrn) & yrbrn >= 1920 & !is.na(clsprty)) %>%
group_by(yrbrn, clsprty) %>%
tally() %>%
mutate(proportion = n / sum(n)) %>%
ungroup()clsprtyplot <- ggplot(clsprty_proportions, aes(x = yrbrn, y = proportion, color = as.factor(clsprty))) +
geom_point() +
geom_smooth(method = 'loess', se = FALSE) +
labs(
title = "Proportions of Feeling Close to a Party by Cohort in Hungary",
x = "Cohort",
y = "Proportion"
) +
theme_minimal() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
) +
scale_color_discrete(name = "Close to Party", labels = c("No", "Yes"))
clsprtyplot ## `geom_smooth()` using formula = 'y ~ x'
clsprty_proportions## # A tibble: 174 × 4
## yrbrn clsprty n proportion
## <dbl> <dbl> <int> <dbl>
## 1 1920 0 14 0.583
## 2 1920 1 10 0.417
## 3 1921 0 18 0.72
## 4 1921 1 7 0.28
## 5 1922 0 23 0.575
## 6 1922 1 17 0.425
## 7 1923 0 18 0.439
## 8 1923 1 23 0.561
## 9 1924 0 20 0.426
## 10 1924 1 27 0.574
## # ℹ 164 more rowshungary_data <- hungary_data %>%
mutate(
gndr = case_when(
gndr == 1 ~ "Male",
gndr == 2 ~ "Female",
TRUE ~ NA_character_ # Set anything that is not 1 or 2 to NA
),
lrscale = case_when(
lrscale %in% 0:3 ~ "Left", # Left-wing (0 to 3)
lrscale %in% 7:10 ~ "Right", # Right-wing (7 to 10)
TRUE ~ NA_character_ # Moderate (4, 5, 6) and special codes (77, 88, 99) set to NA
)
) lrscale_percentages <- hungary_data %>%
filter(!is.na(lrscale), !is.na(gndr)) %>%
group_by(gndr, lrscale) %>%
summarise(count = n(), .groups = 'drop') %>%
mutate(percentage = count / sum(count) * 100)
lrscale_percentages ## # A tibble: 4 × 4
## gndr lrscale count percentage
## <chr> <chr> <int> <dbl>
## 1 Female Left 1450 20.9
## 2 Female Right 2368 34.2
## 3 Male Left 1096 15.8
## 4 Male Right 2018 29.1hungary_data <- hungary_data %>%
mutate(
geo = recode(as.character(domicil),
'1' = "Urban",
'2' = "Urban",
'3' = "Rural",
'4' = "Rural",
'5' = "Rural",
'7' = NA_character_,
'8' = NA_character_,
'9' = NA_character_)
) %>%
filter(!is.na(lrscale), !is.na(geo)) cond <- hungary_data %>%
count(lrscale, geo) %>%
group_by(geo) %>%
mutate(prob = n / sum(n))
cond## # A tibble: 4 × 4
## # Groups: geo [2]
## lrscale geo n prob
## <chr> <chr> <int> <dbl>
## 1 Left Rural 1653 0.349
## 2 Left Urban 893 0.408
## 3 Right Rural 3087 0.651
## 4 Right Urban 1297 0.592plot <- ggplot(cond, aes(x = lrscale, y = prob, fill = lrscale)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_viridis_d(name = "Political Orientation") +
labs(y = "Conditional Probability",
x = "Feels Close to a Party",
title = "Conditional Probability of Political Orientation in Hungary",
subtitle = "by Geographical Area: Urban vs. Rural") +
facet_wrap(~ geo, nrow = 1) +
theme(legend.position = "bottom",
legend.title = element_blank(),
plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.text.x = element_text(angle = 45, hjust = 1))
plot
Answer: I am just eager to know the answer for this question. This question got me headache for 4 hours straight. Please let me know if any of these answers are correct.
We already have data that indicates all (100%) of Hungarian respondents who live in rural areas have declared their political orientation and there is no observable data of respondents who live in rural areas and do not feel close to any particular party.
100% (respondents who live in rural areas) - 100% (respondents who live in rural areas AND lean politically either left or right) = 0% (respondents who live in rural areas AND do not lean politically either side)
For this question, it is not possible to apply a multiplication or division rule because numbers cannot be multiplied or divided by zero; it will be “undefined.”
Thus, in Hungary, the conditional probability of not feeling close to any particular party given that the person lives in a rural area is 0%.