Hakim_Rashad_Homework_2
2024-01-29
# 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"france_data <- read.fst("france_data.fst")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)?
#Answer: France’s Trust in Parliament is steady at around 2.5-4 with an increase in the later years of 2018 and 2020. While, Spain shows a decline in thier trust in parliament from 2002 - 2012.
france_data <- france_data %>%
mutate(
ppltrst = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt),
)france_data$year <- NA
replacements <- c(2002, 2004, 2006, 2008, 2010, 2012, 2014, 2016, 2018, 2020)
for(i in 1:10){
france_data$year[france_data$essround == i] <- replacements[i]
}trust_by_year <- france_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.93
## 2 2004 4.02
## 3 2006 3.80
## 4 2008 3.94
## 5 2010 3.57
## 6 2012 3.72
## 7 2014 3.11
## 8 2016 3.33
## 9 2018 5.27
## 10 2020 4.98ggplot(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) +
labs(title = "Trust in Parliament in France (2002-2020)",
x = "Survey Year",
y = "Average Trust (0-10 scale)") +
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.
spain_data <- read.fst("spain_data.fst")spain_data <- spain_data %>%
mutate(
ppltrst = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt),
)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]
}trust_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 7.81
## 2 2004 5.96
## 3 2006 5.41
## 4 2008 5.71
## 5 2010 3.61
## 6 2012 2.84
## 7 2014 3.30
## 8 2016 3.88
## 9 2018 4.15
## 10 2020 3.13ggplot(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()
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: In 1920-1960 France felt closer to a party by cohort than Italy at around 0.60 range to Italy’s 0.40-0.45 range, but as time went on and going into the 2000’s both France and Italy share similar result at the 0.20-0.25 range. Furthermore, from 1920 all the way to the 2000’s Norway has maintianed a feeling closer to a party by cohort than France, even though boht have decreased as the years gone by.
france_data <- france_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 <- france_data %>%
filter(!is.na(yrbrn) & yrbrn >= 1920 & !is.na(clsprty)) %>%
group_by(yrbrn, clsprty) %>%
tally() %>%
mutate(proportion = n / sum(n)) %>%
ungroup()clsprtyplot <- ggplot(clsprty_proportions, aes(x = yrbrn, y = proportion, color = as.factor(clsprty))) +
geom_point() +
geom_smooth(method = 'loess', se = FALSE) +
labs(
title = "task2_plot",
x = "Cohort",
y = "Proportion"
) +
theme_minimal() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
) +
scale_color_discrete(name = "Close to Party", labels = c("No", "Yes"))
clsprtyplot ## `geom_smooth()` using formula = 'y ~ x'
clsprty_proportions## # A tibble: 172 × 4
## yrbrn clsprty n proportion
## <dbl> <dbl> <int> <dbl>
## 1 1920 0 17 0.425
## 2 1920 1 23 0.575
## 3 1921 0 12 0.308
## 4 1921 1 27 0.692
## 5 1922 0 33 0.5
## 6 1922 1 33 0.5
## 7 1923 0 20 0.377
## 8 1923 1 33 0.623
## 9 1924 0 27 0.435
## 10 1924 1 35 0.565
## # ℹ 162 more rowsitaly_data <- read.fst("italy_data.fst")
norway_data <- read.fst("norway_data.fst")combined_countries_data <- bind_rows(
france_data %>% mutate(cntry = "France"),
norway_data %>% mutate(cntry = "Norway"),
italy_data %>% mutate(cntry = "Italy")
) %>%
filter(!yrbrn %in% c(7777, 8888)) %>%
mutate(
yrbrn = ifelse(yrbrn > 2005, NA, yrbrn),
clsprty = ifelse(clsprty %in% c(7, 8, 9), NA, clsprty),
clsprty = ifelse(clsprty == 2, 0, clsprty)
)
clsprty_proportions_compare <- combined_countries_data %>%
filter(!is.na(yrbrn) & yrbrn >= 1920 & !is.na(clsprty)) %>%
group_by(yrbrn, cntry) %>%
summarise(yes_count = sum(clsprty), total_count = n(), .groups = 'drop') %>%
mutate(proportion = yes_count / total_count) clsprty_proportions_compare## # 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 rowstask2_plot <- ggplot(clsprty_proportions_compare, aes(x = yrbrn, y = proportion, color = cntry)) +
geom_point() +
geom_smooth(method = 'loess', se = FALSE) +
labs(
title = "Proportion Saying 'Yes' to Feeling Close to a Party by Cohort",
x = "Cohort",
y = "Proportion",
color = "Country"
) +
theme_minimal() +
scale_color_manual(values = c(
"France" = "#1f77b4",
"Norway" = "#ff7f0e",
"Italy" = "#2ca02c"
)) +
scale_y_continuous(limits = c(0, 1))
task2_plot## `geom_smooth()` using formula = 'y ~ x'
Task 3
Provide code and answer.
Question: What is the marginal percentage of Italian men who feel close to a particular political party?
#Answer: The Marginal percentage of Italian Men who feel close to a particular political party is 46.0% left wing and 53.9% right wing.
italy_data <- italy_data %>%
mutate(
gndr = case_when(
gndr == 1 ~ "Male",
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_
)
) 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 ## # A tibble: 2 × 4
## gndr lrscale count percentage
## <chr> <chr> <int> <dbl>
## 1 Male Left 924 46.0
## 2 Male Right 1084 54.0Task 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",
lrscale %in% 7:10 ~ "Right",
TRUE ~ NA_character_
)
) 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.1lrscale_plot <- ggplot(lrscale_percentages, aes(x = lrscale, y = percentage, fill = lrscale)) +
geom_bar(stat = "identity", position = position_dodge()) +
facet_wrap(~ gndr, scales = "fixed") +
scale_fill_brewer(palette = "Set1") +
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 = "bottom")
lrscale_plot
lrscale_plot_v2 <- ggplot(lrscale_percentages,
aes(x = percentage,
y = reorder(gndr, -percentage),
fill = gndr)) +
geom_col() +
coord_flip() +
guides(fill = "none") +
facet_wrap(~ lrscale, nrow = 1) +
labs(x = "Percentage of Respondents",
y = NULL,
title = "Political Orientation by Gender",
subtitle = "Comparing the percentage distribution of left vs. right for Sweden (2002-2020)") +
theme(plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.title.y = element_blank(),
legend.position = "bottom")
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?
#Answer: The conditional probability of not feeling close to any particular party is 0.08
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(lrscale), !is.na(geo)) cond <- hungary_data %>%
count(lrscale, geo) %>%
group_by(geo) %>%
mutate(prob = n / sum(n))
cond## # A tibble: 28 × 4
## # Groups: geo [2]
## lrscale geo n prob
## <dbl> <chr> <int> <dbl>
## 1 0 Rural 314 0.0266
## 2 0 Urban 234 0.0483
## 3 1 Rural 233 0.0198
## 4 1 Urban 107 0.0221
## 5 2 Rural 469 0.0398
## 6 2 Urban 215 0.0444
## 7 3 Rural 637 0.0540
## 8 3 Urban 337 0.0696
## 9 4 Rural 632 0.0536
## 10 4 Urban 332 0.0686
## # ℹ 18 more rowsplot <- ggplot(cond, aes(x = lrscale, y = prob, fill = lrscale)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_viridis_d(name = "Political Orientation") +
labs(y = "Conditional Probability",
x = "Feels Close to a Party",
title = "Conditional Probability of Political Orientation in Hungary",
subtitle = "by Geographical Area: Urban vs. Rural") +
facet_wrap(~ geo, nrow = 1) +
theme(legend.position = "bottom",
legend.title = element_blank(),
plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.text.x = element_text(angle = 45, hjust = 1))