# List of packages
packages <- c("tidyverse", "infer", "fst", "modelsummary", "effects", "survey", "MASS", "aod", "interactions", "kableExtra", "flextable", "scales") # 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.5
## ✔ 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
## Warning: package 'infer' was built under R version 4.3.3
## Warning: package 'effects' was built under R version 4.3.3
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.3.3
## lattice theme set by effectsTheme()
## See ?effectsTheme for details.
## Warning: package 'survey' was built under R version 4.3.3
## Loading required package: grid
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
## Loading required package: survival
##
## Attaching package: 'survey'
##
## The following object is masked from 'package:graphics':
##
## dotchart
##
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select
## Warning: package 'aod' was built under R version 4.3.3
##
## Attaching package: 'aod'
##
## The following object is masked from 'package:survival':
##
## rats
## Warning: package 'interactions' was built under R version 4.3.3
##
## Attaching package: 'kableExtra'
##
## The following object is masked from 'package:dplyr':
##
## group_rows
##
##
## Attaching package: 'flextable'
##
## The following objects are masked from 'package:kableExtra':
##
## as_image, footnote
##
## The following object is masked from 'package:purrr':
##
## compose
##
##
## 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] "infer" "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [7] "readr" "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [13] "graphics" "grDevices" "utils" "datasets" "methods" "base"
##
## [[3]]
## [1] "fst" "infer" "lubridate" "forcats" "stringr" "dplyr"
## [7] "purrr" "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [13] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [19] "base"
##
## [[4]]
## [1] "modelsummary" "fst" "infer" "lubridate" "forcats"
## [6] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [11] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [16] "grDevices" "utils" "datasets" "methods" "base"
##
## [[5]]
## [1] "effects" "carData" "modelsummary" "fst" "infer"
## [6] "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [11] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [16] "stats" "graphics" "grDevices" "utils" "datasets"
## [21] "methods" "base"
##
## [[6]]
## [1] "survey" "survival" "Matrix" "grid" "effects"
## [6] "carData" "modelsummary" "fst" "infer" "lubridate"
## [11] "forcats" "stringr" "dplyr" "purrr" "readr"
## [16] "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [21] "graphics" "grDevices" "utils" "datasets" "methods"
## [26] "base"
##
## [[7]]
## [1] "MASS" "survey" "survival" "Matrix" "grid"
## [6] "effects" "carData" "modelsummary" "fst" "infer"
## [11] "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [16] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [21] "stats" "graphics" "grDevices" "utils" "datasets"
## [26] "methods" "base"
##
## [[8]]
## [1] "aod" "MASS" "survey" "survival" "Matrix"
## [6] "grid" "effects" "carData" "modelsummary" "fst"
## [11] "infer" "lubridate" "forcats" "stringr" "dplyr"
## [16] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [21] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [26] "datasets" "methods" "base"
##
## [[9]]
## [1] "interactions" "aod" "MASS" "survey" "survival"
## [6] "Matrix" "grid" "effects" "carData" "modelsummary"
## [11] "fst" "infer" "lubridate" "forcats" "stringr"
## [16] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [21] "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [26] "utils" "datasets" "methods" "base"
##
## [[10]]
## [1] "kableExtra" "interactions" "aod" "MASS" "survey"
## [6] "survival" "Matrix" "grid" "effects" "carData"
## [11] "modelsummary" "fst" "infer" "lubridate" "forcats"
## [16] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [21] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [26] "grDevices" "utils" "datasets" "methods" "base"
##
## [[11]]
## [1] "flextable" "kableExtra" "interactions" "aod" "MASS"
## [6] "survey" "survival" "Matrix" "grid" "effects"
## [11] "carData" "modelsummary" "fst" "infer" "lubridate"
## [16] "forcats" "stringr" "dplyr" "purrr" "readr"
## [21] "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [26] "graphics" "grDevices" "utils" "datasets" "methods"
## [31] "base"
##
## [[12]]
## [1] "scales" "flextable" "kableExtra" "interactions" "aod"
## [6] "MASS" "survey" "survival" "Matrix" "grid"
## [11] "effects" "carData" "modelsummary" "fst" "infer"
## [16] "lubridate" "forcats" "stringr" "dplyr" "purrr"
## [21] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [26] "stats" "graphics" "grDevices" "utils" "datasets"
## [31] "methods" "base"
Task 1
# Loading Germany's data in
germany_data <- read_fst("germany_data.fst")
# Renaming the dataset to df
df <- germany_data
# Survey weights
df$weight <- df$dweight * df$pweight
survey_design <- svydesign(ids = ~1, data = df, weights = ~weight)
# Multiple linear regression scale
# Setting up the populist scale
df$trstplt <- ifelse(df$trstplt > 10, NA, df$trstplt)
df$trstprl <- ifelse(df$trstprl > 10, NA, df$trstprl)
df$trstprt <- ifelse(df$trstprt > 10, NA, df$trstprt)
df$trust <- scales::rescale(df$trstplt + df$trstprl + df$trstprt, na.rm = TRUE, to = c(0, 100))
df$populist <- scales::rescale(df$trust, na.rm = TRUE, to = c(100, 0))
df <- df %>%
mutate(
cohort = ifelse(yrbrn < 1930 | yrbrn > 2000, NA, yrbrn),
gen = case_when(
yrbrn %in% 1900:1945 ~ "Interwar",
yrbrn %in% 1946:1964 ~ "Baby Boomers",
yrbrn %in% 1965:1979 ~ "Gen X",
yrbrn %in% 1980:1996 ~ "Millennials",
TRUE ~ as.character(yrbrn)
),
gen = factor(gen,
levels = c("Interwar", "Baby Boomers", "Gen X", "Millennials"),
labels = c("Interwar", "Baby Boomers", "Gen X", "Millennials"))
)
# Running models
model3 <- lm(populist ~ gen, data = df, weights = weight)
model4 <- lm(populist ~ gen + cohort, data = df, weights = weight)
# Modelsummary table
modelsummary(
list(model3, model4),
fmt = 1,
estimate = c("{estimate} ({std.error}){stars}",
"{estimate} ({std.error}){stars}"),
statistic = NULL
)
|
|
 (1)
