Init

library(kirkegaard)
## Loading required package: tidyverse
## ── 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.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Loading required package: magrittr
## 
## 
## Attaching package: 'magrittr'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     set_names
## 
## 
## The following object is masked from 'package:tidyr':
## 
##     extract
## 
## 
## Loading required package: weights
## 
## Loading required package: Hmisc
## 
## 
## Attaching package: 'Hmisc'
## 
## 
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## 
## 
## The following objects are masked from 'package:base':
## 
##     format.pval, units
## 
## 
## Loading required package: assertthat
## 
## 
## Attaching package: 'assertthat'
## 
## 
## The following object is masked from 'package:tibble':
## 
##     has_name
## 
## 
## Loading required package: psych
## 
## 
## Attaching package: 'psych'
## 
## 
## The following object is masked from 'package:Hmisc':
## 
##     describe
## 
## 
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## 
## 
## 
## Attaching package: 'kirkegaard'
## 
## 
## The following object is masked from 'package:psych':
## 
##     rescale
## 
## 
## The following object is masked from 'package:assertthat':
## 
##     are_equal
## 
## 
## The following object is masked from 'package:purrr':
## 
##     is_logical
## 
## 
## The following object is masked from 'package:base':
## 
##     +
load_packages(
  haven,
  ggeffects,
  DirichletReg,
)
## Loading required package: Formula
theme_set(theme_bw())

options(
    digits = 3
)

#multithreading
#library(future)
#plan(multisession(workers = 8))

Functions

Data

#read SPSS file
d = read_sav("data/The_Value_Gap_DATA.sav")
d_vars = d %>% df_var_table()

d_budget = d %>% select(BAT_1_1:BAT_1_5) %>% set_colnames(c("academic_freedom", "advance_knowledge", "wellbeing", "social_justice", "academic_rigor")) %>% {
    #normalize
    . / rowSums(.)
  }

#prep compositional data
d$budget_dist = DR_data(d_budget)
## Warning in DR_data(d_budget): some entries are 0 or 1 => transformation forced
#recode
d$religiousness = d$Self_Religiosity %>% as_factor() %>% as.ordered()
d$sex = d$Gend_R %>% as_factor()
d$female = (d$Gend_R==1)
d$age = d$Age_New

Analysis

Politics

#better names
d_pol = d %>% select(PIS_1_1:PIS_1_12)
colnames(d_pol) = d_vars$label[d_vars$var_name %in% colnames(d_pol)] %>% str_remove("Please indicate the extent to which you agree with each statement. \n\nScores of 0 indicate strong disagreement, and scores of 100 indicate strong agreement. Scores of 50 indicate that you feel neutral about the issue. - ")

leftism_fa = fa(
  d_pol
)

leftism_fa
## Factor Analysis using method =  minres
## Call: fa(r = d_pol)
## Standardized loadings (pattern matrix) based upon correlation matrix
##                                                             MR1   h2   u2 com
## Women should have the right to have an abortion.          -0.60 0.36 0.64   1
## Government should be limited overall.                      0.52 0.27 0.73   1
## Military and National Security should be prioritized.      0.77 0.59 0.41   1
## All people should practice religion.                       0.49 0.24 0.76   1
## Welfare should not be expanded.                            0.66 0.44 0.56   1
## Gun ownership should not be restricted.                    0.58 0.33 0.67   1
## Traditional Marriage is important to maintaining society.  0.75 0.57 0.43   1
## Traditional Values are important to maintaining society.   0.74 0.55 0.45   1
## Taxation should be as limited as possible.                 0.64 0.41 0.59   1
## Businesses should be given maximal autonomy.               0.65 0.42 0.58   1
## The family unit is a foundational aspect of society.       0.62 0.38 0.62   1
## Patriotism is an important value.                          0.70 0.49 0.51   1
## 
##                 MR1
## SS loadings    5.05
## Proportion Var 0.42
## 
## Mean item complexity =  1
## Test of the hypothesis that 1 factor is sufficient.
## 
## df null model =  66  with the objective function =  5.4 with Chi Square =  3069
## df of  the model are 54  and the objective function was  0.98 
## 
## The root mean square of the residuals (RMSR) is  0.08 
## The df corrected root mean square of the residuals is  0.09 
## 
## The harmonic n.obs is  528 with the empirical chi square  444  with prob <  9.2e-63 
## The total n.obs was  574  with Likelihood Chi Square =  555  with prob <  3.3e-84 
## 
## Tucker Lewis Index of factoring reliability =  0.796
## RMSEA index =  0.127  and the 90 % confidence intervals are  0.118 0.137
## BIC =  212
## Fit based upon off diagonal values = 0.97
## Measures of factor score adequacy             
##                                                    MR1
## Correlation of (regression) scores with factors   0.95
## Multiple R square of scores with factors          0.91
## Minimum correlation of possible factor scores     0.81
d$leftism = leftism_fa$scores %>% as.numeric() %>% multiply_by(-1) %>% standardize()

Correlations

