# List of packages
packages <- c("tidyverse", "fst", "gt", "scales", "ggridges")
# 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.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ 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
##
## Attaching package: 'scales'
##
##
## The following object is masked from 'package:purrr':
##
## discard
##
##
## The following object is masked from 'package:readr':
##
## col_factor
## [[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] "gt" "fst" "lubridate" "forcats" "stringr" "dplyr"
## [7] "purrr" "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [13] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [19] "base"
##
## [[4]]
## [1] "scales" "gt" "fst" "lubridate" "forcats" "stringr"
## [7] "dplyr" "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [13] "tidyverse" "stats" "graphics" "grDevices" "utils" "datasets"
## [19] "methods" "base"
##
## [[5]]
## [1] "ggridges" "scales" "gt" "fst" "lubridate" "forcats"
## [7] "stringr" "dplyr" "purrr" "readr" "tidyr" "tibble"
## [13] "ggplot2" "tidyverse" "stats" "graphics" "grDevices" "utils"
## [19] "datasets" "methods" "base"
TASK 1
# Load the full GSS dataset
gss <- read_fst("gss2022.fst")
# Initial look at data dimensions
dim(gss)
## [1] 72390 6646
# Initial examination
table(gss$abany)
##
## yes no
## 16626 22628
## don't know iap
## 0 0
## I don't have a job dk, na, iap
## 0 0
## no answer not imputable_(2147483637)
## 0 0
## not imputable_(2147483638) refused
## 0 0
## skipped on web uncodeable
## 0 0
## not available in this release not available in this year
## 0 0
## see codebook
## 0
# View unique values to understand coding
unique(gss$abany)
## [1] <NA> yes no
## 15 Levels: yes no don't know iap I don't have a job dk, na, iap ... see codebook
# Clean and recode abortion variable (abany)
gss_cleaned <- gss %>%
mutate(
abortion_attitude = case_when(
abany == "yes" ~ "Support",
abany == "no" ~ "Oppose",
TRUE ~ NA_character_ # Assign NA to missing values
)
) %>%
drop_na(abortion_attitude) # Remove rows with missing values
table(gss_cleaned$abortion_attitude)
##
## Oppose Support
## 22628 16626
# Clean and recode political views
gss_cleaned <- gss %>%
mutate(
# Recode political views
political_views = case_when(
tolower(trimws(polviews)) %in% c("extremely liberal", "liberal", "slightly liberal") ~ "Liberal",
tolower(trimws(polviews)) == "moderate, middle of the road" ~ "Moderate",
tolower(trimws(polviews)) %in% c("slightly conservative", "conservative", "extremely conservative") ~ "Conservative",
TRUE ~ NA_character_
),
# Create factor for political views
political_views = factor(political_views, levels = c("Liberal", "Moderate", "Conservative"))
) %>%
filter(
!is.na(political_views) # Removes rows with missing values for political_views
)
# Check the distribution of political views
table(gss_cleaned$political_views)
##
## Liberal Moderate Conservative
## 17604 23992 21122
# Clean and recode education (degree)
gss_cleaned <- gss_cleaned %>%
mutate(
# Recode education levels
education = case_when(
tolower(trimws(degree)) %in% c("lt high school", "high school") ~ "High School or Less",
tolower(trimws(degree)) %in% c("associate/junior college") ~ "Some College",
tolower(trimws(degree)) %in% c("bachelor", "graduate") ~ "Bachelor’s or Higher",
TRUE ~ NA_character_
),
# Create factor for education
education = factor(education, levels = c("High School or Less", "Some College", "Bachelor’s or Higher"))
) %>%
filter(
!is.na(education) # Removes rows with missing values for education
)
# Check the distribution of education
table(gss_cleaned$education)
##
## High School or Less Some College Bachelor’s or Higher
## 31866 3982 5489
# Clean and recode gender (sex)
gss_cleaned <- gss_cleaned %>%
mutate(
# Recode gender (binary)
gender = case_when(
tolower(trimws(sex)) == "male" ~ "Male",
tolower(trimws(sex)) == "female" ~ "Female",
TRUE ~ NA_character_
),
# Create factor for gender
gender = factor(gender, levels = c("Male", "Female"))
) %>%
filter(
!is.na(gender) # Removes rows with missing values for gender
)
# Check the distribution of gender
table(gss_cleaned$gender)
##
## Male Female
## 18251 23043
# Create the abortion_attitude column again after cleaning
gss_cleaned <- gss_cleaned %>%
mutate(
abortion_attitude = case_when(
abany == "yes" ~ "Support",
abany == "no" ~ "Oppose",
TRUE ~ NA_character_ # Assign NA to other values
)
) %>%
drop_na(abortion_attitude) # Remove rows with missing values
# Check if the abortion_attitude column was successfully created
table(gss_cleaned$abortion_attitude)
##
## Oppose Support
## 13543 10862
# Combine the gender, political_views, education, and abortion_attitude columns into a new table
combined_table <- gss_cleaned %>%
select(gender, political_views, education, abortion_attitude)
# Check the combined table
head(combined_table)
## gender political_views education abortion_attitude
## 1 Female Moderate High School or Less Support
## 2 Female Conservative High School or Less Oppose
## 3 Female Liberal High School or Less Support
## 4 Male Liberal High School or Less Support
## 5 Male Conservative High School or Less Support
## 6 Female Moderate High School or Less Oppose
# Summarize the data
combined_summary <- combined_table %>%
group_by(gender, political_views, education, abortion_attitude) %>%
summarise(count = n(), .groups = 'drop') %>%
mutate(proportion = count / sum(count), # Calculate proportion
percentage = proportion * 100) # Calculate percentage
# Check the summary
head(combined_summary)
## # A tibble: 6 × 7
## gender political_views education abortion_attitude count proportion percentage
## <fct> <fct> <fct> <chr> <int> <dbl> <dbl>
## 1 Male Liberal High Sch… Oppose 948 0.0388 3.88
## 2 Male Liberal High Sch… Support 1119 0.0459 4.59
## 3 Male Liberal Some Col… Oppose 106 0.00434 0.434
## 4 Male Liberal Some Col… Support 146 0.00598 0.598
## 5 Male Liberal Bachelor… Oppose 125 0.00512 0.512
## 6 Male Liberal Bachelor… Support 501 0.0205 2.05
# Create a formatted table using gt package
combined_summary %>%
# Initialize gt table
gt() %>%
# Rename column headers for clearer presentation
cols_label(
gender = "Gender",
political_views = "Political Views",
education = "Education Level",
abortion_attitude = "Abortion Attitude", # Add abortion_attitude column
count = "Sample Size",
proportion = "Proportion",
percentage = "Percent" # Change from 'percentage' to 'Percent'
) %>%
# Format proportion column as percentages
fmt_percent(
columns = proportion, # Specify which column to format
decimals = 1 # Show one decimal place
) %>%
# Format percentage column with one decimal
fmt_number(
columns = percentage, # Specify which column to format
decimals = 1 # Show one decimal place
) %>%
# Add title and subtitle to table
tab_header(
# Use md() for markdown formatting - makes title bold
title = md("**Support for Abortion Rights by Political and Social Characteristics**"),
subtitle = "General Social Survey, 1977-2022"
) %>%
# Add source note and question wording below table
tab_source_note(
source_note = md("*Note:* Data from the General Social Survey (GSS). Sample includes valid responses for political views, education level, gender, and abortion attitudes.")
) %>%
# Make column headers bold
tab_style(
style = cell_text(weight = "bold"),
locations = cells_column_labels()
) %>%
# Customize table appearance
tab_options(
# Add thick borders at top and bottom of table
table.border.top.width = 2,
table.border.bottom.width = 2,
# Add thick border below column headers
column_labels.border.bottom.width = 2,
# Set font sizes for different table elements
table.font.size = px(12),
heading.title.font.size = px(14),
heading.subtitle.font.size = px(12),
source_notes.font.size = px(10),
# Adjust spacing between rows
data_row.padding = px(4)
) %>%
# Format numbers with comma separator for thousands
fmt_integer(
columns = count,
sep_mark = ","
)
| Support for Abortion Rights by Political and Social Characteristics |
| General Social Survey, 1977-2022 |
| Gender |
Political Views |
Education Level |
Abortion Attitude |
Sample Size |
Proportion |
Percent |
| Male |
Liberal |
High School or Less |
Oppose |
948 |
3.9% |
3.9 |
| Male |
Liberal |
High School or Less |
Support |
1,119 |
4.6% |
4.6 |
| Male |
Liberal |
Some College |
Oppose |
106 |
0.4% |
0.4 |
| Male |
Liberal |
Some College |
Support |
146 |
0.6% |
0.6 |
| Male |
Liberal |
Bachelor’s or Higher |
Oppose |
125 |
0.5% |
0.5 |
| Male |
Liberal |
Bachelor’s or Higher |
Support |
501 |
2.1% |
2.1 |
| Male |
Moderate |
High School or Less |
Oppose |
1,852 |
7.6% |
7.6 |
| Male |
Moderate |
High School or Less |
Support |
1,380 |
5.7% |
5.7 |
| Male |
Moderate |
Some College |
Oppose |
180 |
0.7% |
0.7 |
| Male |
Moderate |
Some College |
Support |
150 |
0.6% |
0.6 |
| Male |
Moderate |
Bachelor’s or Higher |
Oppose |
138 |
0.6% |
0.6 |
| Male |
Moderate |
Bachelor’s or Higher |
Support |
221 |
0.9% |
0.9 |
| Male |
Conservative |
High School or Less |
Oppose |
1,954 |
8.0% |
8.0 |
| Male |
Conservative |
High School or Less |
Support |
970 |
4.0% |
4.0 |
| Male |
Conservative |
Some College |
Oppose |
262 |
1.1% |
1.1 |
| Male |
Conservative |
Some College |
Support |
117 |
0.5% |
0.5 |
| Male |
Conservative |
Bachelor’s or Higher |
Oppose |
361 |
1.5% |
1.5 |
| Male |
Conservative |
Bachelor’s or Higher |
Support |
252 |
1.0% |
1.0 |
| Female |
Liberal |
High School or Less |
Oppose |
1,158 |
4.7% |
4.7 |
| Female |
Liberal |
High School or Less |
Support |
1,484 |
6.1% |
6.1 |
| Female |
Liberal |
Some College |
Oppose |
114 |
0.5% |
0.5 |
| Female |
Liberal |
Some College |
Support |
234 |
1.0% |
1.0 |
| Female |
Liberal |
Bachelor’s or Higher |
Oppose |
111 |
0.5% |
0.5 |
| Female |
Liberal |
Bachelor’s or Higher |
Support |
623 |
2.6% |
2.6 |
| Female |
Moderate |
High School or Less |
Oppose |
2,852 |
11.7% |
11.7 |
| Female |
Moderate |
High School or Less |
Support |
1,929 |
7.9% |
7.9 |
| Female |
Moderate |
Some College |
Oppose |
292 |
1.2% |
1.2 |
| Female |
Moderate |
Some College |
Support |
256 |
1.0% |
1.0 |
| Female |
Moderate |
Bachelor’s or Higher |
Oppose |
159 |
0.7% |
0.7 |
| Female |
Moderate |
Bachelor’s or Higher |
Support |
252 |
1.0% |
1.0 |
| Female |
Conservative |
High School or Less |
Oppose |
2,392 |
9.8% |
9.8 |
| Female |
Conservative |
High School or Less |
Support |
951 |
3.9% |
3.9 |
| Female |
Conservative |
Some College |
Oppose |
289 |
1.2% |
1.2 |
| Female |
Conservative |
Some College |
Support |
145 |
0.6% |
0.6 |
| Female |
Conservative |
Bachelor’s or Higher |
Oppose |
250 |
1.0% |
1.0 |
| Female |
Conservative |
Bachelor’s or Higher |
Support |
132 |
0.5% |
0.5 |
| Note: Data from the General Social Survey (GSS). Sample includes valid responses for political views, education level, gender, and abortion attitudes. |
# Summarize the data for opposition to abortion by year, gender, political views, and education
opposition_summary <- gss_cleaned %>%
filter(abortion_attitude == "Oppose") %>% # Adjust according to your opposition coding
group_by(year, gender, political_views, education) %>%
summarise(n = n(), .groups = "drop") # n() counts the number of observations
# Summarize opposition by year and characteristics (gender, political views, education)
opposition_summary <- gss_cleaned %>%
filter(abortion_attitude == "Oppose") %>%
group_by(year, gender, political_views, education) %>%
summarise(n = n(), .groups = "drop")
# Calculate percentage of opposition
total_count <- sum(opposition_summary$n)
opposition_summary <- opposition_summary %>%
mutate(percentage = (n / total_count) * 100)
# Visualization for Gender
ggplot(opposition_summary, aes(x = year, y = percentage, color = gender)) +
geom_line(linewidth = 1.2, alpha = 0.7) +
labs(title = "Opposition to Abortion Over Time by Gender",
x = "Year",
y = "Opposition (%)") +
theme_minimal(base_size = 14) +
theme(legend.title = element_blank(),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_color_manual(values = c("blue", "pink"))

# Visualization for Political Views
ggplot(opposition_summary, aes(x = year, y = percentage, color = political_views)) +
geom_line(linewidth = 1.2, alpha = 0.5) +
labs(title = "Opposition to Abortion Over Time by Political Views",
x = "Year",
y = "Opposition (%)") +
theme_minimal(base_size = 14) +
theme(legend.title = element_blank(),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_color_brewer(palette = "Set1")

# Visualization for Education Level
ggplot(opposition_summary, aes(x = year, y = percentage, color = education)) +
geom_line(linewidth = 1.2, alpha = 0.5) +
labs(title = "Opposition to Abortion Over Time by Education Level",
x = "Year",
y = "Opposition (%)") +
theme_minimal(base_size = 10) +
theme(legend.title = element_blank(),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_color_viridis_d()
The data presented in combined_summary table and opposition_summary
visualization highlight key trends in opposition to abortion over time,
segmented by gender, political views, and education level. The findings
indicate notable variations across these demographic categories. First,
gender differences in opposition to abortion are evident. In earlier
years, men exhibited slightly higher levels of opposition than women.
However, in more recent decades, the gap has narrowed, suggesting a
convergence in attitudes. While both groups have shown fluctuations, the
general trend indicates a decline in a strong opposition, particularly
after the 1990’s. Political ideology presents one of the most pronounced
differences in attitudes toward abortion. Individuals identifying as
conservative have demonstrated higher opposition compare to those with
moderate or liberal views. The gap between these groups has remained
persistent, with conservatives showing little change in their stance
over the decades. Moderates and liberals, on the other hand, have
exhibited a gradual decline in opposition, reinforcing the ideological
divide on the issue. The data in table 3 highlights a clear correlation
between education and opposition to abortion. Individuals with lower
levels of formal education have historically shown higher opposition,
while those with post secondary education have expressed lower levels of
resistance. This trend has remained stable over time, with opposition
decreasing more significantly among individuals with university degrees.
Overall, while opposition to abortion has declined across all groups,
notable differences remain, particularly along political and educational
lines. These findings underscore the ongoing influence of ideological
and social factors in shaping attitudes toward abortion rights.
TASK 2
# Load individual country files
france_data <- read_fst("france_data.fst")
hungary_data <- read_fst("hungary_data.fst")
#Clean data for France
france_cleaned <- france_data %>%
filter(!freehms %in% c(7, 8, 9)) %>% # Remove missing values
mutate(
freehms_category = case_when(
freehms %in% c(1, 2) ~ "Support",
freehms == 3 ~ "Neutral",
freehms %in% c(4, 5) ~ "Oppose"
),
education = case_when(
eisced %in% c(1, 2) ~ "Lower Secondary or Less",
eisced %in% c(3, 4) ~ "Upper Secondary",
eisced %in% c(5, 6, 7) ~ "Tertiary"
),
residence = case_when(
domicil == 1 ~ "Major city",
domicil %in% c(2, 3) ~ "Urban periphery",
domicil %in% c(4, 5) ~ "Rural"
)
) %>%
drop_na(freehms_category, education, residence) # Remove any remaining missing values
#Clean data fro Hungary
hungary_cleaned <- hungary_data %>%
filter(!freehms %in% c(7, 8, 9)) %>% # Remove missing values
mutate(
freehms_category = case_when(
freehms %in% c(1, 2) ~ "Support",
freehms == 3 ~ "Neutral",
freehms %in% c(4, 5) ~ "Oppose"
),
education = case_when(
eisced %in% c(1, 2) ~ "Lower Secondary or Less",
eisced %in% c(3, 4) ~ "Upper Secondary",
eisced %in% c(5, 6, 7) ~ "Tertiary"
),
residence = case_when(
domicil == 1 ~ "Major city",
domicil %in% c(2, 3) ~ "Urban periphery",
domicil %in% c(4, 5) ~ "Rural"
)
) %>%
drop_na(freehms_category, education, residence) # Remove any remaining missing values
# Function to generate a summary table
create_summary_table <- function(data, country_name) {
summary_table <- data %>%
count(freehms_category, education, residence) %>%
group_by(education, residence) %>%
mutate(
total = sum(n),
percent = (n / total) * 100
) %>%
ungroup() %>%
select(education, residence, freehms_category, percent) %>%
pivot_wider(
id_cols = c(education, residence),
names_from = freehms_category,
values_from = percent
) %>%
gt() %>%
fmt_number(
columns = c("Support", "Neutral", "Oppose"),
decimals = 1
) %>%
tab_header(
title = md(paste0("**Attitudes Toward LGBTQ+ Rights in ", country_name, "**")),
subtitle = "Distribution by Education Level and Place of Residence (%)"
) %>%
cols_label(
education = md("**Education Level**"),
residence = md("**Place of Residence**")
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_column_labels()
) %>%
tab_source_note(md("Data: European Social Survey (ESS)"))
return(summary_table)
}
# Generate tables for each country
france_table <- create_summary_table(france_cleaned, "France")
hungary_table <- create_summary_table(hungary_cleaned, "Hungary")
# Print the tables
france_table
| Attitudes Toward LGBTQ+ Rights in France |
| Distribution by Education Level and Place of Residence (%) |
| Education Level |
Place of Residence |
Neutral |
Oppose |
Support |
| Lower Secondary or Less |
Major city |
9.2 |
17.3 |
73.5 |
| Lower Secondary or Less |
Rural |
10.0 |
13.0 |
77.0 |
| Lower Secondary or Less |
Urban periphery |
11.2 |
13.5 |
75.3 |
| Tertiary |
Major city |
5.1 |
4.6 |
90.3 |
| Tertiary |
Rural |
5.7 |
2.9 |
91.3 |
| Tertiary |
Urban periphery |
5.7 |
4.2 |
90.2 |
| Upper Secondary |
Major city |
7.9 |
7.9 |
84.2 |
| Upper Secondary |
Rural |
7.7 |
6.1 |
86.2 |
| Upper Secondary |
Urban periphery |
7.2 |
6.7 |
86.0 |
| Data: European Social Survey (ESS) |
hungary_table
| Attitudes Toward LGBTQ+ Rights in Hungary |
| Distribution by Education Level and Place of Residence (%) |
| Education Level |
Place of Residence |
Neutral |
Oppose |
Support |
| Lower Secondary or Less |
Major city |
24.6 |
37.3 |
38.1 |
| Lower Secondary or Less |
Rural |
22.3 |
39.9 |
37.8 |
| Lower Secondary or Less |
Urban periphery |
23.2 |
37.4 |
39.5 |
| Tertiary |
Major city |
25.9 |
22.1 |
52.0 |
| Tertiary |
Rural |
26.9 |
21.7 |
51.4 |
| Tertiary |
Urban periphery |
29.2 |
24.0 |
46.8 |
| Upper Secondary |
Major city |
24.9 |
28.5 |
46.6 |
| Upper Secondary |
Rural |
24.4 |
28.9 |
46.7 |
| Upper Secondary |
Urban periphery |
26.1 |
30.3 |
43.7 |
| Data: European Social Survey (ESS) |
# Function to create a summary table showing opposition percentage
create_opposition_table <- function(data, country_name, group_by_var) {
# Count all categories (Support, Neutral, Oppose) for each group
opposition_data <- data %>%
count(!!sym(group_by_var), freehms_category) %>%
group_by(!!sym(group_by_var)) %>%
mutate(
total = sum(n), # Get total responses in each group
percent_sample = (n / sum(n)) * 100, # Calculate percentage of sample
percent_opposing = ifelse(freehms_category == "Oppose", (n / total) * 100, 0) # Calculate for opposition category only
) %>%
ungroup() %>%
filter(freehms_category == "Oppose") %>% # Only keep "Oppose" category
select(!!sym(group_by_var), percent_sample, n, percent_opposing) %>%
rename(group = !!sym(group_by_var),
group_size = n,
percent_of_sample = percent_sample,
percent_opposing = percent_opposing)
# Create the table
opposition_table <- opposition_data %>%
gt() %>%
fmt_number(
columns = c("percent_of_sample", "percent_opposing"),
decimals = 1
) %>%
tab_header(
title = md(paste0("**Opposition to LGBTQ+ Rights in ", country_name, "**")),
subtitle = paste("Opposition by", group_by_var)
) %>%
cols_label(
group = md(paste0("**", group_by_var, "**")),
group_size = md("**Group Size**"),
percent_of_sample = md("**% of Sample**"),
percent_opposing = md("**% Opposing**")
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_column_labels()
) %>%
tab_source_note(md("Data: European Social Survey (ESS)"))
return(opposition_table)
}
# Table 1: % Opposing by Education Level in France
france_education_opposition <- create_opposition_table(france_cleaned, "France", "education")
# Table 2: % Opposing by Education Level in Hungary
hungary_education_opposition <- create_opposition_table(hungary_cleaned, "Hungary", "education")
# Table 3: % Opposing by Place of Residence in France
france_residence_opposition <- create_opposition_table(france_cleaned, "France", "residence")
# Table 4: % Opposing by Place of Residence in Hungary
hungary_residence_opposition <- create_opposition_table(hungary_cleaned, "Hungary", "residence")
# Print the tables
france_education_opposition
| Opposition to LGBTQ+ Rights in France |
| Opposition by education |
| education |
% of Sample |
Group Size |
% Opposing |
| Lower Secondary or Less |
13.9 |
580 |
13.9 |
| Tertiary |
3.9 |
193 |
3.9 |
| Upper Secondary |
6.6 |
430 |
6.6 |
| Data: European Social Survey (ESS) |
hungary_education_opposition
| Opposition to LGBTQ+ Rights in Hungary |
| Opposition by education |
| education |
% of Sample |
Group Size |
% Opposing |
| Lower Secondary or Less |
38.7 |
1344 |
38.7 |
| Tertiary |
22.8 |
712 |
22.8 |
| Upper Secondary |
29.3 |
2474 |
29.3 |
| Data: European Social Survey (ESS) |
france_residence_opposition
| Opposition to LGBTQ+ Rights in France |
| Opposition by residence |
| residence |
% of Sample |
Group Size |
% Opposing |
| Major city |
8.5 |
247 |
8.5 |
| Rural |
7.2 |
408 |
7.2 |
| Urban periphery |
7.8 |
548 |
7.8 |
| Data: European Social Survey (ESS) |
hungary_residence_opposition
| Opposition to LGBTQ+ Rights in Hungary |
| Opposition by residence |
| residence |
% of Sample |
Group Size |
% Opposing |
| Major city |
27.5 |
1059 |
27.5 |
| Rural |
31.7 |
1678 |
31.7 |
| Urban periphery |
30.4 |
1793 |
30.4 |
| Data: European Social Survey (ESS) |
create_opposition_data <- function(data, group_by_var) {
data %>%
count(!!sym(group_by_var), freehms_category) %>%
group_by(!!sym(group_by_var)) %>%
mutate(
total = sum(n),
percent_sample = (n / sum(n)) * 100,
percent_opposing = ifelse(freehms_category == "Oppose", (n / total) * 100, 0)
) %>%
ungroup() %>%
filter(freehms_category == "Oppose") %>%
select(!!sym(group_by_var), percent_opposing) %>%
rename(group = !!sym(group_by_var)) # Rename column to 'group'
}
# Generate clean opposition data
france_education_data <- create_opposition_data(france_cleaned, "education")
hungary_education_data <- create_opposition_data(hungary_cleaned, "education")
france_residence_data <- create_opposition_data(france_cleaned, "residence")
hungary_residence_data <- create_opposition_data(hungary_cleaned, "residence")
create_opposition_plot <- function(data, title, bar_color = "lightblue", point_color = "red") {
data <- data %>% mutate(percent_opposing = as.numeric(percent_opposing)) # Ensure numeric
ggplot(data, aes(x = reorder(group, percent_opposing), y = percent_opposing)) +
geom_col(fill = bar_color, width = 0.6) +
geom_point(aes(y = percent_opposing), color = point_color, size = 3) +
geom_text(aes(label = paste0(format(round(percent_opposing, 1), nsmall = 1), "%")),
hjust = -0.3, size = 5, color = "black") +
coord_flip() +
labs(title = title, x = "", y = "Opposition (%)") +
theme_minimal(base_size = 14) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(color = "grey80"),
axis.text = element_text(color = "black"),
plot.title = element_text(hjust = 0.5, face = "bold"),
legend.position = "none"
)
}
# Generate and print plots
plot1 <- create_opposition_plot(france_education_data, "Opposition by Education Level in France")
plot2 <- create_opposition_plot(hungary_education_data, "Opposition by Education Level in Hungary")
plot3 <- create_opposition_plot(france_residence_data, "Opposition by Place of Residence in France")
plot4 <- create_opposition_plot(hungary_residence_data, "Opposition by Place of Residence in Hungary")
plot1

plot2

plot3

plot4

# Ensure each dataset used for ggplot has the necessary columns
france_education_data <- france_education_data %>%
mutate(plot_group = "Opposition by Education Level in France")
hungary_education_data <- hungary_education_data %>%
mutate(plot_group = "Opposition by Education Level in Hungary")
france_residence_data <- france_residence_data %>%
mutate(plot_group = "Opposition by Place of Residence in France")
hungary_residence_data <- hungary_residence_data %>%
mutate(plot_group = "Opposition by Place of Residence in Hungary")
# Combine all data frames into one for patchwork
combined_data <- bind_rows(
france_education_data,
hungary_education_data,
france_residence_data,
hungary_residence_data
)
# Create the plot
combined_plot <- ggplot(combined_data, aes(x = percent_opposing, y = reorder(group, percent_opposing))) +
geom_col(aes(fill = plot_group), width = 0.6) + # Using bar chart for clarity
geom_text(aes(label = paste0(format(round(percent_opposing, 1), nsmall = 1), "%")),
hjust = -0.3, size = 5, color = "black") +
facet_wrap(~ plot_group, scales = "free_y", ncol = 2) +
labs(title = "Opposition to LGBTQ+ Rights by Various Demographics",
x = "Opposition (%)",
y = "Demographic Group") +
theme_minimal() +
scale_fill_brewer(palette = "Set3") +
theme(legend.position = "none", strip.text = element_text(face = "bold"))
# Display the combined plot using patchwork
combined_plot

The analysis of opposition to LGBTQ+ rights across education levels
and places of residence in France and Hungary reveal distinct patterns
influenced by demographic factors. Education level appears to be a
strong predictor of opposition. Individuals with lower levels of
education exhibit higher opposition rates compared to those with higher
education. For instance, in the combined dataset, individuals with only
primary education show consistently higher opposition, with values
exceeding 30 in several cases. In contrast, opposition decreases among
those with secondary or post-secondary education, often falling below
15. This trend aligns with broader sociological research suggesting that
higher education correlates with more progressive social attitudes. The
location of residence also demonstrates notable differences. Rural
residents exhibit higher opposition compared to urban dwellers. In the
combined dataset, rural opposition rates frequently surpass 25, whereas
urban opposition remains closer to or below 10. The disparity may be
attributed to factors such as differing exposure to diverse social
environments, media representation, and cultural norms prevalent in
urban versus rural settings. Additionally, the comparison between France
and Hungary suggests national-level differences. While both countries
follow similar trends regarding education and residence. Hungary
consistently shows higher overall opposition rates. This is evident as
Hungary’s rural respondents often report oppositions levels about 35,
whereas France’s rural respondents remain closer to 20. Such national
variations may be linked to political climates, historical contexts, and
government policies on LGBTQ+ rights.