Reader survey 2025

Init

#devtools::install_github("stephenslab/ebpm")

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(
  mirt,
  ebpm,
  googlesheets4
)

## Loading required package: stats4
## Loading required package: lattice

theme_set(theme_bw())

options(
    digits = 3
)

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

Functions

#convert likert to numeric
convert_likert = function(x) {
  case_when(
    x == "Dislike a lot" ~ -2,
    x == "Dislike" ~ -1,
    x == "Neutral" ~ 0,
    x == "Like" ~ 1,
    x == "Like a lot" ~ 2,
    TRUE ~ NA_real_
  )
}

Data

d = read_csv("data/20250618192249-SurveyExport.csv") %>% df_legalize_names()

## Rows: 664 Columns: 190
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (166): Status, Language, Referer, SessionID, User Agent, IP Address, Co...
## dbl   (18): Response ID, Longitude, Latitude, When did you start reading my ...
## lgl    (4): Contact ID, Legacy Comments, Comments, Tags
## dttm   (2): Time Started, Date Submitted
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

d_vars = d %>% df_var_table()

#population counts for countries
gs4_deauth()
pops = read_sheet("https://docs.google.com/spreadsheets/d/1dLw7bGWJNe9hlLq3sPtzB5_-mDvkBqdLDqVmDVki1Go/edit#gid=0")

## ✔ Reading from "Population sizes by country".
## ✔ Range 'Sheet1'.

pops$ISO = pu_translate(pops$Country)

#IQ data
IQs = read_sheet("https://docs.google.com/spreadsheets/d/1cReoeIZLlbxOrN4_wnj52Q6UWFepXSJGi3Gj5m6ZAZg/edit") %>% 
  df_legalize_names()

## ✔ Reading from "National IQ datasets".
## ✔ Range 'Emil'.

Recode

#extract percentages from pol_compass
d$pol_compass_X = d$This_meme_went_out_of_fashion_however_it_s_still_fun_to_track_self_placement_on_the_political_compass_over_time_and_see_how_it_relates_to_self_labels_So_where_are_you %>% 
  str_extract_all("\\d+") %>% 
  map(as.numeric) %>% 
  map_dbl(function(x) {
    if (length(x) > 0) {
      return(x[4])
    } else {
      return(NA_real_)
    }
  }) %>% 
  kirkegaard::rescale(0, 100)

#Y
d$pol_compass_Y = d$This_meme_went_out_of_fashion_however_it_s_still_fun_to_track_self_placement_on_the_political_compass_over_time_and_see_how_it_relates_to_self_labels_So_where_are_you %>% 
  str_extract_all("\\d+") %>% 
  map(as.numeric) %>% 
  map_dbl(function(x) {
    if (length(x) > 0) {
      return(x[5])
    } else {
      return(NA_real_)
    }
  }) %>% 
  kirkegaard::rescale(0, 100)

#morality
d$moral_realism = d$Is_morality_real_though
d$moral_theory = d$Moral_framework_if_you_must_choose

Analysis

Basics

#subject counts
print(nrow(d) / 552, digits = 5)

## [1] 1.2029

#completed cases
sum(d$Status=="Complete")/238

## [1] 1.34

#promised new paid subs
664*0.075

## [1] 49.8

#age
d$How_old_are_you %>% 
  describe2()

Country

#IP locations
d %>% 
  mutate(
    #sort by most common
    Country = Country %>% fct_infreq() %>% fct_rev()
  ) %>% 
  filter(!is.na(Country)) %>% 
  count(Country) %>%
  ggplot(aes(x = Country, y = n)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), color = "red", hjust = 0) +
  ggtitle("IP-based country of survey participants as Percentages") +
  coord_flip()

GG_save("figs/2025/countries.png")

#population counts
country_counts = d %>% 
  filter(!is.na(Country)) %>% 
  count(Country) %>% 
  filter(
    !Country %in% c("Anonymous Proxy", "Europe")
  ) %>% 
  mutate(
    ISO = pu_translate(Country)
  )

## No exact match: Iran, Islamic Republic of

## No exact match: Korea, Republic of

## Best fuzzy match found: Iran, Islamic Republic of -> Iran Islamic Republic of with distance 1.00

## Best fuzzy match found: Korea, Republic of -> Korea Republic of with distance 1.00

#join
countries = full_join(
  country_counts %>% select(-Country),
  pops,
  by = "ISO"
) %>% 
  left_join(
    IQs %>% select(ISO, IQ_6datasets),
  )

## Joining with `by = join_by(ISO)`

#impute n = 0 if missing
countries$n[is.na(countries$n)] = 0

#per million, a simple but problematic method
countries$per_capita = (countries$n / countries$population2023)

#empirical Bayes
fit_ebayes = ebpm_gamma(
  countries$n,
  countries$population2023
  )
fit_ebayes %>% summary()

##                Length Class       Mode   
## fitted_g       3      point_gamma list   
## posterior      2      data.frame  list   
## log_likelihood 1      -none-      numeric

countries$per_capita_bayes = fit_ebayes$posterior$mean