bind_cols(
  d %>% select(
  female,
  age,
  leftism
  ),
  d_budget
) %>% 
  mixedCor() %>% 
  .$rho %>% 
  GG_heatmap(reorder_vars = F)

Regressions

#complete cases subset
d_models = d %>% select(budget_dist, sex, age, leftism) %>% na.omit()

budget_fit = DirichReg(
  budget_dist ~ sex + age + leftism * sex,
  data = d_models
)

budget_fit
## Call:
## DirichReg(formula = budget_dist ~ sex + age + leftism * sex, data = d_models)
## using the common parametrization
## 
## Log-likelihood: 1948 on 25 df (148 BFGS + 2 NR Iterations)
## 
## -----------------------------------------
## Coefficients for variable no. 1: academic_freedom
##       (Intercept)          sexFemale                age            leftism  
##           0.26596           -0.03026           -0.00645            0.15047  
## sexFemale:leftism  
##          -0.04952  
## -----------------------------------------
## Coefficients for variable no. 2: advance_knowledge
##       (Intercept)          sexFemale                age            leftism  
##           0.67201           -0.03001            0.00097            0.08736  
## sexFemale:leftism  
##           0.11992  
## -----------------------------------------
## Coefficients for variable no. 3: wellbeing
##       (Intercept)          sexFemale                age            leftism  
##            0.8092             0.4588            -0.0305             0.3787  
## sexFemale:leftism  
##           -0.2593  
## -----------------------------------------
## Coefficients for variable no. 4: social_justice
##       (Intercept)          sexFemale                age            leftism  
##         -0.509389           0.631109           0.000839           0.494652  
## sexFemale:leftism  
##         -0.071342  
## -----------------------------------------
## Coefficients for variable no. 5: academic_rigor
##       (Intercept)          sexFemale                age            leftism  
##           -0.1952             0.0443             0.0129            -0.0324  
## sexFemale:leftism  
##           -0.0297  
## -----------------------------------------
budget_fit %>% summary()
## Call:
## DirichReg(formula = budget_dist ~ sex + age + leftism * sex, data = d_models)
## 
## Standardized Residuals:
##                      Min      1Q   Median     3Q   Max
## academic_freedom   -1.39  -0.439  -0.0363  0.397  2.63
## advance_knowledge  -2.05  -0.519  -0.1510  0.311  3.48
## wellbeing          -1.77  -0.488  -0.1807  0.341  4.49
## social_justice     -1.53  -0.518  -0.0228  0.481  7.94
## academic_rigor     -1.46  -0.482   0.0040  0.465  5.25
## 
## ------------------------------------------------------------------
## Beta-Coefficients for variable no. 1: academic_freedom
##                   Estimate Std. Error z value Pr(>|z|)  
## (Intercept)        0.26596    0.18406    1.44    0.148  
## sexFemale         -0.03026    0.09016   -0.34    0.737  
## age               -0.00645    0.00760   -0.85    0.396  
## leftism            0.15047    0.05978    2.52    0.012 *
## sexFemale:leftism -0.04952    0.07783   -0.64    0.525  
## ------------------------------------------------------------------
## Beta-Coefficients for variable no. 2: advance_knowledge
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        0.67200    0.18032    3.73  0.00019 ***
## sexFemale         -0.03001    0.08738   -0.34  0.73128    
## age                0.00097    0.00724    0.13  0.89348    
## leftism            0.08736    0.06334    1.38  0.16783    
## sexFemale:leftism  0.11992    0.08058    1.49  0.13670    
## ------------------------------------------------------------------
## Beta-Coefficients for variable no. 3: wellbeing
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         0.8092     0.1884    4.30  1.7e-05 ***
## sexFemale           0.4588     0.0890    5.15  2.5e-07 ***
## age                -0.0306     0.0077   -3.97  7.3e-05 ***
## leftism             0.3787     0.0651    5.82  6.1e-09 ***
## sexFemale:leftism  -0.2593     0.0828   -3.13   0.0017 ** 
## ------------------------------------------------------------------
## Beta-Coefficients for variable no. 4: social_justice
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)       -0.509389   0.184778   -2.76   0.0058 ** 
## sexFemale          0.631109   0.092042    6.86  7.0e-12 ***
## age                0.000839   0.007600    0.11   0.9121    
## leftism            0.494652   0.068781    7.19  6.4e-13 ***
## sexFemale:leftism -0.071342   0.086631   -0.82   0.4102    
## ------------------------------------------------------------------
## Beta-Coefficients for variable no. 5: academic_rigor
##                   Estimate Std. Error z value Pr(>|z|)  
## (Intercept)       -0.19516    0.17417   -1.12    0.263  
## sexFemale          0.04433    0.09044    0.49    0.624  
## age                0.01293    0.00711    1.82    0.069 .
## leftism           -0.03245    0.06007   -0.54    0.589  
## sexFemale:leftism -0.02973    0.07842   -0.38    0.705  
## ------------------------------------------------------------------
## Significance codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Log-likelihood: 1948 on 25 df (148 BFGS + 2 NR Iterations)
## AIC: -3846, BIC: -3741
## Number of Observations: 507
## Link: Log
## Parametrization: common
#make predictions
pred_data = expand_grid(
  age = median(d$age, na.rm = T),
  sex = d$sex %>% unique() %>% na.omit(),
  leftism = seq(-2, 2, length.out = 100)
)

