Boccongelle-Shaw_Rylee_Homework_2
Rylee Boccongelle
2024-01-26
# List of packages
packages <- c("tidyverse", "fst", "modelsummary") # 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## [[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"Homework 2 (5%): due by next lecture on Jan. 30
Instructions: Start a new R markdown for the homework and call it “Yourlastname_Firstname_Homework_2”.
Copy everything below from Task 1 to Task 5. Keep the task prompt and questions, and provide your code and answer underneath.
Remember: you need all the steps for your code to work, including loading your data – otherwise it will not knit.
To generate a new code box, click on the +C sign above. Underneath your code, provide your answer to the task question.
When you are done, click on “Knit” above, then “Knit to Html”. Wait for everything to compile. If you get an error like “Execution halted”, it means there are issues with your code you must fix. When all issues are fixed, it will prompt a new window. Then click on “Publish” in the top right, and then Rpubs (the first option) and follow the instructions to create your Rpubs account and get your Rpubs link for your document (i.e., html link as I provide for the tutorial).
Note: Make sure to provide both your markdown file and R pubs link. If you do not submit both, you will be penalized 2 pts. out of the 5 pts. total.
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), # 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(aes(group = 1), color = "blue", size = 1, linetype = "longdash") + # Dashed line for the trend
# geom_point(aes(color = mean_trust), size = 3) + # if you want to try alternative + strive to keep improving
# scale_color_viridis(option = "D", end = 0.9, direction = -1) + # try the alternative, and try to keep improving
labs(title = "Trust in Parliament in Spain (2002-2020)",
x = "Survey Year",
y = "Average Trust in Parliament (0-10 scale)") +
ylim(0, 10) + # change the numbers to truncate more or less or keep the full 0 to 10 scale
theme_minimal() + # Minimal theme for a clean look
theme(legend.position = "none") # Remove the legend## 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.
#when looking at the graph, it appeares that trust in parliament was at its peak during 2005-2006 and remained steady then started to decrease until 2012. After 2012 average trust in parliament in Spain started to increase again and then started to decline around 2017 and every since. 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.
# one comparative trend that is evident in the graph is that when comparing France relative to Norway and Italy in proporation to saying yes to feeling close to a party by cohort, it appears that since approximately 1950, all three countries have been decresing in feeling close to a party, excpet for Norway, as they have been on a slight increase to saying yes they feel close to a party by cohort by 2000. In comparison to France, where in 1920-1940 was at their peak of a proportion of approximently 0.65, ever since they have been on a decline to in 2000, of a proportion of just under 0.25. Similarly, Italy, has followed a similar trend to France, where they peaked in proportion to saying yes to feeling close to a party by cohort in 1950-1955 of a proportion of approximately 0.40-0.45, and since then have been on a decline, where in 2000, Italy proportion of saying yes to feeling close to a party by cohort reached an all time low of a proportion of 0.17-0.20. Ajother comparative trend that is evident in the visualziation of this graph is that France is the only country that had an increase in feeling close to a party from 1920-40. Between both Norway and Italy, during the 19202-1940s, they were both declining in feeling close to a party during this tie, with italy only having a slight increase. 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",
gndr == 2 ~ "Female",
TRUE ~ NA_character_
),
clsprty = case_when(
clsprty %in% 1 ~ "Yes",
clsprty %in% 2 ~ "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: 4 × 4
## gndr clsprty count percentage
## <chr> <chr> <int> <dbl>
## 1 Female No 3228 34.2
## 2 Female Yes 1686 17.9
## 3 Male No 2593 27.5
## 4 Male Yes 1936 20.5# the marginal percentage of Italian men who feel close to a particular party is 20.5%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", # 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 %>%
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.1# Create a ggplot object for horizontal bar chart with the specified style
lrscale_plot_v2 <- ggplot(lrscale_percentages,
aes(x = percentage, # Use percentage directly
y = reorder(gndr, -percentage), # Order bars within each gender
fill = gndr)) + # Fill color based on Gender
# Create horizontal bar chart
geom_col() + # Draws the bars using the provided data
coord_flip() + # Flip coordinates to make bars horizontal
# Remove fill color legend
guides(fill = "none") + # Removes legend for the fill aesthetic
# Split the plot based on Political Orientation
facet_wrap(~ lrscale, nrow = 1) + # Separate plots for Left/Right
# 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"), # Format title
plot.subtitle = element_text(size = 12), # Format subtitle
axis.title.y = element_blank(), # Remove Y-axis title
legend.position = "bottom") # Position the legend at the 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?
hungary_data <- read.fst("hungary_data.fst")hungary_data <- hungary_data %>%
mutate(
clsprty = ifelse(clsprty == 2, 0, ifelse(clsprty %in% c(7, 8, 9), NA, clsprty))
) %>%
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()# Recode clsprty and geo variables, removing NAs
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)) # Removing rows with NA in clsprty or geocond <- 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
## <dbl> <chr> <int> <dbl>
## 1 0 Rural 6275 0.554
## 2 0 Urban 2395 0.512
## 3 1 Rural 5055 0.446
## 4 1 Urban 2283 0.488# given that someone lives in rural area in Hungary and does not feel close to any particular party, the conditional probability of that is 0.5538394 (55.3% proabability)