#per capita plot
countries %>% 
  filter(!is.na(Country), n > 0) %>%
  mutate(
    Country = Country %>% fct_reorder(per_capita)
  ) %>%
  ggplot(aes(x = Country, y = per_capita)) +
  geom_bar(stat = "identity") +
  ggtitle("Emil blog readership rate (per million)") +
  coord_flip() +
  scale_y_continuous("Emil blog readership rate per million")

GG_save("figs/countries per capita.png")

#compare per capita to empirical Bayes
countries %>% 
  filter(n > 0) %>% 
  mutate(
    #into per million
    per_capita = per_capita * 1e6,
    per_capita_bayes = per_capita_bayes * 1e6
  ) %>% 
  GG_scatter(
    "per_capita",
    "per_capita_bayes",
    case_names = "Country"
  ) +
  scale_x_log10() +
  scale_y_log10() +
  labs(
    x = "Crude readership per million",
    y = "Empirical Bayes per capita readership",
    title = "Comparison of readership rates",
    subtitle = "Crude vs empirical Bayes"
  )

## `geom_smooth()` using formula = 'y ~ x'

GG_save("figs/2025/countries per capita comparison.png")

## `geom_smooth()` using formula = 'y ~ x'

#rank order cor
countries %>% 
  filter(n > 0) %>% 
  select(per_capita, per_capita_bayes) %>% 
  cor(method = "spearman")

##                  per_capita per_capita_bayes
## per_capita            1.000            0.995
## per_capita_bayes      0.995            1.000

Political labels

#select the pol labels data
pol_labels = d %>% 
  select(contains("f_you_had_to_describe_yo")) %>% 
  {
    names(.) = str_replace(names(.), "_If_you_had_to_describe_your_politics_using_only_labels_which_would_you_say_apply_to_you_Scenario_God_pulls_you_aside_and_asks_you_and_he_will_punish_you_if_you_lie", "") %>% str_clean()
    .
  } %>% 
  map_df(~!is.na(.)) %>% 
  map_df(as.numeric)

#which rows have no selections? i.e., people who skipped
pol_labels_skip = rowSums(pol_labels) == 0

#subset
pol_labels_no_skip = pol_labels[!pol_labels_skip, ]

#correlation matrix using mixedcor
pol_labels_cors = pol_labels_no_skip %>% 
  as.data.frame() %>% 
  polycor::hetcor()

#alt method
pol_labels_cors2 = pol_labels_no_skip %>% 
  as.data.frame() %>% 
  psych::mixedCor()

## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done

#compute p values from r and SE, inverse normal, 2 sided
pol_labels_cors$p = NA_real_
pol_labels_cors$std.err = pol_labels_cors$std.err %>% 
  as.numeric()
  
pol_labels_cors$p = (pol_labels_cors$correlations / pol_labels_cors$std.errors) %>% 
  pnorm(lower.tail = FALSE) %>% 
  `*`(2) #two-tailed

pol_labels_cors2$rho %>% 
  GG_heatmap(
    font_size = 2,
    ) +
  #put the legend inside the plot
  #make background white using theme
  theme(
    legend.position = "inside",
    panel.background = element_rect(fill = "white", linewidth = 0),
    plot.background = element_rect(fill = "white", linewidth = 0)
    ) +
  ggtitle("Correlation matrix of political labels", subtitle = "Latent correlations (tetrachoric)")

GG_save("figs/political labels cors 2025.png")

#IRT
pol_labels_irt = mirt(
  pol_labels_no_skip,
  model = 1,
  itemtype = "2PL",
  technical = list(NCYCLES = 2000)
)

## Iteration: 1, Log-Lik: -3900.531, Max-Change: 0.86430Iteration: 2, Log-Lik: -3855.453, Max-Change: 0.33273Iteration: 3, Log-Lik: -3833.671, Max-Change: 0.35795Iteration: 4, Log-Lik: -3817.282, Max-Change: 0.40637Iteration: 5, Log-Lik: -3803.519, Max-Change: 0.37946Iteration: 6, Log-Lik: -3792.336, Max-Change: 0.31463Iteration: 7, Log-Lik: -3783.123, Max-Change: 0.23582Iteration: 8, Log-Lik: -3775.603, Max-Change: 0.17356Iteration: 9, Log-Lik: -3769.815, Max-Change: 0.12771Iteration: 10, Log-Lik: -3765.828, Max-Change: 0.10473Iteration: 11, Log-Lik: -3763.166, Max-Change: 0.08498Iteration: 12, Log-Lik: -3761.583, Max-Change: 0.06626Iteration: 13, Log-Lik: -3759.894, Max-Change: 0.02494Iteration: 14, Log-Lik: -3759.785, Max-Change: 0.01546Iteration: 15, Log-Lik: -3759.737, Max-Change: 0.01249Iteration: 16, Log-Lik: -3759.691, Max-Change: 0.01024Iteration: 17, Log-Lik: -3759.685, Max-Change: 0.00399Iteration: 18, Log-Lik: -3759.682, Max-Change: 0.00327Iteration: 19, Log-Lik: -3759.679, Max-Change: 0.00114Iteration: 20, Log-Lik: -3759.679, Max-Change: 0.00104Iteration: 21, Log-Lik: -3759.679, Max-Change: 0.00035Iteration: 22, Log-Lik: -3759.679, Max-Change: 0.00031Iteration: 23, Log-Lik: -3759.679, Max-Change: 0.00020Iteration: 24, Log-Lik: -3759.679, Max-Change: 0.00017Iteration: 25, Log-Lik: -3759.679, Max-Change: 0.00052Iteration: 26, Log-Lik: -3759.679, Max-Change: 0.00039Iteration: 27, Log-Lik: -3759.679, Max-Change: 0.00014Iteration: 28, Log-Lik: -3759.679, Max-Change: 0.00012Iteration: 29, Log-Lik: -3759.679, Max-Change: 0.00030Iteration: 30, Log-Lik: -3759.679, Max-Change: 0.00007