#add predictions
pred_data = bind_cols(
  pred_data,
  predict(budget_fit, newdata = pred_data) %>% as.data.frame() %>% set_colnames(d$budget_dist %>% colnames)
)

pred_data %>% 
  select(-age) %>% 
  pivot_longer(-c(leftism, sex)) %>% 
  ggplot(aes(leftism, value, color = name)) +
  geom_line() +
  labs(
    x = "Leftism score (z scale)",
    y = "Budget distribution",
    color = "Budget item"
  ) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  facet_wrap("sex", labeller = "label_both")

GG_save("figs/leftism_budget.png")

Meta

#versions
write_sessioninfo()
## R version 4.5.0 (2025-04-11)
## Platform: x86_64-pc-linux-gnu
## Running under: Linux Mint 21.1
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0 
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0  LAPACK version 3.10.0
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_DK.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_DK.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_DK.UTF-8 LC_IDENTIFICATION=C       
## 
## time zone: Europe/Brussels
## tzcode source: system (glibc)
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] DirichletReg_0.7-1    Formula_1.2-5         ggeffects_2.2.1      
##  [4] haven_2.5.4           kirkegaard_2025-04-27 psych_2.5.3          
##  [7] assertthat_0.2.1      weights_1.0.4         Hmisc_5.2-3          
## [10] magrittr_2.0.3        lubridate_1.9.4       forcats_1.0.0        
## [13] stringr_1.5.1         dplyr_1.1.4           purrr_1.0.4          
## [16] readr_2.1.5           tidyr_1.3.1           tibble_3.2.1         
## [19] ggplot2_3.5.2         tidyverse_2.0.0      
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_1.2.1  farver_2.1.2      fastmap_1.2.0     digest_0.6.37    
##  [5] rpart_4.1.24      timechange_0.3.0  lifecycle_1.0.4   cluster_2.1.8.1  
##  [9] survival_3.8-3    gdata_3.0.1       compiler_4.5.0    rlang_1.1.6      
## [13] sass_0.4.10       tools_4.5.0       yaml_2.3.10       data.table_1.17.0
## [17] knitr_1.50        labeling_0.4.3    htmlwidgets_1.6.4 mnormt_2.1.1     
## [21] withr_3.0.2       foreign_0.8-90    nnet_7.3-20       grid_4.5.0       
## [25] jomo_2.7-6        colorspace_2.1-1  mice_3.17.0       scales_1.3.0     
## [29] gtools_3.9.5      iterators_1.0.14  MASS_7.3-65       insight_1.1.0    
## [33] cli_3.6.4         rmarkdown_2.29    ragg_1.4.0        miscTools_0.6-28 
## [37] reformulas_0.4.0  generics_0.1.3    rstudioapi_0.17.1 tzdb_0.5.0       
## [41] minqa_1.2.8       cachem_1.1.0      splines_4.5.0     parallel_4.5.0   
## [45] base64enc_0.1-3   vctrs_0.6.5       sandwich_3.1-1    boot_1.3-31      
## [49] glmnet_4.1-8      Matrix_1.7-3      jsonlite_2.0.0    hms_1.1.3        
## [53] mitml_0.4-5       htmlTable_2.4.3   systemfonts_1.2.2 foreach_1.5.2    
## [57] jquerylib_0.1.4   glue_1.8.0        nloptr_2.2.1      pan_1.9          
## [61] codetools_0.2-19  stringi_1.8.7     shape_1.4.6.1     gtable_0.3.6     
## [65] lme4_1.1-37       munsell_0.5.1     pillar_1.10.2     htmltools_0.5.8.1
## [69] R6_2.6.1          textshaping_1.0.0 maxLik_1.5-2.1    Rdpack_2.6.4     
## [73] evaluate_1.0.3    lattice_0.22-5    rbibutils_2.3     backports_1.5.0  
## [77] broom_1.0.8       bslib_0.9.0       Rcpp_1.0.14       gridExtra_2.3    
## [81] nlme_3.1-168      checkmate_2.3.2   xfun_0.52         zoo_1.8-14       
## [85] pkgconfig_2.0.3
#write data to file for reuse
d %>% write_rds("data/data_for_reuse.rds")

#OSF
if (F) {
  library(osfr)
  
  #login
  osf_auth(readr::read_lines("~/.config/osf_token"))
  
  #the project we will use
  osf_proj = osf_retrieve_node("https://osf.io/XXX/")
  
  #upload all files in project
  #overwrite existing (versioning)
  osf_upload(
    osf_proj,
    path = c("data", "figures", "papers", "notebook.Rmd", "notebook.html", "sessions_info.txt"), 
    conflicts = "overwrite"
    )
}