# 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.