BASA_l

# List of packages
packages <- c("tidyverse", "infer", "fst", "modelsummary", "effects", "survey", "interactions") # 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)

[[1]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

[[2]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

[[3]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

[[4]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

[[5]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

[[6]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

[[7]]
 [1] "broom"        "fstcore"      "interactions" "survey"      
 [5] "survival"     "Matrix"       "grid"         "effects"     
 [9] "carData"      "modelsummary" "fst"          "infer"       
[13] "lubridate"    "forcats"      "stringr"      "dplyr"       
[17] "purrr"        "readr"        "tidyr"        "tibble"      
[21] "ggplot2"      "tidyverse"    "stats"        "graphics"    
[25] "grDevices"    "utils"        "datasets"     "methods"     
[29] "base"        

#TASK 1#

sweden_data <- read.fst("sweden_data.fst")

table(sweden_data$trstplt)

   0    1    2    3    4    5    6    7    8    9   10   77   88   99 
 866  782 1429 2178 2456 3873 2829 2335  934  201  119    9  184   21 

table(sweden_data$trstprl)

   0    1    2    3    4    5    6    7    8    9   10   77   88   99 
 506  311  776 1356 1465 2991 2341 3362 3027 1058  708   10  277   28 

table(sweden_data$trstprt)

   0    1    2    3    4    5    6    7    8    9   10   77   88   99 
 597  593 1192 1877 2142 3694 2511 2139  875  185  101   13  270   28 

sweden_data$trstplt <- ifelse(sweden_data$trstplt > 10, NA, sweden_data$trstplt)


sweden_data$trstprl <- ifelse(sweden_data$trstprl > 10, NA, sweden_data$trstprl)


sweden_data$trstprt <- ifelse(sweden_data$trstprt > 10, NA, sweden_data$trstprt)

table(sweden_data$trstplt)

   0    1    2    3    4    5    6    7    8    9   10 
 866  782 1429 2178 2456 3873 2829 2335  934  201  119 

table(sweden_data$trstprl)

   0    1    2    3    4    5    6    7    8    9   10 
 506  311  776 1356 1465 2991 2341 3362 3027 1058  708 

table(sweden_data$trstprt)

   0    1    2    3    4    5    6    7    8    9   10 
 597  593 1192 1877 2142 3694 2511 2139  875  185  101 

sweden_data$trust <- scales::rescale(sweden_data$trstplt + sweden_data$trstprl + sweden_data$trstprt, na.rm = TRUE, to = c(0, 100))

sweden_data$populist <- scales::rescale(sweden_data$trust, na.rm = TRUE, to = c(100, 0))

ggplot(sweden_data, aes(x = populist)) +
  geom_histogram(bins = 30, fill = "yellow", color = "black") +
  theme_minimal() +
  labs(title = "Distribution of Populist Scale for Sweden")

NA

#INTERPRETATION# Based on the data provided, and through visual observation, we see that the bins on the left of the distribution tend to be higher on average than the bins towards the right side of the distribution. We can hypothetically conclude then, that Sweden is a slightly left populist country.

#TASK 2#

1. Recoding Educational Attainment

ess <- read.fst("All-ESS-Data.fst")

sweden_data <- ess %>%
  filter(cntry == "SE")

sweden_data <- sweden_data %>%
  mutate(
    edulvla = na_if(edulvla, 55) %>%
      na_if(., 77) %>%
      na_if(., 88),
   
     edulvlb = na_if(edulvlb, 5555) %>%
      na_if(., 7777) %>%
      na_if(., 8888)
  ) %>%
  
  mutate(
    edulvla = case_when(
      essround < 5 & edulvla == 55 ~ NA_real_,
      TRUE ~ edulvla
    ),
    
    edulvlb = case_when(
      essround >= 5 & edulvlb %in% c(5555, 7777, 8888) ~ NA_real_, 
      TRUE ~ edulvlb
    ),
    
    educ_level = case_when(
      essround < 5 & edulvla == 5 ~ "BA",
      essround >= 5 & edulvlb > 600 ~ "BA",
      TRUE ~ "No BA"
    )
  )

table(sweden_data$educ_level)

   BA No BA 
 4644 13572 

2. Authoritarian Scale

sweden_data <- sweden_data %>%
  mutate(
    behave = ipbhprp,
    secure = impsafe,
    safety = ipstrgv,
    tradition = imptrad,
    rules = ipfrule) %>%
  mutate(across(c("behave", "secure", "safety", "tradition", "rules"), ~ 7 - .x))

sweden_data$auth <- scales::rescale(sweden_data$behave + sweden_data$secure + sweden_data$safety + sweden_data$tradition + sweden_data$rules, to=c(0,100), na.rm = TRUE)

sweden_data <- sweden_data %>%
  filter(!is.na(auth))

table(sweden_data$auth)

   0  7.5 12.5   15 17.5   20 22.5   25 27.5   30 32.5   35 37.5   40 
 601    1   47    1    3    6    6   28   10    7   13   11   17   20 
42.5   45 47.5   50 52.5   55 57.5   60 62.5   65 67.5   70 72.5   75 
  35   75  106  163  284  413  539  665  869  988 1137 1196 1321 1214 
77.5   80 82.5   85 87.5   90 92.5   95 97.5  100 
1185 1030  907  750  654  456  260  182   92   99 

3. Linear Regression Model

model_data <- sweden_data %>%
  mutate(
    educ.ba = case_when(
      essround < 5 & edulvla == 5 ~ "BA or more",
      essround >= 5 & edulvlb > 600 ~ "BA or more",
      TRUE ~ "No BA"
    ),
    
    edulvla = ifelse(edulvla %in% c(77, 88, 99), NA_integer_, edulvla),
    edulvlb = ifelse(edulvlb %in% c(5555, 7777, 8888), NA_integer_, edulvlb),
    
    educ.ba = factor(educ.ba, levels = c("No BA", "BA or more")),
  )

model_education <- lm(auth ~ educ.ba, data = model_data)

modelsummary(
  list(model_education),
  fmt = 1,
  estimate = c("{estimate} ({std.error}){stars}"),
  statistic = NULL,
  coef_omit = "Intercept"
)

	(1)
educ.baBA or more	−1.6 (0.3)***
Num.Obs.	15391
R2	0.001
R2 Adj.	0.001
AIC	133280.4
BIC	133303.4
Log.Lik.	−66637.213
RMSE	18.37

4. Tidy Model

sweden_pop_model <- lm(auth ~ educ.ba, data= model_data )

coefficients_sweden <- coef(sweden_pop_model)
print(coefficients_sweden)

      (Intercept) educ.baBA or more 
         69.79813          -1.62068 

library(broom)
tidy(sweden_pop_model) |>
knitr::kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	69.798	0.171	408.19	0
educ.baBA or more	-1.621	0.342	-4.74	0

#INTERPRETATION#

Firstly, with an intercept of 69.8 tells us that if education is set at 0, the populist level will score 69.8, we can interpret this as saying that swedish people have a natural tendency to score more left on populist attitudes. Regarding a coefficient of -1.62 this indicates a negative correlation between educational attainment and populist levels which resonate with the findings in the distribution from task 1. Further, the provided p-value of 0 indicates statistical significance between the two variables explored.

#TASK 3#

italy_data <- read.fst ("italy_data.fst")

1. Authoriatrian Scales

table(italy_data$trstplt)

   0    1    2    3    4    5    6    7    8    9   10   77   88   99 
2472  979 1235 1307 1228 1339  851  362  135   50   29   40  144    7 

table(italy_data$trstprl)

   0    1    2    3    4    5    6    7    8    9   10   77   88   99 
1467  613  940 1091 1188 1720 1387  862  463  110   97   39  200    1 

table(italy_data$trstprt)

   0    1    2    3    4    5    6    7    8    9   10   77   88   99 
2327  946 1155 1052 1058 1124  628  302  118   38   23   44  151    5 

italy_data$trstplt <- ifelse(italy_data$trstplt > 10, NA, italy_data$trstplt)

italy_data$trstprl <- ifelse(italy_data$trstprl > 10, NA, italy_data$trstprl)

italy_data$trstprt <- ifelse(italy_data$trstprt > 10, NA, italy_data$trstprt)

table(italy_data$trstplt)

   0    1    2    3    4    5    6    7    8    9   10 
2472  979 1235 1307 1228 1339  851  362  135   50   29 

table(italy_data$trstprl)

   0    1    2    3    4    5    6    7    8    9   10 
1467  613  940 1091 1188 1720 1387  862  463  110   97 

table(italy_data$trstprt)

   0    1    2    3    4    5    6    7    8    9   10 
2327  946 1155 1052 1058 1124  628  302  118   38   23 

sweden_data$year <- NA
replacements <- c(2002, 2004, 2006, 2008, 2010, 2012, 2014, 2016, 2018, 2020)
for (i in 1:10) {
  sweden_data$year[sweden_data$essround == i] <- replacements[i]
}
auth_avg <- sweden_data %>%
  group_by(year) %>%
  summarize(auth_avg = mean(auth, na.rm = TRUE))

plot_auth <- ggplot(auth_avg, aes(x = year, y = auth_avg)) +
  geom_point(aes(color = auth_avg), alpha = 1.0) +
  geom_line(aes(group = 1), color = "black", linetype = "dashed") +
  labs(title = "Authoritarian Scale Average by Year (Italy)",
       x = "Survey Year",
       y = "Authoritarian Scale Average") +
  theme_minimal() +
  theme(legend.position = "none") +
  scale_y_continuous(limits = c(0, 100))

print(plot_auth)

NA
NA

#INTERPRETATION#

Based on the graph of average authoritarian scale by year they tend to strongly score above 50, however between 2005 and 2010 there was a slight dip, but begun to stabilize towards previous settings in the following years showing the country’s natural tendency towards the right.

#TASK 4#

1. Authoritarian Scale

italy_data <- read.fst ("italy_data.fst")

italy_data <- italy_data %>%
  mutate(
    behave = ipbhprp,
    secure = impsafe, 
    safety = ipstrgv,
    tradition = imptrad,
    rules = ipfrule) %>%
  
  mutate(across(c("behave", "secure", "safety", "tradition", "rules"),
                ~ na_if(.x, 7) %>% na_if(8) %>% na_if(9))) %>%
  
  mutate(across(c("behave", "secure", "safety", "tradition", "rules"), ~ 7 - .x))

italy_data$auth <- scales::rescale(italy_data$behave + 
                      italy_data$secure + 
                      italy_data$safety + 
                      italy_data$tradition + 
                      italy_data$rules, to=c(0,100), na.rm=TRUE)

italy_data <- italy_data %>%
  filter(!is.na(auth))

table(italy_data$secure)

   1    2    3    4    5    6 
  54  139  626 1856 2876 2881 

2. Generation Variable

model_data_gen <- italy_data %>%
  mutate(
    gen = case_when(
      yrbrn %in% 1900:1945 ~ "1",
      yrbrn %in% 1946:1964 ~ "2",
      yrbrn %in% 1965:1979 ~ "3",
      yrbrn %in% 1980:1996 ~ "4",
      TRUE ~ as.character(yrbrn)
    )
  ) %>%
  mutate(
    gen = factor(gen, 
                 levels = c("1", "2", "3", "4"),
                 labels = c("Interwar", "Baby Boomers", "Gen X", "Millennials"))
  )

model1 <- lm(auth ~ gen, data = model_data_gen)

modelsummary(
  list(model1),
  fmt = 1,
  estimate  = c( "{estimate} ({std.error}){stars}"),
  statistic = NULL,
  coef_omit = "Intercept")

	(1)
genBaby Boomers	−1.1 (0.6)*
genGen X	−2.1 (0.6)***
genMillennials	−3.6 (0.6)***
Num.Obs.	7631
R2	0.006
R2 Adj.	0.006
AIC	62934.0
BIC	62968.7
Log.Lik.	−31462.009
RMSE	14.94

models <- list(
  "Model 1" = lm(auth ~ gen, data = model_data_gen)
)

modelsummary(models, fmt = 1,
             estimate = c("{estimate} ({std.error})"), statistic = NULL)

	Model 1
(Intercept)	75.3 (0.5)
genBaby Boomers	−1.1 (0.6)
genGen X	−2.1 (0.6)
genMillennials	−3.6 (0.6)
Num.Obs.	7631
R2	0.006
R2 Adj.	0.006
AIC	62934.0
BIC	62968.7
Log.Lik.	−31462.009
RMSE	14.94

modelplot(models, coef_omit = 'Interc')

modelsummary(models, fmt = 1,
             estimate = c("{estimate} ({std.error})"), statistic = NULL,

coef_rename = c("genBaby Boomers" = "Baby Boomers", "genGen X" = "Gen X", "genMillennials" = "Millennials"),

title = "Table 2. Regression models for authoritarian attitudes in Italy"
)

Table 2. Regression models for authoritarian attitudes in Italy

	Model 1
(Intercept)	75.3 (0.5)
Baby Boomers	−1.1 (0.6)
Gen X	−2.1 (0.6)
Millennials	−3.6 (0.6)
Num.Obs.	7631
R2	0.006
R2 Adj.	0.006
AIC	62934.0
BIC	62968.7
Log.Lik.	−31462.009
RMSE	14.94

NA

tidy(model1) |>
knitr::kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	72.934	0.373	195.384	0
lrscaleModerate	3.796	0.423	8.974	0
lrscaleRight	6.062	0.471	12.873	0

#INTERPRETATION#

Based on the data provided, coefficients ranged from 1.1 to 3.6, indicating an extremely strong relationship between authoritarian scales/scores and generation birth year, further, all coefficients shown a negative correlation between the two, indicating that as generation year progressed, authoritarian scores declined. In other words, as the years progressed, individuals became slightly more authoritarian. These findings are found to be statistically significant given that P = 0.

Given that r = 0.006, this means that the variance of scores from the line are not significant enough to invalidate the findings. Further, it works towards the validity and strength of the findings between the relationship between generation year and authoritarian scales.

#TASK 5#

1. Greece Populist

greece_data <- read.fst ("greece_data.fst")

greece_data$trstplt <- ifelse(greece_data$trstplt > 10, NA, greece_data$trstplt)
greece_data$trstprl <- ifelse(greece_data$trstprl > 10, NA, greece_data$trstprl)
greece_data$trstprt <- ifelse(greece_data$trstprt > 10, NA, greece_data$trstprt)

greece_data$trust <- scales::rescale(greece_data$trstplt + greece_data$trstprl + greece_data$trstprt, na.rm = TRUE, to = c(0, 100))

table(greece_data$trstplt)

   0    1    2    3    4    5    6    7    8    9   10 
2834 1551 1589 1619 1326 1774  711  526  317  127   65 

table(greece_data$trstprl)

   0    1    2    3    4    5    6    7    8    9   10 
1894 1102 1196 1348 1225 2224 1178 1018  735  227  203 

table(greece_data$trstprt)

   0    1    2    3    4    5    6    7    8    9   10 
2358 1362 1289 1250 1116 1322  523  380  213   51   41 

greece_data <- greece_data %>%
  mutate(
    behave = ipbhprp,
    secure = impsafe,
    safety = ipstrgv,
    tradition = imptrad,
    rules = ipfrule) %>%
  
  mutate(across(c("behave", "secure", "safety", "tradition", "rules"),
                ~ na_if(.x, 7) %>% na_if(8) %>% na_if(9))) %>%

  mutate(across(c("behave", "secure", "safety", "tradition", "rules"), ~ 7 - .x ))


greece_data$auth <- scales::rescale(greece_data$behave +
                                      greece_data$secure +
                                      greece_data$safety +
                                      greece_data$tradition +
                                      greece_data$rules, to=c(0,100), na.rm = TRUE)

model_data <- greece_data %>%
  mutate(
    gndr = case_when(
      gndr == 1 ~ "Male",
      gndr == 2 ~ "Female",
      gndr == 9 ~ NA_character_,
      TRUE ~ as.character(gndr)
    ),
    
    lrscale = case_when(
      lrscale %in% 0:3 ~ "Left",
      lrscale %in% 7:10 ~ "Right",
      lrscale %in% 4:6 ~ "Moderate",
      lrscale %in% c(77, 88, 99) ~ NA_character_),
    
    Gen = case_when(
      yrbrn %in% 1900:1945 ~ "1",
      yrbrn %in% 1946:1964 ~ "2",
      yrbrn %in% 1965:1979 ~ "3",
      yrbrn %in% 1980:1996 ~ "4",
      TRUE ~ as.character(yrbrn)
    ),
    
    Gen = factor(Gen, levels = c("1", "2", "3", "4"), 
                 labels = c("Interwar", "Baby Boomers", "Gen X", "Millennials"))
    
)

table(greece_data$gndr)

   1    2 
5629 6929 

table(greece_data$lrscale)

   0    1    2    3    4    5    6    7    8    9   10   77   88 
 151  226  440  811 1060 3878  775  961  897  450  439  340 2130 

table(greece_data$Gen)

< table of extent 0 >

model1 <- lm(auth ~ lrscale, data = model_data)
model2 <- lm(auth ~ gndr, data = model_data)
model3 <- lm(auth ~ Gen, data = model_data)

models <- list(
  "Model 1" = lm(auth ~ lrscale, data = model_data),
  "Model 2" = lm(auth ~ gndr, data = model_data),
  "Model 3" = lm(auth ~ Gen, data = model_data))

modelsummary(models, fmt = 1, 
             estimate = c("{estimate} ({std.error}){stars}",
                          "{estimate} ({std.error}){stars}",
                          "{estimate} ({std.error}){stars}"),
             
statistic = NULL,
coef_rename = c("GenBaby Boomers" = "Baby Boomers", "GenGen X" = "Gen X", "GenMillennials" = "Millennials", "gndrMale" = "Male", "lrscaleModerate" = "Moderate", "lrscaleRight" = "Right"),
title = "Table 3. Regression models for authoritarian attitudes for the country of Greece"
             
             
             )

Table 3. Regression models for authoritarian attitudes for the country of Greece

	Model 1	Model 2	Model 3
(Intercept)	72.9 (0.4)***	77.8 (0.2)***	82.0 (0.3)***
Moderate	3.8 (0.4)***
Right	6.1 (0.5)***
Male		−2.0 (0.3)***
Baby Boomers			−4.1 (0.4)***
Gen X			−6.0 (0.4)***
Millennials			−10.3 (0.4)***
Num.Obs.	9926	12303	12042
R2	0.016	0.005	0.054
R2 Adj.	0.016	0.004	0.054
AIC	81830.5	101489.4	98536.4
BIC	81859.3	101511.7	98573.4
Log.Lik.	−40911.238	−50741.707	−49263.205
RMSE	14.92	14.96	14.47

coef_rename = c("GenBaby Boomers" = "Baby Boomers", "GenGen X" = "Gen X", "GenMillennials" = "Millennials", "gndrMale" = "Male", "lrscaleModerate" = "Moderate", "lrscaleRight" = "Right")

modelplot(models, coef_omit = 'Interc')

#INTERPRETATION#

Firstly, a 95% CI indicates upon repeated measures we can be 95% sure that the true value would lie between an alpha = .05. Notably, the most extreme results obtained is regarding the lrscale. We see both a positive and an Extremely Strong (3.8 - 6.1) correlation between lrscale and populist scales, which are reasonable to assume since both variables consider the political affiliation of persons. Further, both coefficients indicate a positive relationship which tells us that populist attitudes follow or mimic political affiliation.

Regarding the variable gndr, Males shown an extremely strong correlation (2.0) between populist attitudes. The correlation is also negative which tells us that the opposite gender tend to show an inverse reaction towards populist scores.

Finally, as expected of the generational model between populist scales and generational birth, we see similar findings to that in Task 4, with an extermely strong negative correlation between populist scale and generational birth