|
  (2)
|
|
(Intercept)
|
59.9 (0.3)***
|
304.2 (49.0)***
|
|
genBaby Boomers
|
1.6 (0.3)***
|
3.4 (0.6)***
|
|
genGen X
|
0.3 (0.4)
|
3.9 (0.9)***
|
|
genMillennials
|
−3.0 (0.4)***
|
2.7 (1.3)*
|
|
cohort
|
|
−0.1 (0.0)***
|
|
Num.Obs.
|
28552
|
27899
|
|
R2
|
0.007
|
0.008
|
|
R2 Adj.
|
0.007
|
0.008
|
|
AIC
|
256975.5
|
251065.9
|
|
BIC
|
257016.8
|
251115.3
|
|
Log.Lik.
|
−128482.771
|
−125526.939
|
|
RMSE
|
20.73
|
20.72
|
all the coefficients of the MLR without the interaction
model3_germany are set at the 0.001 level. There are found to be shifts
in the populists attitude scales for every unit rise. there is a
compication observed with MLR interpretation and interacion with
model4_germany. The connection between the predictors and outcome varies
based upon other responses.
Task 2
interaction_plot <- effect("gen*cohort", model4, na.rm = TRUE)
## NOTE: gen:cohort does not appear in the model
plot(interaction_plot,
main = "Interaction Effect: Generational Cohort and Year of Birth on Populist Attitudes",
xlab = "Generational Cohort",
ylab = "Populist Attitudes Scale")
interaction_plot
##
## gen*cohort effect
## cohort
## gen 1930 1950 1960 1980 2000
## Interwar 61.38713 58.87057 57.61228 55.09572 52.57916
## Baby Boomers 64.75681 62.24025 60.98197 58.46541 55.94885
## Gen X 65.31135 62.79479 61.53651 59.01995 56.50339
## Millennials 64.10352 61.58696 60.32868 57.81212 55.29556
the visualization of the interaction between, capital,generation,
and amount of populist attitude is depicted through the interaction
plot. different capital levels are observed by the interaction effect
that is indicated by non paralell lines. critical components of the
interpretation land on variation of line slopes.
Task 3
netherlands_data <- read_fst("netherlands_data.fst")
# Renaming dataset to df for Netherlands data
df_netherlands <- netherlands_data
# Survey weights
df$weight <- df$dweight * df$pweight
survey_design <- svydesign(ids = ~1, data = df, weights = ~weight)
# Recoding variables for model5 and model6
df <- df %>%
mutate(
polID = 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_
),
religious = case_when(
rlgdgr %in% c(77, 88, 99) ~ NA_real_,
TRUE ~ rlgdgr
)
)
df <- df %>%
mutate(
behave = ipbhprp,
secure = impsafe,
safety = ipstrgv,
tradition = imptrad,
rules = ipfrule,
across(c("behave", "secure", "safety", "tradition", "rules"),
~ na_if(.x, 7) %>% na_if(8) %>% na_if(9)),
across(c("behave", "secure", "safety", "tradition", "rules"), ~ 7 - .x ),
auth = scales::rescale(behave + secure + safety + tradition + rules, to=c(0,100), na.rm=TRUE)
)
# Running models
model5 <- lm(auth ~ polID + religious, data = df, weights = weight)
model6 <- lm(auth ~ polID + religious + polID*religious, data = df, weights = weight)
# Modelsummary table
modelsummary(
list(model5, model6),
fmt = 1,
estimate = c("{estimate} ({std.error}){stars}",
"{estimate} ({std.error}){stars}"),
statistic = NULL,
coef_omit = "Intercept"
)
|
|
 (1)
