Homework 2
2024-01-16
Kashvi Shah | 1009413706
# 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 packagesnew_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## [[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"rm(list=ls()); gc() ## used (Mb) gc trigger (Mb) limit (Mb) max used (Mb)
## Ncells 1080003 57.7 2200544 117.6 NA 1450717 77.5
## Vcells 1860711 14.2 8388608 64.0 16384 2400631 18.4ess <- read_fst("All-ESS-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)?
spain_data <- read.fst("spain_data.fst")library(ggplot2)
library(dplyr)# Set values 77, 88, and 99 to NA in 'trstplt'
spain_data <- spain_data %>%
mutate(
trstplt = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt)
)# Check the values after modification
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 71# 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]
}# Calculate the average trust in Parliament by year
trust_by_year <- spain_data %>%
group_by(year) %>%
summarize(mean_trust_plt = mean(trstplt, na.rm = TRUE))# Visualize the trend
ggplot(trust_by_year, aes(x = year, y = mean_trust_plt)) +
geom_line(color = "Purple", size = 1) + # Line to show the trend
geom_point(color = "orange", size = 3) + # Points to highlight each year's value
labs(title = "Trust in Parliament in Spain (2002-2020)",
x = "Survey Year",
y = "Average Trust in Parliament") +
ylim(0, 10) + # Setting the y-axis limits from 0 to 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.
The graph showed indications of a decline. From 3.75 to about 1.9, the average trust continued to decline between 2005 and 2012. Even though it had somewhat increased—by about 0.6—between 2012 and 2018, it continued to decline after that.
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: There are several anomalies from the previous years, with Norway having extremely high proportions and Italy having very low ones. In more recent times, there has been a negative association observed in all three countries. The depiction depicting France’s early years reveals tendencies that are extremely similar to, but marginally weaker than, those of Norway, while the closest period to the 21st century has a trend that begins to resemble Italy’s slope while staying just above it.France had increased slightly between 1920 and 1940, whereas Norway had dropped. Norway has only reduced from roughly 0.75 to roughly 0.5 since 1940, while France has decreased from 0.625 to slightly less than 0.25. It demonstrates that whereas Norway has only decreased for about 0.25 percent, France has decreased for about 0.4 percent. Thus, France is superior to Italy, while Norway is superior to France.
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")# Recode gndr and lrscale variables
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",
lrscale %in% 7:10 ~ "Right",
TRUE ~ NA_character_
)
)lrscale_percentages <- italy_data %>% # Begin with the dataset 'italy_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 930 23.9
## 2 Female Right 955 24.5
## 3 Male Left 924 23.7
## 4 Male Right 1084 27.8Male and Right: Among all Italian respondents, 27.8% are men who lean right politically. Male and Left: Of all Italian respondents, 23.7% are male and have a left political inclination. Of Italian men, 20.5% feel a strong sense of affinity with 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")# Recode gender and political orientation variables
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_
)
)# Calculate percentages
lrscale_percentages_sweden <- 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_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 = "Set3") +
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 = "top")
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 %>%
mutate(
geo = case_when(
domicil %in% c(1, 2) ~ "Urban", # Assuming 1 and 2 represent urban areas
domicil %in% c(3, 4, 5) ~ "Rural", # Assuming 3, 4, and 5 represent rural areas
TRUE ~ NA_character_
)
) %>%
filter(!is.na(geo), !is.na(lrscale), !lrscale %in% c(77, 88, 99)) # Removing rows with NA in geo, lrscale, and excluding 77, 88, 99# Convert lrscale to factor
hungary_data$lrscale <- as.factor(hungary_data$lrscale)# Calculate conditional probabilities, excluding NAs for Hungary_data
cond_hungary <- hungary_data %>%
count(lrscale, geo) %>%
group_by(geo) %>%
mutate(prob_not_feeling_close = sum(n[lrscale %in% c(0, 1)]) / sum(n))
# Print conditional probabilities for Hungary_data
print(cond_hungary)## # A tibble: 22 × 4
## # Groups: geo [2]
## lrscale geo n prob_not_feeling_close
## <fct> <chr> <int> <dbl>
## 1 0 Rural 314 0.0566
## 2 0 Urban 234 0.0817
## 3 1 Rural 233 0.0566
## 4 1 Urban 107 0.0817
## 5 2 Rural 469 0.0566
## 6 2 Urban 215 0.0817
## 7 3 Rural 637 0.0566
## 8 3 Urban 337 0.0817
## 9 4 Rural 632 0.0566
## 10 4 Urban 332 0.0817
## # ℹ 12 more rows# Calculate conditional probabilities, excluding NAs
cond <- hungary_data %>%
count(clsprty, geo) %>%
group_by(geo) %>%
mutate(prob = n / sum(n))
cond## # A tibble: 10 × 4
## # Groups: geo [2]
## clsprty geo n prob
## <dbl> <chr> <int> <dbl>
## 1 1 Rural 4751 0.492
## 2 1 Urban 2162 0.518
## 3 2 Rural 4667 0.483
## 4 2 Urban 1910 0.458
## 5 7 Rural 85 0.00880
## 6 7 Urban 42 0.0101
## 7 8 Rural 159 0.0165
## 8 8 Urban 57 0.0137
## 9 9 Rural 1 0.000103
## 10 9 Urban 3 0.000719Did it two ways to get a clear understanding. Given that they reside in a rural location, the conditional likelihood that they Do Not feel close to any particular party is 55.4%.