pol_labels_irt %>% summary()

##                        F1     h2
## neoreactionary NRX -0.210 0.0441
## alt right          -0.567 0.3210
## ethnonationalist   -0.602 0.3619
## communist           0.619 0.3829
## socialist          -0.210 0.0442
## liberal             0.726 0.5274
## classical liberal   0.597 0.3569
## leftist             0.218 0.0476
## conservative       -0.142 0.0201
## libertarian         0.396 0.1568
## anarcholibertarian  0.335 0.1124
## radical centrist    0.447 0.2002
## plain old centrist  0.559 0.3121
## YIMBY               0.575 0.3308
## NIMBY               0.049 0.0024
## moderate            0.495 0.2451
## center right        0.351 0.1234
## center left         0.489 0.2390
## apolitical          0.198 0.0392
## feminist            0.598 0.3581
## anti feminist      -0.222 0.0491
## nationalist        -0.424 0.1795
## globalist           0.810 0.6567
## neoliberal          0.895 0.8004
## 
## SS loadings:  5.91 
## Proportion Var:  0.246 
## 
## Factor correlations: 
## 
##    F1
## F1  1

#save scores to main
#but only for rows with actual data
d$pol_labels_score = NA_real_
d$pol_labels_score[!pol_labels_skip] = fscores(pol_labels_irt)[, 1] %>% standardize()

#correlations among scores and self-placement
d %>% 
  select(pol_labels_score, pol_compass_X, pol_compass_Y) %>% 
  wtd.cors()

##                  pol_labels_score pol_compass_X pol_compass_Y
## pol_labels_score           1.0000       -0.1964       -0.0867
## pol_compass_X             -0.1964        1.0000        0.0188
## pol_compass_Y             -0.0867        0.0188        1.0000

#2 d matrix of labels by factor loadings
pol_labels_fa2 = fa(
  pol_labels_cors2$rho,
  nfactors = 2,
  rotate = "none"
)

pol_labels_fa2

## Factor Analysis using method =  minres
## Call: fa(r = pol_labels_cors2$rho, nfactors = 2, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                      MR1   MR2    h2    u2 com
## neoreactionary NRX  0.04  0.39 0.152 0.848 1.0
## alt right          -0.21  0.57 0.370 0.630 1.3
## ethnonationalist   -0.29  0.55 0.382 0.618 1.5
## communist           0.77  0.58 0.925 0.075 1.9
## socialist           0.23  0.54 0.342 0.658 1.4
## liberal             0.67 -0.22 0.497 0.503 1.2
## classical liberal   0.46 -0.45 0.411 0.589 2.0
## leftist             0.47  0.46 0.437 0.563 2.0
## conservative       -0.09  0.07 0.013 0.987 1.8
## libertarian         0.30 -0.25 0.153 0.847 1.9
## anarcholibertarian  0.34  0.11 0.130 0.870 1.2
## radical centrist    0.44 -0.08 0.196 0.804 1.1
## plain old centrist  0.69  0.14 0.503 0.497 1.1
## YIMBY               0.56 -0.14 0.330 0.670 1.1
## NIMBY               0.34  0.46 0.324 0.676 1.8
## moderate            0.51 -0.06 0.268 0.732 1.0
## center right        0.30 -0.16 0.114 0.886 1.5
## center left         0.54  0.10 0.302 0.698 1.1
## apolitical          0.32  0.19 0.135 0.865 1.6
## feminist            0.63  0.15 0.417 0.583 1.1
## anti feminist       0.14  0.38 0.165 0.835 1.3
## nationalist        -0.11  0.48 0.244 0.756 1.1
## globalist           0.70 -0.18 0.526 0.474 1.1
## neoliberal          0.74 -0.38 0.694 0.306 1.5
## 
##                        MR1  MR2
## SS loadings           5.18 2.85
## Proportion Var        0.22 0.12
## Cumulative Var        0.22 0.33
## Proportion Explained  0.65 0.35
## Cumulative Proportion 0.65 1.00
## 
## Mean item complexity =  1.4
## Test of the hypothesis that 2 factors are sufficient.
## 
## df null model =  276  with the objective function =  100
## df of  the model are 229  and the objective function was  93.3 
## 
## The root mean square of the residuals (RMSR) is  0.13 
## The df corrected root mean square of the residuals is  0.14 
## 
## Fit based upon off diagonal values = 0.78
## Measures of factor score adequacy             
##                                                    MR1  MR2
## Correlation of (regression) scores with factors   0.96 0.98
## Multiple R square of scores with factors          0.93 0.96
## Minimum correlation of possible factor scores     0.85 0.91

