Shackleton_Jaime_Homework_2
Jaime Shackleton
2024-01-25
Set 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.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)?
Inputting data
spain_data <- read.fst("spain_data.fst")spain_data <- spain_data %>%
mutate(
trstplt = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt), # setting values 77, 88, and 99 to NA.
)
table(spain_data$trstplt) #checking ##
## 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 # creating year variable
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) #checking ##
## 2002 2004 2006 2008 2010 2012 2014 2016 2018 2020
## 1729 1663 1876 2576 1885 1889 1925 1958 1668 2283trust_by_year <- spain_data %>% #calculating average per year
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.94note: average does not shift much from 2002-2008, but shifts more between 2010-2020
#visualizing data
ggplot(trust_by_year, aes(x = year, y = mean_trust)) +
geom_line(color = "blue", size = 1) + # Line to show the trend
geom_point(color = "red", size = 3) + # Points to highlight each year's value
labs(title = "Trust in Parliament in Spain (2002-2020)",
x = "Survey Year",
y = "Average Trust (0-10 scale)") +
ylim(1.5, 4) + # Setting the y-axis limits from 1.5 to 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.
Conclusion:
The overall level of trust has decreased from 2002 to 2020. The lowest dip was in 2012, at ~1.91 levels of trust, with a strong decrease up to that point, and then a steady increase up to 2018. However, there was a second strong decrease from 2018 to 2020 to ~1.93. This visual is bimodal, with the highest peak being at ~3.65 levels of trust in 2004.
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.
italy_data <- read.fst("italy_data.fst")
norway_data <- read.fst("norway_data.fst")
france_data <- read.fst("france_data.fst")# Combining data from three countries (France, Norway, Italy) into a single dataset
combined_countries_data <- bind_rows(
france_data %>% mutate(cntry = "France"), # Adding a new column 'cntry' with the value 'France' to france_data
norway_data %>% mutate(cntry = "Norway"), # Doing the same for norway_data with 'Norway'
italy_data %>% mutate(cntry = "Italy") # And for italy_data with 'Italy'
) %>%
filter(!yrbrn %in% c(7777, 8888)) %>% # Removing rows where 'yrbrn' (year born) is either 7777 or 8888 (likely missing data codes)
mutate(
yrbrn = ifelse(yrbrn > 2005, NA, yrbrn), # Replacing 'yrbrn' values greater than 2005 with NA
clsprty = ifelse(clsprty %in% c(7, 8, 9), NA, clsprty), # Replacing 'clsprty' values of 7, 8, 9 with NA
clsprty = ifelse(clsprty == 2, 0, clsprty) # Converting 'clsprty' value of 2 to 0 (recoding for analysis purposes)
)
# Computing proportions for 'clsprty' by 'yrbrn' for each country
clsprty_proportions_compare <- combined_countries_data %>%
filter(!is.na(yrbrn) & yrbrn >= 1920 & !is.na(clsprty)) %>% # Filter out rows with NA in 'yrbrn' and 'clsprty', and where 'yrbrn' is earlier than 1920
group_by(yrbrn, cntry) %>% # Grouping the data by 'yrbrn' (year born) and 'cntry' (country)
summarise(yes_count = sum(clsprty), total_count = n(), .groups = 'drop') %>% # Summarising data to get count of 'clsprty' and total count per group
mutate(proportion = yes_count / total_count) # Calculating the proportion of 'clsprty' in each group
clsprty_proportions_compare #checking values## # A tibble: 258 × 5
## yrbrn cntry yes_count total_count proportion
## <dbl> <chr> <dbl> <int> <dbl>
## 1 1920 France 23 40 0.575
## 2 1920 Italy 1 2 0.5
## 3 1920 Norway 21 25 0.84
## 4 1921 France 27 39 0.692
## 5 1921 Italy 4 7 0.571
## 6 1921 Norway 28 36 0.778
## 7 1922 France 33 66 0.5
## 8 1922 Italy 8 13 0.615
## 9 1922 Norway 28 35 0.8
## 10 1923 France 33 53 0.623
## # ℹ 248 more rows# Visualizing the data
task2_plot <- ggplot(clsprty_proportions_compare, aes(x = yrbrn, y = proportion, color = cntry)) + # Initialize ggplot with 'clsprty_proportions' data, setting 'yrbrn' as x-axis, 'proportion' as y-axis, and 'cntry' for color differentiation
geom_point() + # Add points to the plot for each data point
geom_smooth(method = 'loess', se = FALSE) + # Add a LOESS smoothed line for trend visualization without standard error bands
labs(
title = "Proportion Saying 'Yes' to Feeling Close to a Party by Cohort", # Title of the plot
x = "Cohort", # Label for the x-axis
y = "Proportion", # Label for the y-axis
color = "Country" # Legend title for color coding by country
) +
theme_minimal() + # Use a minimal theme for a cleaner look
scale_color_manual(values = c(
"France" = "#1f77b4", # Assign a specific color for France
"Norway" = "#ff7f0e", # Assign a different color for Norway
"Italy" = "#2ca02c" # And another distinct color for Italy
)) +
scale_y_continuous(limits = c(0, 1)) # Set the y-axis limits from 0 to 1 as we're dealing with proportions
# Display the plot
task2_plot## `geom_smooth()` using formula = 'y ~ x'
Conclusion
All three countries have a decline in the amount they feel close to a party, seen in the LOESS smoothed lines. From 1920-2005, they all maintain the same ‘ranking’, with Norway having the most feeling of proximity to a party, Italy the least, and France in the middle. France, however, has the greatest decline, with the steepest slope compared to Italy and Norway, though it also has the most obvious increase around 1930-1940.
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_ # Setting anything that is not 1 or 2 to NA
),
clsprty = case_when(
clsprty %in% 1 ~ "Yes", # Yes (1)
clsprty %in% 2 ~ "No", # No (2)
TRUE ~ NA_character_ # Moderate (7, 8, 9) and set to NA
)
) Calculations
clsprty_percentages <- italy_data %>% # Begin with the dataset 'italy_data'
filter(!is.na(clsprty), !is.na(gndr)) %>% # Filtering out rows where 'clsprty' or 'gender' is NA (missing data)
group_by(gndr, clsprty) %>% # Grouping the data by 'gender' and 'clsprty' categories
summarise(count = n(), .groups = 'drop') %>% # Summarizing each group to get counts, and then drop groupings
mutate(percentage = count / sum(count) * 100) # Calculating percentage for each group by dividing count by total count and multiplying by 100
clsprty_percentages # The resulting dataframe## # 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.5Conclusion
Male and close to party: 20.5% of all Italian respondents are males who feel close to a political party
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_ # 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_ # Moderating (4, 5, 6) and special codes (77, 88, 99) set to NA
)
) Calculations
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# Creating ggplot object for horizontal bar chart with the specified style
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,
title = "Political Orientation by Gender",
subtitle = "Comparing the percentage distribution of left vs. right for Sweden (2002-2020)") +
# 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
Conclusion (not sure if needed?)
More males are right leaning politically than left leaning, and more so than females.
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(
gndr = case_when(
gndr == 1 ~ "Male",
gndr == 2 ~ "Female",
TRUE ~ NA_character_ # Setting anything that is not 1 or 2 to NA
),
clsprty = case_when(
clsprty %in% 1 ~ "Yes",
clsprty %in% 2 ~ "No",
TRUE ~ NA_character_ # Moderate (4, 5, 6) and special codes (77, 88, 99) set to NA
)
) Calculations
clsprty_hungary_percentages <- hungary_data %>%
filter(!is.na(clsprty), !is.na(gndr)) %>%
group_by(gndr, clsprty) %>%
summarise(count = n(), .groups = 'drop') %>%
mutate(percentage = count / sum(count) * 100)
clsprty_hungary_percentages ## # A tibble: 4 × 4
## gndr clsprty count percentage
## <chr> <chr> <int> <dbl>
## 1 Female No 5071 31.7
## 2 Female Yes 4008 25.0
## 3 Male No 3608 22.5
## 4 Male Yes 3334 20.8# Recoding 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 geo# 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 6275 0.554
## 2 No Urban 2395 0.512
## 3 Yes Rural 5055 0.446
## 4 Yes Urban 2283 0.488