Li Liu_Josselyn_Homework_2
Li Liu_Josselyn
2024-01-23
##Setting up
# List of packages
packages <- c("tidyverse", "fst", "modelsummary", "viridis") # add any you need here
# Install packages if they aren't installed already
new_packages <- packages[!(packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)
# Load the packages
lapply(packages, library, character.only = TRUE)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ 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
## Loading required package: 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"##loading data into R 0
spain_data <- read.fst("spain_data.fst")italy_data <- read.fst("italy_data.fst")sweden_data <- read.fst("sweden_data.fst")hungary_data <- read.fst("hungary_data.fst")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)?
Here we clean and trasform the variable
spain_data <- spain_data %>%
mutate(
trstprl = ifelse(trstprl %in% c(77, 88, 99), NA, trstprl), # set values 77, 88, and 99 to NA.
)table(spain_data$trstprl)##
## 0 1 2 3 4 5 6 7 8 9 10
## 2345 797 1365 2023 1855 4085 2272 1864 1178 304 297Here we create a ‘year’ variable from the essround variable
spain_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 2283Here we calculate the average by year
trust_by_year <- spain_data %>%
group_by(year) %>%
summarize(mean_trust = mean(trstprl, na.rm = TRUE))
trust_by_year## # A tibble: 10 × 2
## year mean_trust
## <dbl> <dbl>
## 1 2002 4.85
## 2 2004 5.07
## 3 2006 4.99
## 4 2008 4.97
## 5 2010 4.30
## 6 2012 3.43
## 7 2014 3.67
## 8 2016 3.92
## 9 2018 4.08
## 10 2020 3.89Here we visualize the data
ggplot(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-10 scale)") +
ylim(0, 10) +
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.
Based on the visual graph, it can be seen that the trust scale of the people of Spain towards parliament has been on a stable trend, indicates that there have been no significant fluctuations in the level of public trust in parliamentary institutions. It was on an decreasing trend from about 2008, but then back to a increasing trend from 2012 and seems like continuously the people of Spain will increase trust in parliament.
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.
According to the graphs in task2_plot, the proportion of individuals close to a political party in France shows relative consistency across cohorts, relative to Italy and Norway. In France, there is a steady trend at first and then a decreasing trend over time. The French data line shows a steady and gradual decline in the proportion of individuals across cohorts who feel close to a political party, suggesting that there has not been a major shift in party identification over the years, and that the decline has been gradual, suggesting that there has been a steady but moderate decline in party affiliation over time. On the other side of the spectrum, compared to Italy and Norway, the data line for Italy is very volatile and shows more variability, suggesting a continuous decline in party affiliation in Italy. Norway, on the other hand, shows an upward trend, suggesting that Norwegian individuals are increasingly inclined to maintain close ties with political parties.
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 <- italy_data %>%
mutate(
gndr = case_when(
gndr == 1 ~ "Male",
gndr == 2 ~ "Female",
TRUE ~ NA_character_
),
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 <- 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 # The resulting dataframe## # A tibble: 4 × 4
## gndr lrscale count percentage
## <chr> <chr> <int> <dbl>
## 1 Female Left 930 23.9
## 2 Female Right 955 24.5
## 3 Male Left 924 23.7
## 4 Male Right 1084 27.8Male and Left: 23.7% of all Italian respondents are males who lean politically left.
Male and Right: 27.8% of all Italian respondents are males who 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 <- 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_ # Moderate (4, 5, 6) and special codes (77, 88, 99) set to NA
)
) 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 # The resulting dataframe## # 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.1Here we visualize
lrscale_plot_v2 <- ggplot(lrscale_percentages,
aes(x = percentage,
y = reorder(gndr, -percentage),
fill = gndr)) +
# Create horizontal bar chart
geom_col() +
coord_flip() +
# Remove fill color legend
guides(fill = "none") +
# Split the plot based on Political Orientation
facet_wrap(~ lrscale, nrow = 1) +
# Labels and titles for the plot
labs(x = "Percentage of Respondents", # X-axis label
y = NULL, # Remove Y-axis label
title = "Political Orientation by Gender", # Main title
subtitle = "Comparing the percentage distribution of left vs. right for Sweden (2002-2020)") + # Subtitle
# Adjust visual properties of the plot
theme(plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.title.y = element_blank(),
legend.position = "bottom")
# Display the ggplot object
lrscale_plot_v2
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?
# Recode clsprty and geo variables, removing NAs
hungary_data <- hungary_data %>%
mutate(
geo = recode(as.character(domicil),
'1' = "Urban",
'2' = "Rural",
'3' = NA_character_,
'4' = NA_character_,
'5' = NA_character_,
'7' = NA_character_,
'8' = NA_character_,
'9' = NA_character_)
) %>%
filter(!is.na(clsprty), !is.na(geo)) hungary_data <- hungary_data %>%
filter(!is.na(clsprty)) %>%
mutate(
clsprty = case_when(
clsprty == 1 ~ "Yes",
clsprty == 2 ~ "No"
)
) %>%
filter(!is.na(clsprty)) # Calculate conditional probabilities, excluding NAs
cond <- hungary_data %>%
count(clsprty, geo) %>%
group_by(geo) %>%
mutate(prob = n / sum(n))
cond## # A tibble: 4 × 4
## # Groups: geo [2]
## clsprty geo n prob
## <chr> <chr> <int> <dbl>
## 1 No Rural 339 0.546
## 2 No Urban 2056 0.507
## 3 Yes Rural 282 0.454
## 4 Yes Urban 2001 0.493In Hungary, the conditional probability of NOT feeling close to any particular party given that the person lives in a rural area is 55%.