#plot loadings
pol_labels_fa2$loadings %>% 
  as.data.frame() %>% 
  miss_filter() %>%
  as.data.frame() %>% 
  rownames_to_column("label") %>% 
  ggplot(aes(MR1, MR2, label = label)) +
  geom_text(size = 3) +
  labs(
    x = "Factor 1",
    y = "Factor 2",
    title = "Political labels factor loadings",
    subtitle = "2D factor solution (orthogonal)"
  )

GG_save("figs/political labels factor loadings 2025.png")

Morality

GG_contingency_table(
  d,
  "moral_realism",
  "moral_theory"
) +
  labs(
    x = "Moral theory",
    y = "Moral realism",
    title = "Moral views"
  )

GG_save("figs/2025/morality.png")

Ratings

People and entities

#subset ratings, and convert to numeric
d_ratings = d %>% 
  select(ends_with("How_much_do_you_like_or_not_like_the_following_The_purpose_of_answering_these_is_to_get_a_map_of_who_is_liked_together")) %>% 
  #clean names
  {
    names(.) = str_replace(names(.), "_How_much_do_you_like_or_not_like_the_following_The_purpose_of_answering_these_is_to_get_a_map_of_who_is_liked_together", "") %>% str_clean()
    .
  } %>% 
  map_df(~ordered(.x, levels = c("Dislike a lot", "Dislike", "Neutral", "Like", "Like a lot")))

#numerics
d_ratings_num = d_ratings %>% 
  map_df(convert_likert)

#correlations
d_ratings_num %>% 
  GG_heatmap(short_x_labels = T, font_size = 0, dodge_x_labels = 2) +
  # theme_bw() +
  #move legend inside
  # scale_x_discrete(guide = guide_axis(n.dodge = 2)) +
  ggtitle("Correlations among ratings")

GG_save("figs/2025/ratings heatmap.png")

#factor analyze
d_ratings_fa = fa(d_ratings_num, nfactors = 2, rotate = "none")
d_ratings_fa

## Factor Analysis using method =  minres
## Call: fa(r = d_ratings_num, nfactors = 2, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                                     MR1   MR2    h2   u2 com
## Jordan Peterson                   -0.11  0.25 0.073 0.93 1.4
## Sam Harris                        -0.56  0.21 0.359 0.64 1.3
## Aporia magazine                    0.19  0.55 0.335 0.67 1.2
## The Guardian                      -0.50 -0.14 0.265 0.74 1.2
## New York Times                    -0.56  0.04 0.312 0.69 1.0
## Quillette                         -0.31  0.48 0.330 0.67 1.7
## The Unz Review                     0.47  0.20 0.262 0.74 1.4
## Taki s Magazine                    0.27  0.37 0.209 0.79 1.8
## Fox News                           0.26  0.14 0.088 0.91 1.5
## Emil Kirkegaard                    0.23  0.46 0.263 0.74 1.5
## Noah Carl                          0.05  0.59 0.350 0.65 1.0
## Bo Winegard                        0.08  0.57 0.336 0.66 1.0
## Joseph Bronski                     0.14  0.24 0.075 0.93 1.6
## Steve Sailer                       0.30  0.54 0.382 0.62 1.6
## Charles Murray                     0.08  0.59 0.351 0.65 1.0
## Richard Dawkins                   -0.34  0.44 0.310 0.69 1.9
## Richard Lewontin                  -0.22 -0.33 0.157 0.84 1.7
## Stephen Jay Gould                 -0.24 -0.39 0.211 0.79 1.7
## Richard Lynn                       0.26  0.50 0.321 0.68 1.5
## Trump                              0.63  0.06 0.400 0.60 1.0
## Adolf Hitler                       0.53 -0.27 0.354 0.65 1.5
## Josef Stalin                       0.15 -0.37 0.161 0.84 1.3
## Augusto Pinochet                   0.52  0.06 0.275 0.72 1.0
## Lee Kuan Yew                       0.21  0.31 0.142 0.86 1.8
## Mao Zedong                         0.08 -0.35 0.130 0.87 1.1
## Xi Jinping                         0.24 -0.24 0.113 0.89 2.0
## Putin                              0.59 -0.30 0.433 0.57 1.5
## Curtis Yarvin aka Mencius Moldbug  0.30  0.11 0.102 0.90 1.2
## Nick Land                          0.18  0.20 0.069 0.93 2.0
## Scott Alexander                   -0.44  0.34 0.306 0.69 1.9
## Bryan Caplan                      -0.37  0.22 0.187 0.81 1.6
## Bronze Age Pervert                 0.29  0.20 0.125 0.88 1.8
## Richard Spencer                    0.11 -0.08 0.019 0.98 1.8
## Nick Fuentes                       0.23 -0.13 0.070 0.93 1.5
## Tucker Carlson                     0.61 -0.06 0.381 0.62 1.0
## Jews                              -0.57  0.37 0.456 0.54 1.7
## Anti Semites                       0.61 -0.37 0.507 0.49 1.6
## Africans                          -0.48  0.02 0.230 0.77 1.0
## Europeans                          0.11  0.23 0.063 0.94 1.4
## Yourself                           0.00  0.25 0.061 0.94 1.0
## Your mother                       -0.11  0.12 0.026 0.97 2.0
## Your father                        0.01  0.15 0.023 0.98 1.0
## Academics                         -0.44  0.09 0.205 0.80 1.1
## Journalists                       -0.57 -0.01 0.324 0.68 1.0
## Muslims                           -0.37 -0.26 0.204 0.80 1.8
## Christians                         0.15  0.01 0.022 0.98 1.0
## Elon Musk                          0.38  0.31 0.239 0.76 1.9
## Substack                          -0.02  0.31 0.097 0.90 1.0
## Twitter X                          0.21  0.30 0.133 0.87 1.8
## Pronatalism                        0.13  0.22 0.066 0.93 1.6
## Arthur Jensen                      0.17  0.57 0.356 0.64 1.2
## Phil Rushton                       0.30  0.40 0.252 0.75 1.8
## Richard Hanania                   -0.50  0.21 0.296 0.70 1.3
## God                                0.17 -0.08 0.036 0.96 1.4
## Balaji                             0.02  0.13 0.018 0.98 1.0
## USA                               -0.15  0.32 0.129 0.87 1.4
## EU                                -0.60  0.08 0.370 0.63 1.0
## China                              0.06 -0.08 0.010 0.99 1.8
## Japan                              0.13  0.22 0.063 0.94 1.6
## Denmark                           -0.03  0.32 0.104 0.90 1.0
## 
##                        MR1  MR2
## SS loadings           6.90 5.65
## Proportion Var        0.11 0.09
## Cumulative Var        0.11 0.21
## Proportion Explained  0.55 0.45
## Cumulative Proportion 0.55 1.00
## 
## Mean item complexity =  1.4
## Test of the hypothesis that 2 factors are sufficient.
## 
## df null model =  1770  with the objective function =  26.1 with Chi Square =  16757
## df of  the model are 1651  and the objective function was  15.7 
## 
## The root mean square of the residuals (RMSR) is  0.09 
## The df corrected root mean square of the residuals is  0.09 
## 
## The harmonic n.obs is  398 with the empirical chi square  11148  with prob <  0 
## The total n.obs was  664  with Likelihood Chi Square =  10083  with prob <  0 
## 
## Tucker Lewis Index of factoring reliability =  0.395
## RMSEA index =  0.088  and the 90 % confidence intervals are  0.086 0.089
## BIC =  -645
## Fit based upon off diagonal values = 0.73
## Measures of factor score adequacy             
##                                                    MR1  MR2
## Correlation of (regression) scores with factors   0.95 0.94
## Multiple R square of scores with factors          0.91 0.89
## Minimum correlation of possible factor scores     0.82 0.78