|
  (2)
|
|
polIDModerate
|
4.6 (0.3)***
|
3.4 (0.4)***
|
|
polIDRight
|
7.7 (0.4)***
|
4.2 (0.7)***
|
|
religious
|
0.9 (0.0)***
|
0.6 (0.1)***
|
|
polIDModerate × religious
|
|
0.3 (0.1)***
|
|
polIDRight × religious
|
|
0.8 (0.1)***
|
|
Num.Obs.
|
23373
|
23373
|
|
R2
|
0.048
|
0.050
|
|
R2 Adj.
|
0.048
|
0.050
|
|
AIC
|
200594.1
|
200558.6
|
|
BIC
|
200634.4
|
200615.0
|
|
Log.Lik.
|
−100292.049
|
−100272.298
|
|
RMSE
|
17.27
|
17.24
|
Model 6 shows us an interaction point to investigate the variability
between the relationship of political ideology and authoritian views,
based on different levels of religion. Model 5 on the other hand focuses
more on observing the individual impacts based on political ideology and
religiosity at a seperate level between the attitudes. The coefficients
in Model 5 indicate significant effects for both political ideology and
religiousness: individuals identifying as politically right-leaning and
those with higher levels of religious inclination tend to score higher
on the authoritarian attitudes scale.
Task 4
df <- df %>%
mutate(
behave = ipbhprp,
secure = impsafe,
safety = ipstrgv,
tradition = imptrad,
rules = ipfrule,
across(c("behave", "secure", "safety", "tradition", "rules"),
~ na_if(.x, 7) %>% na_if(8) %>% na_if(9)),
across(c("behave", "secure", "safety", "tradition", "rules"), ~ 7 - .x ),
auth = scales::rescale(behave + secure + safety + tradition + rules, to=c(0,100), na.rm=TRUE)
)
df <- df %>% filter(!is.na(auth))
model7 <- lm(auth ~ polID + cohort + polID*cohort, data = df, weights = weight)
interaction_plot <- effect("polID*cohort", model7, na.rm = TRUE)
plot(interaction_plot,
main = "Interaction Effect: Political Ideology and Generational Cohort on Authoritarian Attitudes",
xlab = "Political Ideology",
ylab = "Authoritarian Attitudes Scale")
interaction_plot
##
## polID*cohort effect
## cohort
## polID 1930 1950 1960 1980 2000
## Left 66.75900 61.83047 59.36620 54.43767 49.50915
## Moderate 70.45384 66.29155 64.21041 60.04812 55.88583
## Right 74.46138 69.33910 66.77796 61.65569 56.53341
model 7 shows us the impact between the interaction of generational
cohort and political ideology for netherlands data. The regretion slopes
for left, moderate and right political ideology groups. This furthermore
provides a visual understanding of how these variables interact to
influence authoritarian attitudes.
Task 5
df <- df %>%
mutate(
behave = ipbhprp,
secure = impsafe,
safety = ipstrgv,
tradition = imptrad,
rules = ipfrule,
across(c("behave", "secure", "safety", "tradition", "rules"),
~ na_if(.x, 7) %>% na_if(8) %>% na_if(9)),
across(c("behave", "secure", "safety", "tradition", "rules"), ~ 7 - .x ),
auth = scales::rescale(behave + secure + safety + tradition + rules, to=c(0,100), na.rm=TRUE),
ID = case_when(
lrscale >= 0 & lrscale <= 4 ~ "Left",
lrscale >= 6 & lrscale <= 10 ~ "Right",
lrscale > 10 ~ NA_character_, # Set values above 10 as NA
TRUE ~ NA_character_ # Ensure value 5 and any other unexpected values are set as NA
)
)
df <- df %>% filter(!is.na(auth))
model8 <- lm(auth ~ religious + ID + religious*ID, data = df, weights = weight)
interaction_plot <- effect("religious*ID", model8, na.rm = TRUE)
plot(interaction_plot,
main = "Interaction Effect: Religiousness and Ideological Self-placement on Authoritarian Attitudes",
xlab = "Religiousness",
ylab = "Authoritarian Attitudes Scale")
interaction_plot
##
## religious*ID effect
## ID
## religious Left Right
## 0 56.71321 60.03449
## 2 58.04484 62.66420
## 5 60.04229 66.60877
## 8 62.03973 70.55333
## 10 63.37136 73.18304
ideological placement and impact of religion on authoritian
attitudes is seen in model 8 in netherlands data. those who are
politically right and left have different relationships with religion
and authoritian tendencies. The graphics help us understand religion
level between all the different groups. The ideological self placement
unlocks the understanding of how they fall under authoritian
attitudes.
End