Init

library(kirkegaard)
## Loading required package: tidyverse
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0      ✔ purrr   0.3.5 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## 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
## 
## Loading required package: lattice
## 
## Loading required package: survival
## 
## Loading required package: Formula
## 
## 
## 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 objects are masked from 'package:purrr':
## 
##     is_logical, is_numeric
## 
## 
## The following object is masked from 'package:base':
## 
##     +
load_packages(
  patchwork
)

options(
  digits = 3
)

theme_set(theme_bw())

Data

d = read_csv("data/20230328222120-SurveyExport.csv") %>% df_legalize_names()
## Rows: 584 Columns: 77
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (10): Status, Language, Referer, SessionID, User Agent, IP Address, Cou...
## dbl  (61): Response ID, Longitude, Latitude, IQ of Scott Alexander, IQ of El...
## 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_table = df_var_table(d)

#variables for IQ estimates
estimate_vars = d %>% select(IQ_of_Scott_Alexander:IQ_of_your_self) %>% names()

#clean data
d_orig = d

for (v in estimate_vars) {
  d[[v]][d[[v]] < 70] = NA
}

Analysis

#long format, clean bad data, clean strings
d_long = d %>% 
  select(!!estimate_vars) %>% 
  pivot_longer(cols = everything()) %>% 
  filter(!is.na(value)) %>% 
  mutate(
    name = str_replace(name, "IQ_of_", "") %>% str_clean() %>% str_replace_all("The Alternative Hypothesis", "") %>% str_replace("James ", "") %>% mapvalues("your self", "yourself"),
    name = fct_reorder(name, value)
    )

#descriptives by person
describe2(d_long$value, d_long$name) %>% arrange(-median) %>% select(-var) %>% knitr::kable()
## New names:
## • `` -> `...1`
group n mean median sd mad min max skew kurtosis
Isaac Newton 289 162 160 16.8 14.83 114 200 0.439 -0.043
Immanuel Kant 221 149 149 17.9 16.31 100 200 0.296 0.509
Aristotle 244 152 148 19.1 17.79 74 200 0.605 1.571
Plato 244 148 148 18.3 14.09 77 200 0.465 2.116
Socrates 238 146 145 17.2 14.83 89 200 0.764 1.517
Frederich Nietzsche 229 146 144 19.2 14.83 79 200 0.449 1.409
Elon Musk 328 142 142 13.5 11.86 87 187 -0.155 1.714
Thomas Aquinas 195 144 142 17.6 13.34 74 200 0.340 2.506
Arthur Jensen 165 140 140 13.6 8.90 75 200 -0.414 4.726
Eliezer Yudkowsky 226 138 140 17.0 14.83 70 175 -0.983 1.875
Greg Cochran 173 138 140 15.2 13.34 72 172 -1.146 2.843
Robin Hanson 215 137 140 13.7 13.34 95 179 -0.490 1.013
Scott Alexander 289 138 140 14.0 11.86 77 187 -0.562 2.047
Curtis Yarvin 229 138 139 16.2 13.34 70 200 -0.026 2.344
Diogenes of Sinope 135 140 139 19.9 16.31 74 200 0.494 1.290
Gwern 183 137 136 14.7 13.34 93 180 -0.515 1.009
Nick Land 149 135 136 13.5 10.38 84 200 0.113 4.243
Charles Murray 281 135 135 12.0 8.90 73 200 0.465 6.337
Cremieux 85 132 135 17.7 14.83 70 171 -0.525 0.975
Emil Kirkegaard 279 134 135 13.1 7.41 82 200 0.435 5.983
John D Rockefeller 176 134 135 13.2 10.38 86 200 0.484 3.834
Razib Khan 234 134 135 12.8 8.90 82 162 -0.977 2.043
Steve Sailer 300 135 135 12.1 10.38 103 200 1.380 5.206
Meng Hu 86 131 133 14.5 10.38 85 166 -0.685 1.255
Sean Last 113 130 133 15.2 11.86 71 200 -0.183 4.795
yourself 303 133 132 16.2 10.38 94 200 1.436 5.025
Nathan Cofnas 124 130 131 10.7 10.38 99 150 -0.685 0.431
Noah Carl 175 129 131 11.5 8.90 90 164 -0.801 1.617
Philippe Rushton 129 132 131 12.0 8.90 103 200 1.252 6.876
Richard Lynn 151 132 131 11.5 8.90 100 200 1.035 7.436
Samo Burja 112 131 131 14.8 13.34 90 200 0.524 3.405
Bronze Age Pervert 208 130 130 16.5 14.83 70 200 -0.300 2.239
Geoffrey Miller 198 129 130 13.4 10.38 77 162 -0.859 1.654
John Fuerst 77 129 130 13.8 10.38 72 151 -1.253 3.228
Richard Hanania 247 128 130 13.7 13.34 73 194 -0.306 2.687
Spandrel 111 129 130 14.0 11.86 88 200 0.745 5.284
Ryan Faulk 116 129 129 13.2 11.86 100 200 1.239 6.061
Zach Goldberg 94 126 129 13.4 10.38 76 155 -0.911 1.471
Zero HP Lovecraft 183 128 129 13.6 13.34 90 184 -0.008 1.270
Davide Piffer 85 126 128 14.5 10.38 70 168 -1.028 2.751
Jayman 118 124 126 14.2 12.60 80 193 0.233 4.347
your dad 269 127 126 16.4 14.83 79 200 0.802 3.307
Anatoly Karlin 181 124 125 14.5 14.83 83 155 -0.165 -0.784
Matt Yglesias 279 123 125 13.6 11.86 75 160 -0.606 0.744
Roko Mijic 178 126 125 13.0 11.86 75 171 -0.499 1.551
Thuletide 75 125 125 17.9 14.83 85 200 1.094 3.787
Noah Smith 243 123 124 13.5 13.34 79 200 0.280 4.011
Aella 283 122 121 12.4 13.34 75 162 -0.202 1.070
Alexandra Kaschuta 127 121 121 10.5 10.38 90 148 -0.098 0.146
Donald Trump 335 122 121 14.4 10.38 84 200 1.059 5.096
Richard Spencer 208 119 120 11.5 8.90 72 163 -0.346 1.791
Nick Fuentes 209 117 118 14.6 10.38 70 170 -0.190 1.568
your mom 272 118 118 16.3 13.34 79 200 1.335 5.929
Joe Biden 321 113 115 11.5 8.90 70 145 -0.672 1.116
Varg Vikernes 124 117 115 17.6 14.83 74 200 1.461 6.504
Andrew Tate 253 112 111 13.7 13.34 75 150 0.028 0.268
Kanye West 306 107 108 13.9 13.34 70 148 0.111 -0.061 
#overall mean
describe2(d_long$value, d_long$name) %>% pull(median) %>% describe2()
## New names:
## • `` -> `...1`
#main plot
d_long %>% 
  GG_group_means("value", "name", type = "violin", split_group_labels = F) +
  coord_flip() +
  scale_y_continuous(breaks = seq(0, 200, 10))

