LEI_AMY_Homework_2
2024-01-24
# 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.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
## 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"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)?
The data from 2002 to 2020 reveal a general decreasing trend in mean trust levels, indicating a gradual decline in trust over these years. Notably, there was a slight increase in trust from 2002 to 2004. However, this was followed by a sharp decline, particularly between 2008 and 2012. The years 2012 and 2020 are marked by significantly low mean trust levels, underscoring particularly low levels of trust in Parliament during these periods.
spain_data <- read.fst("spain_data.fst")spain_data <- spain_data %>%
mutate(
trstplt = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt) # set values 77, 88, and 99 to NA
)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, linetype = "longdash") +
geom_point(color = "red", size = 2) +
labs(title = "Average Trust in Parliament in Spain (2002-2020)",
x = "Survey Year",
y = "Average Trust in Parliament (0-10 scale)") +
ylim(0, 10) +
scale_x_continuous(breaks = seq(min(trust_by_year$year), max(trust_by_year$year), by = 2)) +
theme_minimal() +
theme(legend.position = "none")## 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.
## X-Axis label has been adjusted to show two-year increments to display
yearly trends clearly.
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.
The graph shows us how starting with the 1920 cohort, France had more people feeling close to political parties than Italy or Norway. Over time, while the feeling of closeness to parties has generally decreased in all three countries, France’s decrease has been slower. In recent years, after 1980, France’s numbers have started to level off, suggesting a steadying in people’s closeness to parties, unlike Italy and Norway, which continue to see a drop. By the year 2000, France’s numbers are still above Italy’s but have fallen below Norway’s. This shows that French people have maintained a relatively stronger connection to their political parties over time compared to Italy, pointing to distinct trends in how these countries engage with politics.
Task 3
Provide code and answer.
Question: What is the marginal percentage of Italian men who feel close to a particular political party?
The marginal percentage of italian men who feel close to a prarticular political party is 20.501%
italy_data <- read.fst("italy_data.fst")
Italy_data <- italy_data %>%
mutate(
gndr = case_when(
gndr == 1 ~ "Male",
gndr == 2 ~ "Female",
TRUE ~ NA_character_
),
clsprty = case_when(
clsprty %in% 1 ~ "Yes",
clsprty %in% 0 ~ "No",
TRUE ~ NA_character_
)
)clsprty_percentages <- italy_data %>%
filter(!is.na(clsprty), !is.na(gndr)) %>%
group_by(gndr, clsprty) %>%
summarise(count = n(), .groups = 'drop') %>%
mutate(percentage = count / sum(count) * 100)
clsprty_percentages ## # A tibble: 12 × 4
## gndr clsprty count percentage
## <dbl> <dbl> <int> <dbl>
## 1 1 1 1936 19.0
## 2 1 2 2593 25.5
## 3 1 7 142 1.40
## 4 1 8 165 1.62
## 5 2 1 1686 16.6
## 6 2 2 3228 31.7
## 7 2 7 180 1.77
## 8 2 8 233 2.29
## 9 2 9 2 0.0197
## 10 9 1 4 0.0393
## 11 9 2 7 0.0688
## 12 9 8 2 0.0197Task 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_ # 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 <- sweden_data %>% # Begin with the dataset 'sweden_data'
filter(!is.na(lrscale), !is.na(gndr)) %>% # Filter out rows where 'lrscale' or 'gender' is NA (missing data)
group_by(gndr, lrscale) %>% # Group the data by 'gender' and 'lrscale' categories
summarise(count = n(), .groups = 'drop') %>% # Summarise each group to get counts, and then drop groupings
mutate(percentage = count / sum(count) * 100) # Calculate percentage for each group by dividing count by total count and multiplying by 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.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") + # Fixed scales for y-axis across facets
scale_fill_brewer(palette = "Set1") + # Distinct colors for Left and Right
labs(
title = "Political Orientation (Left vs. Right) by Gender in Sweden",
x = "Political Orientation",
y = "Percentage of Respondents",
fill = "Orientation"
) +
theme_minimal() + # Minimal theme for clarity
theme(legend.position = "bottom") # Legend at the bottom
# Display the ggplot object
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?
The conditional probability of those who live in rural areas and do not feel close to any particular party is 55.38394%
hungary_data <- read.fst("hungary_data.fst")
hungary_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(clsprty), !is.na(geo)) hungary_data <- hungary_data %>%
mutate(
clsprty = case_when(
clsprty %in% 1 ~ "Yes",
clsprty %in% 2 ~ "No",
TRUE ~ NA_character_
)
) %>%
filter(!is.na(clsprty))cond <- hungary_data %>%
count(clsprty, geo) %>%
group_by(geo) %>%
mutate(prob = n / sum(n)*100)
cond## # A tibble: 4 × 4
## # Groups: geo [2]
## clsprty geo n prob
## <chr> <chr> <int> <dbl>
## 1 No Rural 6275 55.4
## 2 No Urban 2395 51.2
## 3 Yes Rural 5055 44.6
## 4 Yes Urban 2283 48.8