#plot loadings
d_ratings_fa$loadings %>% 
  as.data.frame() %>% 
  miss_filter() %>% 
  as.data.frame() %>% 
  rownames_to_column() %>%
  ggplot(aes(MR1, MR2)) +
  geom_point() +
  ggrepel::geom_text_repel(aes(label = rowname)) +
  ggtitle("Factor loadings of ratings") +
  scale_x_continuous("Factor 1: conservatism/right-wing") +
  scale_y_continuous("Factor 2: libertarian/authoritarian")

## Warning: ggrepel: 1 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

GG_save("figs/2025/2025 ratings loadings.png")

#overall liking
d_ratings %>% 
  # map_df(fct_rev) %>% 
  GG_ordinal(
    font_size = 3,
    order = "positive"
  ) +
  ggtitle("Ratings of various entities, groups, or topics")

GG_save("figs/2025/2025 ratings ordinal.png")

d_ratings_num %>% 
  describe2() %>% 
  arrange(mean) %>% 
  print(n = Inf)

## # A tibble: 60 × 10
##    var                 n    mean median    sd   mad   min   max    skew kurtosis
##    <chr>           <dbl>   <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl>   <dbl>    <dbl>
##  1 Josef Stalin      433 -1.68       -2 0.667  0       -2     2  2.51     7.46  
##  2 Mao Zedong        434 -1.65       -2 0.641  0       -2     1  1.85     2.82  
##  3 Adolf Hitler      438 -1.18       -2 1.17   0       -2     2  1.25     0.404 
##  4 The Guardian      426 -1.09       -1 0.882  1.48    -2     2  0.676   -0.175 
##  5 Journalists       435 -1.03       -1 0.941  1.48    -2     2  0.664   -0.377 
##  6 Muslims           430 -1.03       -1 0.862  1.48    -2     2  0.559   -0.117 
##  7 Putin             427 -0.883      -1 1.09   1.48    -2     2  0.776   -0.167 
##  8 New York Times    426 -0.871      -1 0.996  1.48    -2     1  0.467   -0.863 
##  9 Xi Jinping        429 -0.825      -1 0.957  1.48    -2     2  0.445   -0.331 
## 10 Anti Semites      434 -0.770      -1 1.11   1.48    -2     2  0.739   -0.0485
## 11 Nick Fuentes      399 -0.762      -1 1.05   1.48    -2     2  0.498   -0.454 
## 12 Stephen Jay Go…   401 -0.756      -1 0.980  1.48    -2     1 -0.0250  -1.27  
## 13 Africans          430 -0.740      -1 0.883  1.48    -2     2  0.117   -0.719 
## 14 Fox News          430 -0.656      -1 0.870  1.48    -2     2  0.313   -0.259 
## 15 EU                430 -0.614      -1 1.06   1.48    -2     2  0.356   -0.823 
## 16 Richard Lewont…   378 -0.556       0 0.943  0       -2     2 -0.247   -0.656 
## 17 Richard Spencer   398 -0.548      -1 0.942  1.48    -2     2  0.164   -0.421 
## 18 China             430 -0.421       0 0.995  1.48    -2     2  0.150   -0.555 
## 19 Academics         431 -0.323       0 1.04   1.48    -2     2  0.116   -0.702 
## 20 Augusto Pinoch…   405 -0.296       0 1.14   1.48    -2     2  0.0672  -0.758 
## 21 Richard Hanania   411 -0.270       0 1.14   1.48    -2     2  0.102   -0.779 
## 22 Tucker Carlson    425 -0.268       0 1.12   1.48    -2     2  0.0416  -0.982 
## 23 Sam Harris        411 -0.241       0 1.08   1.48    -2     2  0.0805  -0.626 
## 24 Jordan Peterson   434 -0.141       0 1.10   1.48    -2     2  0.113   -0.846 
## 25 Trump             436 -0.0367      0 1.21   1.48    -2     2 -0.165   -1.04  
## 26 Balaji            361 -0.0194      0 0.565  0       -2     2 -0.927    3.91  
## 27 Bronze Age Per…   394 -0.0102      0 0.996  1.48    -2     2 -0.149   -0.362 
## 28 Curtis Yarvin …   404  0.0396      0 0.993  1.48    -2     2 -0.170   -0.258 
## 29 Nick Land         373  0.158       0 0.740  0       -2     2  0.0985   1.87  
## 30 Joseph Bronski    373  0.193       0 0.759  0       -2     2  0.327    1.23  
## 31 Jews              432  0.197       0 1.13   1.48    -2     2 -0.361   -0.555 
## 32 The Unz Review    393  0.232       0 0.805  0       -2     2  0.0572   0.355 
## 33 Quillette         400  0.248       0 0.891  1.48    -2     2 -0.121    0.214 
## 34 Bryan Caplan      402  0.279       0 0.946  1.48    -2     2 -0.0135   0.0127
## 35 Elon Musk         436  0.291       0 1.12   1.48    -2     2 -0.402   -0.644 
## 36 Richard Dawkins   424  0.297       0 1.11   1.48    -2     2 -0.303   -0.653 
## 37 Taki s Magazine   379  0.298       0 0.708  0       -2     2 -0.137    1.51  
## 38 Twitter X         434  0.316       1 1.12   1.48    -2     2 -0.454   -0.538 
## 39 Phil Rushton      388  0.423       0 0.811  0       -2     2  0.337    0.313 
## 40 Noah Carl         391  0.522       0 0.780  1.48    -2     2  0.186   -0.114 
## 41 Bo Winegard       389  0.532       0 0.719  1.48    -2     2  0.0949   0.389 
## 42 Christians        434  0.571       1 0.930  1.48    -2     2 -0.415   -0.0921
## 43 Scott Alexander   399  0.574       0 0.934  1.48    -2     2 -0.0580  -0.410 
## 44 God               425  0.591       0 1.08   1.48    -2     2 -0.183   -0.483 
## 45 USA               440  0.736       1 1.00   1.48    -2     2 -0.687   -0.140 
## 46 Denmark           437  0.776       1 0.827  1.48    -2     2 -0.683    1.26  
## 47 Aporia magazine   406  0.788       1 0.773  1.48    -2     2 -0.131   -0.143 
## 48 Richard Lynn      404  0.790       1 0.808  1.48    -2     2  0.0321  -0.561 
## 49 Steve Sailer      409  0.802       1 0.844  1.48    -2     2 -0.174   -0.462 
## 50 Lee Kuan Yew      402  0.876       1 0.876  1.48    -2     2 -0.357   -0.224 
## 51 Arthur Jensen     404  0.908       1 0.812  1.48    -2     2 -0.0264  -0.940 
## 52 Europeans         435  0.954       1 0.857  1.48    -1     2 -0.437   -0.525 
## 53 Pronatalism       423  0.967       1 0.859  1.48    -2     2 -0.608    0.125 
## 54 Yourself          438  0.977       1 1.01   1.48    -2     2 -0.925    0.393 
## 55 Charles Murray    425  1.04        1 0.836  1.48    -2     2 -0.670    0.322 
## 56 Japan             434  1.05        1 0.703  0       -2     2 -0.552    0.980 
## 57 Your father       435  1.07        1 1.12   1.48    -2     2 -1.20     0.639 
## 58 Substack          433  1.09        1 0.753  0       -2     2 -0.708    0.855 
## 59 Emil Kirkegaard   437  1.22        1 0.691  0       -2     2 -0.950    2.44  
## 60 Your mother       431  1.25        2 1.02   0       -2     2 -1.37     1.16

