Graves-Rice_Olivia_Homework_2
Olivia Graves-Rice
2024-01-29
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)?
# 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"library(fst)
france_data <- read_fst("france_data.fst")library(fst)
hungary_data <- read_fst("hungary_data.fst")library(fst)
sweden_data <- read_fst("sweden_data.fst")library(fst)
italy_data <- read_fst("italy_data.fst")library(fst)
norway_data <- read_fst("norway_data.fst")library(fst)
spain_data <- read_fst("spain_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 <- spain_data %>%
mutate(
trstplt = ifelse(trstplt %in% c(77, 88, 99), NA, trstplt), # set values 77, 88, and 99 to NA.
)
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 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) + # Line to show the trend
geom_point(color = "red", size = 3) + # Points to highlight each year's value
labs(title = "Trust in Parliament",
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.
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.
combined_countries_data <- bind_rows(
france_data %>% mutate(cntry = "France"), # Add a new column 'cntry' with the value 'France' to france_data
norway_data %>% mutate(cntry = "Norway"), # Do the same for norway_data with 'Norway'
italy_data %>% mutate(cntry = "Italy") # And for italy_data with 'Italy'
) %>%
filter(!yrbrn %in% c(7777, 8888)) %>% # Remove rows where 'yrbrn' (year born) is either 7777 or 8888 (likely missing data codes)
mutate(
yrbrn = ifelse(yrbrn > 2005, NA, yrbrn), # Replace 'yrbrn' values greater than 2005 with NA (as they are invalid)
clsprty = ifelse(clsprty %in% c(7, 8, 9), NA, clsprty), # Replace 'clsprty' values of 7, 8, 9 with NA (considered as invalid or missing)
clsprty = ifelse(clsprty == 2, 0, clsprty) # Convert 'clsprty' value of 2 to 0 (recoding for analysis purposes)
)
# Compute 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) %>% # Group the data by 'yrbrn' (year born) and 'cntry' (country)
summarise(yes_count = sum(clsprty), total_count = n(), .groups = 'drop') %>% # Summarise data to get count of 'clsprty' and total count per group
mutate(proportion = yes_count / total_count) # Calculate the proportion of 'clsprty' in each group
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'
# When looking at the data, it seems like France is in the middle of
both other countries. This would mean that are not as positive when it
comes to feeling close to a party like Norway is, but is more sure about
their beliefs than Italy. It is also to note that there is a clear
decline from the 60s to the 2000s of answering yes, the same is to be
said for Italy which shows commonality between the two although the
decline for Italy did not start until the middle of the 80s. On the
other hand Norway shows a more steady answer although there was a bit of
a drop in numbers from the 60s to the 2000s, but it seems like the
number is going back up whereas for the other two countries numbers keep
going down.
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_ # Set anything that is not 1 or 2 to NA
),
clsprty = case_when(
clsprty %in% 0:3 ~ "No", # Left-wing (0 to 3)
clsprty %in% 7:10 ~ "Yes", # Right-wing (7 to 10)
TRUE ~ NA_character_ # Moderate (4, 5, 6) and special codes (77, 88, 99) set to NA
)
) clsprty_percentages <- italy_data %>% # Begin with the dataset 'italy_data'
filter(!is.na(clsprty), !is.na(gndr)) %>% # Filter out rows where 'lrscale' or 'gender' is NA (missing data)
group_by(gndr, clsprty) %>% # Group the data by 'gender' and 'clsprty' 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
clsprty_percentages # The resulting dataframe## # A tibble: 4 × 4
## gndr clsprty count percentage
## <chr> <chr> <int> <dbl>
## 1 Female No 4914 48.3
## 2 Female Yes 415 4.08
## 3 Male No 4529 44.6
## 4 Male Yes 307 3.02Therefore the marginal percentage for Italian men would be 3.02% that 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 <- 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 'france_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?
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)) # Removing rows with NA in clsprty or 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 rowscond$lrscale <- as.factor(cond$lrscale)
plot <- 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))
plot
#The conditional probability of not feeling close to a party in a rural
area in Hungary would be 0.0266%.