GG_save("figs/IQ estimates for public figures.png")

#example of bad data
(GG_denhist(d_orig$IQ_of_Aella) + ggtitle("Aella") + scale_x_continuous("IQ estimate")) +
  (GG_denhist(d_orig$IQ_of_Emil_Kirkegaard) + ggtitle("Emil Kirkegaard") + scale_x_continuous("IQ estimate")) +
  (GG_denhist(d_orig$IQ_of_Scott_Alexander) + ggtitle("Scott Alexander") + scale_x_continuous("IQ estimate")) +
  (GG_denhist(d_orig$IQ_of_Richard_Hanania) + ggtitle("Richard Hanania") + scale_x_continuous("IQ estimate"))
## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## ℹ The deprecated feature was likely used in the kirkegaard package.
##   Please report the issue to the authors.
## Warning: Removed 297 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 297 rows containing non-finite values (`stat_density()`).
## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
## Warning: Removed 228 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 228 rows containing non-finite values (`stat_density()`).
## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
## Warning: Removed 285 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 285 rows containing non-finite values (`stat_density()`).
## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
## Warning: Removed 331 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 331 rows containing non-finite values (`stat_density()`).
## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 297 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 297 rows containing non-finite values (`stat_density()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 228 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 228 rows containing non-finite values (`stat_density()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 285 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 285 rows containing non-finite values (`stat_density()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 331 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 331 rows containing non-finite values (`stat_density()`).

GG_save("figs/IQ public figures troll.png")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 297 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 297 rows containing non-finite values (`stat_density()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 228 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 228 rows containing non-finite values (`stat_density()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 285 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 285 rows containing non-finite values (`stat_density()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 331 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 331 rows containing non-finite values (`stat_density()`).
#rating reliability
d %>% 
  select(!!estimate_vars) %>% 
  map_df(function(x) {
    x[x<70] = NA
    x
  }) %>% 
  as.matrix() %>% 
  t() %>% 
  ICC()
## Call: ICC(x = .)
## 
## Intraclass correlation coefficients 
##                          type  ICC   F df1   df2 p lower bound upper bound
## Single_raters_absolute   ICC1 0.31 260  56 33231 0        0.24         0.4
## Single_random_raters     ICC2 0.31 385  56 32648 0        0.24         0.4
## Single_fixed_raters      ICC3 0.40 385  56 32648 0        0.32         0.5
## Average_raters_absolute ICC1k 1.00 260  56 33231 0        0.99         1.0
## Average_random_raters   ICC2k 1.00 385  56 32648 0        0.99         1.0
## Average_fixed_raters    ICC3k 1.00 385  56 32648 0        1.00         1.0
## 
##  Number of subjects = 57     Number of Judges =  584
## See the help file for a discussion of the other 4 McGraw and Wong estimates,
#correlation to others for each person
cors_per_person = map_df(seq_along_rows(d), function(i) {
  #overall median estimates minus that person
  ests = d[-i, ] %>% select(!!estimate_vars) %>% describe2()
  
  tibble(
    subject = i,
    r_median = wtd.cors(ests$median, d[i, estimate_vars] %>% unlist()),
    r_mean = wtd.cors(ests$mean, d[i, estimate_vars] %>% unlist())
  )
})

describe2(cors_per_person$r_median)
describe2(cors_per_person$r_mean %>% {.[is.finite(.)]})
#plot distribution of rater agreement
GG_denhist(cors_per_person, "r_median") +
  scale_x_continuous("Correlation of rater with median estimate of other raters")
## Warning: Removed 201 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 201 rows containing non-finite values (`stat_density()`).
## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 201 rows containing non-finite values (`stat_bin()`).
## Removed 201 rows containing non-finite values (`stat_density()`).

GG_save("figs/median agreement.png")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 201 rows containing non-finite values (`stat_bin()`).
## Removed 201 rows containing non-finite values (`stat_density()`).