Statements

#subset statements, and convert to numeric
d_statements = d %>% 
  select(ends_with("_Do_you_agree")) %>% 
  #clean names
  {
    names(.) = str_replace(names(.), "_Do_you_agree", "") %>% str_clean()
    .
  } %>% 
  map_df(~ordered(.x, levels = c("Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree")))

#numerics
d_statements_num = d_statements %>% 
  map_df(as.numeric)

#overall agreement
d_statements %>% 
  # map_df(fct_rev) %>% 
  GG_ordinal(
    font_size = 3,
    order = "positive"
  ) +
  ggtitle("Agreement with various statements")

GG_save("figs/2025/2025 statements ordinal.png")

#factor analyze
d_statements_fa = fa(d_statements_num, nfactors = 2, rotate = "none")
d_statements_fa

## Factor Analysis using method =  minres
## Call: fa(r = d_statements_num, nfactors = 2, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
##                                                                MR1   MR2    h2
## The West should militarily support Ukraine                    0.48 -0.02 0.228
## There should be fewer restrictions on abortion                0.55  0.36 0.436
## Free speech is good                                           0.29  0.01 0.082
## There should be fewer restrictions on drug use                0.47  0.17 0.251
## Capitalism is a great system                                  0.21  0.14 0.065
## Feminism is good                                              0.57 -0.16 0.349
## Patriarchy is good                                           -0.63  0.11 0.404
## IQ tests measure something real and important                -0.15  0.40 0.184
## Immigration policy should consider IQ differences            -0.31  0.42 0.278
## My government should take in more immigrants                  0.55 -0.05 0.302
## Voluntary eugenics is good                                    0.08  0.74 0.560
## Coercive eugenics is good                                    -0.20  0.49 0.286
## Embryo selection                                              0.39  0.73 0.685
## People in 1900 were more intelligent than us                 -0.49  0.19 0.276
## Dysgenics is a substantial problem                           -0.35  0.53 0.407
## I would be upset if my daughter had an OnlyFans              -0.47 -0.06 0.226
## We should take drastic actions to reduce carbon emissions     0.34  0.10 0.124
## People are better off now than now many years ago             0.52 -0.01 0.266
## Gay marriage is morally no different from straight marriage   0.70  0.01 0.489
## Promoting the family unit is important for a healthy society -0.49  0.00 0.244
## Cthulhu swims left                                           -0.25  0.11 0.073
## All human life is of equal value                              0.17 -0.58 0.361
## Network states Balaji are worth trying                        0.15  0.11 0.035
## Nuclear power is good                                         0.09  0.25 0.072
## Democracy is the best political system of those we tried      0.52 -0.20 0.312
## Genetic editing CRISPR etc                                    0.43  0.58 0.518
##                                                                u2 com
## The West should militarily support Ukraine                   0.77 1.0
## There should be fewer restrictions on abortion               0.56 1.7
## Free speech is good                                          0.92 1.0
## There should be fewer restrictions on drug use               0.75 1.3
## Capitalism is a great system                                 0.94 1.7
## Feminism is good                                             0.65 1.2
## Patriarchy is good                                           0.60 1.1
## IQ tests measure something real and important                0.82 1.3
## Immigration policy should consider IQ differences            0.72 1.8
## My government should take in more immigrants                 0.70 1.0
## Voluntary eugenics is good                                   0.44 1.0
## Coercive eugenics is good                                    0.71 1.3
## Embryo selection                                             0.32 1.5
## People in 1900 were more intelligent than us                 0.72 1.3
## Dysgenics is a substantial problem                           0.59 1.7
## I would be upset if my daughter had an OnlyFans              0.77 1.0
## We should take drastic actions to reduce carbon emissions    0.88 1.2
## People are better off now than now many years ago            0.73 1.0
## Gay marriage is morally no different from straight marriage  0.51 1.0
## Promoting the family unit is important for a healthy society 0.76 1.0
## Cthulhu swims left                                           0.93 1.4
## All human life is of equal value                             0.64 1.2
## Network states Balaji are worth trying                       0.96 1.9
## Nuclear power is good                                        0.93 1.2
## Democracy is the best political system of those we tried     0.69 1.3
## Genetic editing CRISPR etc                                   0.48 1.8
## 
##                        MR1  MR2
## SS loadings           4.49 3.02
## Proportion Var        0.17 0.12
## Cumulative Var        0.17 0.29
## Proportion Explained  0.60 0.40
## Cumulative Proportion 0.60 1.00
## 
## Mean item complexity =  1.3
## Test of the hypothesis that 2 factors are sufficient.
## 
## df null model =  325  with the objective function =  8.19 with Chi Square =  5353
## df of  the model are 274  and the objective function was  2.56 
## 
## The root mean square of the residuals (RMSR) is  0.07 
## The df corrected root mean square of the residuals is  0.08 
## 
## The harmonic n.obs is  423 with the empirical chi square  1524  with prob <  3e-172 
## The total n.obs was  664  with Likelihood Chi Square =  1667  with prob <  6.2e-198 
## 
## Tucker Lewis Index of factoring reliability =  0.671
## RMSEA index =  0.087  and the 90 % confidence intervals are  0.084 0.092
## BIC =  -114
## Fit based upon off diagonal values = 0.88
## Measures of factor score adequacy             
##                                                    MR1  MR2
## Correlation of (regression) scores with factors   0.94 0.93
## Multiple R square of scores with factors          0.88 0.86
## Minimum correlation of possible factor scores     0.75 0.72

#plot loadings
d_statements_fa$loadings %>% 
  as.data.frame() %>% 
  miss_filter() %>% 
  as.data.frame() %>% 
  rownames_to_column() %>%
  ggplot(aes(MR1, MR2)) +
  geom_point() +
  ggrepel::geom_text_repel(aes(label = rowname)) +
  ggtitle("Factor loadings of statements") +
  scale_x_continuous("Factor 1: leftism") +
  scale_y_continuous("Factor 2: biotech vs. nature")

GG_save("figs/2025/2025 statements loadings.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] stats4    stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] googlesheets4_1.1.1   ebpm_0.0.1.3          mirt_1.44.0          
##  [4] lattice_0.22-5        kirkegaard_2025-05-09 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] RColorBrewer_1.1-3   rstudioapi_0.17.1    audio_0.1-11        
##   [4] jsonlite_2.0.0       shape_1.4.6.1        jomo_2.7-6          
##   [7] farver_2.1.2         nloptr_2.2.1         rmarkdown_2.29      
##  [10] ragg_1.4.0           fs_1.6.6             vctrs_0.6.5         
##  [13] minqa_1.2.8          base64enc_0.1-3      mixsqp_0.3-54       
##  [16] htmltools_0.5.8.1    curl_6.2.2           broom_1.0.8         
##  [19] cellranger_1.1.0     Formula_1.2-5        mitml_0.4-5         
##  [22] dcurver_0.9.2        sass_0.4.10          parallelly_1.43.0   
##  [25] bslib_0.9.0          htmlwidgets_1.6.4    testthat_3.2.3      
##  [28] cachem_1.1.0         admisc_0.38          lifecycle_1.0.4     
##  [31] iterators_1.0.14     pkgconfig_2.0.3      Matrix_1.7-3        
##  [34] R6_2.6.1             fastmap_1.2.0        rbibutils_2.3       
##  [37] future_1.40.0        digest_0.6.37        colorspace_2.1-1    
##  [40] irlba_2.3.5.1        textshaping_1.0.0    vegan_2.6-10        
##  [43] labeling_0.4.3       progressr_0.15.1     timechange_0.3.0    
##  [46] gdata_3.0.1          httr_1.4.7           mgcv_1.9-1          
##  [49] compiler_4.5.0       gargle_1.5.2         bit64_4.6.0-1       
##  [52] withr_3.0.2          htmlTable_2.4.3      backports_1.5.0     
##  [55] R.utils_2.13.0       pan_1.9              MASS_7.3-65         
##  [58] sessioninfo_1.2.3    GPArotation_2025.3-1 gtools_3.9.5        
##  [61] permute_0.9-7        tools_4.5.0          foreign_0.8-90      
##  [64] googledrive_2.1.1    future.apply_1.11.3  nnet_7.3-20         
##  [67] R.oo_1.27.0          glue_1.8.0           nlme_3.1-168        
##  [70] stringdist_0.9.15    grid_4.5.0           checkmate_2.3.2     
##  [73] cluster_2.1.8.1      generics_0.1.3       gtable_0.3.6        
##  [76] tzdb_0.5.0           R.methodsS3_1.8.2    data.table_1.17.0   
##  [79] hms_1.1.3            utf8_1.2.4           Deriv_4.1.6         
##  [82] ggrepel_0.9.6        foreach_1.5.2        pillar_1.10.2       
##  [85] vroom_1.6.5          splines_4.5.0        survival_3.8-3      
##  [88] bit_4.6.0            tidyselect_1.2.1     pbapply_1.7-2       
##  [91] knitr_1.50           reformulas_0.4.0     gridExtra_2.3       
##  [94] xfun_0.52            brio_1.1.5           matrixStats_1.5.0   
##  [97] stringi_1.8.7        yaml_2.3.10          boot_1.3-31         
## [100] evaluate_1.0.3       codetools_0.2-19     beepr_2.0           
## [103] cli_3.6.4            rpart_4.1.24         systemfonts_1.2.2   
## [106] Rdpack_2.6.4         munsell_0.5.1        jquerylib_0.1.4     
## [109] readxl_1.4.5         Rcpp_1.0.14          globals_0.17.0      
## [112] polycor_0.8-1        parallel_4.5.0       lme4_1.1-37         
## [115] listenv_0.9.1        glmnet_4.1-8         mvtnorm_1.3-3       
## [118] SimDesign_2.19.2     scales_1.3.0         crayon_1.5.3        
## [121] rlang_1.1.6          mnormt_2.1.1         mice_3.17.0

#write data to file for reuse
d %>% 
  select(
    -SessionID, -IP_Address, -Longitude, -Latitude, -City, 
    -Any_private_comments_for_me
  ) %>% 
  write_csv("data/data_for_reuse.csv")

#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"
    )
}