Table of Contents

Introduction

This is an analysis of the survery by Slate Star Codex. There were 7298 people who took the survey and agreed to have their results shared, and 236 questions.

Read and process data library(pacman) p_load(tidyverse, magrittr, pander, janitor, scales, broom, feather, ggpubr, ggwordcloud) source('../../src/extra.R', echo = F, encoding="utf-8") df <- read_csv("files/2020ssc_publica.csv") %>% clean_names() %>% rename(sat_verbal = sa_tscoreverbalreading, sat_math = sa_tscoremath) %>% # Drop duplicates distinct(.keep_all = T) %>% # Filter an individual who gives crazy answers filter(biological_older_sibling_age_gap < 1000 | is.na(biological_older_sibling_age_gap)) %>% # remove outliers mutate( age = replace(age, age > 120, NA), tabs = replace(tabs, tabs > 1000, NA), children = replace(children, children > 20, NA), sat_verbal = ifelse(between(sat_verbal, 200, 800), sat_verbal, NA), osri_femininity = ifelse(between(osri_femininity, 20, 200), osri_femininity, NA), osri_masculinity = ifelse(between(osri_masculinity, 20, 200), osri_masculinity, NA), police_killings1 = ifelse(between(police_killings1, 0, 1000000), police_killings1, NA), police_killings2 = ifelse(between(police_killings2, 0, 1000000), police_killings2, NA), police_killings3 = ifelse(between(police_killings3, 0, 1000000), police_killings3, NA), sat_math = ifelse(between(sat_math, 200, 800), sat_math, NA), income = ifelse(between(income, 0, 1000000), income, NA), charity = replace(charity, charity > 500000, NA), inbox = ifelse(inbox == 0, "0", ">0"), # Fix countries, create region variable country = stringr::str_to_title(country), country = ifelse(country %in% c("Nederland", "Nederlands", "The Netherlands"), "Netherlands", country), country = ifelse(country == "Brasil", "Brazil", country), country = ifelse(country == "Czechia", "Czech Republic", country), region = case_when( country == "United States" ~ "US", country %in% c("Australia", "Austria", "Belgium", "Canada", "Czech Republic", "Denmark", "Finland", "France", "Germany", "Greece", "Hungary", "Ireland", "Italy", "Netherlands", "New Zealand", "Norway", "Poland", "Portugal", "Romania", "Slovakia", "Slovenia", "Spain", "Sweden", "Switzerland", "United Kingdom") ~ "The west", T ~ "Other"), # Fix IQ iq = case_when( iq == "~160 (parental ego drove 4 professionally administered tests between ages 5-10 to 'verify')" ~ "160", iq == "?135" ~ "135", iq == ">130? i think that was required for placement in 'gifted' program. but i'm way dumber than i used to be." ~ "130", iq == ">135 (the test only checks up to 135" ~ "135", iq == "10th percentile (bottom 10%)" ~ "80", iq == "120 when I was a kid, none since then" ~ "120", iq == "121, corrected for FE" ~ "121", iq == "130s" ~ "135", iq == "120ish" ~ "120", iq == "135+ (highest possible value on mensa admissions test)" ~ "138", iq == "135+ (Official Mensa membership test measuring only up to 135)" ~ "138", iq == "135+ (was max score)" ~ "138", iq == "138 - long time back" ~ "138", iq == "140 (I was like 9 or 10 when I took it though)" ~ "140", iq == "142 (really old #)" ~ "142", iq == "\"top 90th percentile\"" ~ "120", iq == "135+" ~ "138", iq == "145 (Wechsler, as a child)" ~ "145", iq == "145+ (test had 3sd ceiling)" ~ "148", iq == "150 (according to a childhood test that I no longer remember taking)" ~ "150", iq == "150 when I was like 4 years old" ~ "150", iq == "160, but I took this when I was ~4 years old" ~ "160", iq == "165 (Stanford-Binet as an 8 year old...)" ~ "165", iq == "WAIS-IV 120" ~ "120", iq == "!Accepted into Mensa" ~ "135", iq == "Was given an official score of >140 in UK 11 plus - only formal IQ test ever taken" ~ "140", T ~ iq), iq = as.numeric(iq), iq = ifelse(between(iq, 50, 250), iq, NA), # Fix children_autism_severity children_autism_severity = case_when( startsWith(children_autism_severity, "Moderately") ~ "Moderately", startsWith(children_autism_severity, "Not severely") ~ "Not severely", startsWith(children_autism_severity, "Severely") ~ "Severely") ) %>% # delete some columns select(-c(public, country, life_effects2, police_violence2, other_identity, other_self_help, cfar_year, seasonal0b, paranormal_explanation, mystical_explanation, explanation, religious_denomination, religious_background, life_effects, other_visual_artifacts, lying))

Police killings

The numbers for people shot by the police can be found here. They are 933 total and 10 unarmed black men. The number of police men shot in the line of duty can be found here, and is 47 for last year.

Plot of the guesses for the police killings. The correct value is indicated by the blue line, so the majority made good guesses here. The red lines indicate a guess that’s off by a factor 20.

df %<>% mutate( police_killings1_guess = case_when( police_killings1 < 933 / 20 ~ "badLow", police_killings1 > 933 * 20 ~ "badHigh", T ~ "Medium")) df %>% ggplot(aes(x = police_killings1)) + jpal_hist(bins = 50) + scale_x_log10(labels = comma) + geom_vline(xintercept = 933, color = "blue") + geom_vline(xintercept = 20 * 933, color = "red") + geom_vline(xintercept = 933 / 20, color = "red") + labs(x = "Guess of police killings, total")

Plot of the guesses for the police killings of unarmed black people. A large number of people made way too high guesses here.

df %<>% mutate( police_killings2_guess = case_when( police_killings2 > 10*20 ~ "badHigh", T ~ "Medium")) df %>% ggplot(aes(x = police_killings2)) + jpal_hist(bins = 50) + scale_x_log10(labels = comma) + geom_vline(xintercept = 10, color = "blue") + geom_vline(xintercept = 10 * 20, color = "red") + labs(x = "Guess of police killings, unarmed black men")

Plot of the guesses for police officers shot and killed.

df %<>% mutate( police_killings3_guess = case_when( police_killings3 < 47 / 20 ~ "badLow", police_killings3 > 47 * 20 ~ "badHigh", T ~ "Medium")) df %>% ggplot(aes(x = police_killings3)) + jpal_hist(bins = 50) + scale_x_log10(labels = comma) + geom_vline(xintercept = 47, color = "blue") + geom_vline(xintercept = 47 * 20, color = "red") + geom_vline(xintercept = 47 / 20, color = "red") + labs(x = "Guess of police shot and killed")

The graph below shows the proportion of total police killings that are of unarmed black men

df %<>% mutate( police_killings_ratio = police_killings2 / police_killings1, police_ratio_guess = case_when( police_killings_ratio < 10 / (933*20) ~ "badLow", police_killings_ratio > 10*20 / 933 ~ "badHigh", T ~ "Medium") ) df %>% ggplot(aes(x = police_killings_ratio)) + jpal_hist(binwidth = 0.1) + scale_x_log10(labels = comma) + geom_vline(xintercept = 10 / 933, color = "blue") + geom_vline(xintercept = 10*20 / 933, color = "red") + geom_vline(xintercept = 10 / (933*20), color = "red")

Notice the spike at the correct ratio. It’s likely that these guesses either already knew the numbers, or cheated and looked them up. Also very noticeable how many people think that almost every person killed by the police is an unarmed black person.

IQ and SAT score

The blue lines indicate the mean, top 10% and top 1%.

df %<>% mutate(sat = sat_math + sat_verbal) df %>% ggplot(aes(x = sat)) + jpal_hist(binwidth = 10) + geom_vline(xintercept = 1050, color = "blue") + geom_vline(xintercept = 1350, color = "blue") + geom_vline(xintercept = 1550, color = "blue")

df %>% ggplot(aes(x = iq)) + jpal_hist(binwidth = 1) + geom_vline(xintercept = 100, color = "blue") + geom_vline(xintercept = 119, color = "blue") + geom_vline(xintercept = 135, color = "blue")

6 people have an alleged IQ of 150+, but think that as many or more unarmed black people are killed by the police, as the total number of people killed by the police.

df %>% filter(police_killings_ratio >= 1, iq >= 150) %>% nrow() 6

I found the support for political candidates among the general population here.

get_top <- function(df, g){ df %>% group_by(!!sym(g)) %>% summarise(n = n()) %>% filter(n > 20) %>% pull(!!sym(g)) } top_noms <- get_top(df, "democratic_nominee") df %<>% mutate(democratic_nominee = ifelse(democratic_nominee %in% top_noms, democratic_nominee, NA)) tribble(~democratic_nominee, ~percent, "Amy Klobuchar", 0.02, "Andrew Yang", 0.04, "Bernie Sanders", 0.22, "Cory Booker", 0.03, "Elizabeth Warren", 0.16, "Joe Biden", 0.3, "Mike Bloomberg", 0.06, "Pete Buttigieg", 0.09, "Tulsi Gabbard", 0.02) %>% mutate(group = "normal people", p2 = c(2,4,8,4,7,9,3,6,1)) %>% bind_rows( df %>% tabyl(democratic_nominee) %>% as_tibble() %>% drop_na() %>% mutate(group = "SSC", p2 = c(2,4,8,4,7,9,3,6,1)) ) %>% ggplot(aes(x = reorder(democratic_nominee, p2), y = percent, fill = group)) + geom_bar(position = "dodge", stat = "identity", width = 0.8) + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + labs(y = "proportion", x = "democratic nominee")

OSRI masculinity / femininity

The F and M indicate the mean values for the two genders.

means <- df %>% group_by(sex) %>% drop_na(osri_masculinity, osri_femininity, sex) %>% filter(sex != "Other") %>% summarise(masc = mean(osri_masculinity), fem = mean(osri_femininity)) df %>% select(osri_femininity, osri_masculinity, sex) %>% drop_na() %>% filter(sex != "Other", osri_femininity > 60, osri_masculinity < 140) %>% ggplot(aes(x = osri_femininity, y = osri_masculinity, color = sex)) + geom_count(alpha = 0.4) + geom_abline(slope = 1, intercept = c(0,0), linetype = "dashed") + geom_text(label = "M", y = means %>% get("Male", "masc"), x = means %>% get("Male", "fem"), size = 8, color = "black") + geom_text(label = "F", y = means %>% get("Female", "masc"), x = means %>% get("Female", "fem"), size = 8, color = "black")

Related traits

(Note: The shown values are not strictly correlations, but estimates from regression of two scaled variables.)

find_correlations dff <- cbind( df %>% select_if(is.numeric) %>% mutate_all(stdize), df %>% select_if(negate(is.numeric)) %>% dummy::dummy() ) dff2 <- cbind( df %>% select_if(is.numeric), df %>% select_if(negate(is.numeric)) %>% dummy::dummy() %>% mutate_all(as.numeric) ) find_all_cor <- function() { get_glm <- function(v1, v2){ tryCatch({ if (nrow(unique(dff[v1])) <= 3){ m <- glm(as.formula(glue("{v1} ~ {v2}")), data = dff, family = "binomial")} else { m <- glm(as.formula(glue("{v1} ~ {v2}")), data = dff)} m %>% tidy() %>% filter(term != "(Intercept)") %>% mutate(term1 = v1) %>% select(term1, term2 = term, estimate, p.value)}, error = function(e) NULL) } r <- crossing(v1 = names(dff), v2 = names(dff)) %>% filter(v1 > v2) %>% pmap_df(get_glm) %>% arrange(desc(abs(estimate))) write_feather(r, "files/cor.f") } r <- read_feather("files/cor.f")

Police killings guesses

Traits related to making an extreme overestimate about police killings of unarmed black people. Red means strong negative relationship.

edit_names <- function(df){ df %>% mutate(term = case_when( term == "adhd_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family1" ~ "No ADHD", term == "drugaddiction_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family1" ~ "No drug addiction", term == "anxiety_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family1" ~ "No anxiety", term == "class_current_Upper.middle.class1" ~ "Upper middle class", term == "lengthof_time_More.than.two.years1" ~ "Read SSC more than 2 years", term == "democratic_nominee_Amy.Klobuchar1" ~ "Amy Klobuchar", term == "didyoureadtherulesaboveandunderstandthem_Yes1" ~ "Read and understood rules", term == "face_mask_A.Einstein.mask.facing.towards.the.viewer..as.if.you.were.looking.at.the.person.wearing.it1" ~ "face mask facing towards", term == "borderline_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family1" ~ "No borderline", term == "depression_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family1" ~ "No depression", term == "meetup_Yes..I.attended.one.meetup1" ~ "Attended one meetup", term == "didyoureadtherulesaboveandunderstandthem_No..do.not.count.my.responses.below..skip.to.Part.20.1" ~ "Did not read and understand rules", term == "democratic_nominee_Bernie.Sanders1" ~ "Bernie Sanders", term == "face_mask_I.can.see.it.as.either.of.these.two..or.it.seems.to.switch.back.and.forth1" ~ "Can see face mask either way", term == "esp_I.had.an.unclear.experience.that.seems.like.it.might.belong.in.this.category1" ~ "Had an unclear ESP experience", term == "class_current_Working.to.lower.middle.class1" ~ "Lower middle class", term == "adhd_I.think.I.might.have.this.condition..although.I.have.never.been.formally.diagnosed1" ~ "Might have ADHD", term == "meetup_No..I.don.t.know.of.any..or.can.t.make.it.to.any1" ~ "No meetups", term == "depression_I.think.I.might.have.this.condition..although.I.have.never.been.formally.diagnosed1" ~ "Might have depression", term == "other_paranormal_Yes1" ~ "Have had other paranormal experience", term == "occultism2_I.had.an.unclear.experience.that.seems.like.it.might.belong.in.this.category1" ~ "Unclear occultism experience", term == "american_parties_Democratic.Party1" ~ "Democratic party", term == "anxiety_I.think.I.might.have.this.condition..although.I.have.never.been.formally.diagnosed1" ~ "Might have anxiety", term == "democratic_nominee_Elizabeth.Warren1" ~ "Elizabeth Warren", term == "depression_I.have.a.formal.diagnosis.of.this.condition1" ~ "Depression", term == "seasonal0a_I.live.in.a.tropical.area.that.doesn.t.have.a.distinct.winter..eg.Central.America..India." ~ "Live in tropical area", term == "democratic_nominee_Tulsi.Gabbard1" ~ "Tulsi Gabbard", term == "gender_M..transgender.f....m.1" ~ "Male transgender", term == "gender_F..transgender.m....f.1" ~ "Female transgender", term == "medication_Yes..z.drug..Ambien..Lunesta..Sonata." ~ "Ambien", term == "vegetarian_No..but.I.try.to.eat.less.meat...offset.the.meat.I.eat..for.moral.reasons" ~ "Try to eat less meat", term == "income_status_Retiredncome_status_Retired.or.otherwise.post.significant.money.making1" ~ "Retired", term == "political_affiliation_Alt.right..for.example.France.s.National.Front..nationalist.revival.with.an.ethnic.racial.component1" ~ "Alt-right", term == "alcoholism_I.think.I.might.have.this.condition..although.I.have.never.been.formally.diagnosed1" ~ "Might have alcoholism", term == "american_parties_Republican.Party1" ~ "Republican Party", term == "alcoholism_I.have.family.members..within.two.generations..with.this.condition1" ~ "Have family members with alcoholism", term == "income_status_Student...intern...otherwise.pre.significant.money.making1" ~ "Student / intern", term == "police_killings3_guess_badHigh1" ~ "Bad guess for number of police killed", term == "napping3_Sleep.for.as.long.as.I.would.sleep.at.night..six.hours.or.more..feeling.better1" ~ "Very long naps", term == "lengthof_time_Less.than.a.month1" ~ "read SSC for less than a month", term == "alcoholism_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family" ~ "No alcoholism", term == "eatingdisorder_I.have.family.members..within.two.generations..with.this.condition1" ~ "Family members with eating disorder", term == "energy_work_Yes1" ~ "Energy work (chakra etc)", term == "coffee_sleepy_Never.taken.it...don.t.know...other1" ~ "Never tried coffee for sleepiness", term == "face_mask_A.Einstein.mask.facing.towards.the.viewer..as.if.you.were.looking.at.the.person.wearing.it1" ~ "Face mask facing viewer", term == "alcoholism_I.don.t.have.this.condition.and.neither.does.anyone.in.my.family1" ~ "No alcoholism", term == "police_traffic_Yes..and.I.feel.it.was.unreasonable.of.them.to.pull.me.over1" ~ "Have been pulled over by traffic police, and felt it was unreasonable", term == "blood_Yes1" ~ "Blood donor", T ~ term)) } make_wordcloud <- function(df){ df %>% edit_names() %>% mutate(direction = ifelse(estimate < 0, "a", "b")) %>% ggplot(aes(label = term, size = abs(estimate), color = direction)) + geom_text_wordcloud(area_corr_power = 1.4, rm_outside = T, grid_size = 25) + scale_radius(range = c(0, 8), limits = c(0, NA)) + theme_minimal() } r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "police_killings2_guess_badHigh" | term2 == "police_killings2_guess_badHigh") %>% filter(!startsWith(term2, "police")) %>% head(15) %>% select(term = term2, estimate, p = p.value) %>% filter(term != "other_paranormal_No1", term != "esp_No1", term != "didyoureadtherulesaboveandunderstandthem_No..do.not.count.my.responses.below..skip.to.Part.20.1") %>% make_wordcloud()

Or an extreme overestimate of the proportion of unarmed black people killed out of all police killings

r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "police_ratio_guess_badHigh" | term2 == "police_ratio_guess_badHigh") %>% filter(!startsWith(term2, "police")) %>% head(15) %>% select(term = term2, estimate, p = p.value) %>% filter(term != "didyoureadtherulesaboveandunderstandthem_No..do.not.count.my.responses.below..skip.to.Part.20.1", term != "gender_F..cisgender.1") %>% make_wordcloud()

Correlations with making a decent estimate of the number of black people killed by police each year

r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "police_killings2_guess_Medium" | term2 == "police_killings2_guess_medium") %>% filter(!startsWith(term2, "police")) %>% head(15) %>% select(term = term2, estimate, p = p.value) %>% filter(term != "didyoureadtherulesaboveandunderstandthem_No..do.not.count.my.responses.below..skip.to.Part.20.1", term != "other_paranormal_No1") %>% make_wordcloud()

Human biodiversity

Human biodiversity has been a very in-focus and contentious issue for the SSC community. Let’s look at the strongest associations (other than political).

r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "human_biodiversity" | term2 == "human_biodiversity") %>% #filter(!startsWith(term1, "political"), !startsWith(term2, "democratic"), !startsWith(term2, "american_parties")) %>% mutate(term = ifelse(term1 == "human_biodiversity", term2, term1)) %>% select(term, estimate) %>% filter(!startsWith(term, "political"), !startsWith(term, "democratic"), !startsWith(term, "american_parties"), term != "gender_M..cisgender.1", term != "gender_F..cisgender.1", term != "sex_Female") %>% head(20) %>% make_wordcloud()

Democratic candidates supported by HBDers

ggplot(df %>% drop_na(human_biodiversity, democratic_nominee), aes(y = human_biodiversity, x = democratic_nominee)) + geom_jitter(alpha = 0.3) + theme(axis.text.x = element_text(angle = 45, hjust = 1))

Lets also see the correlations of the two largest races

white r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "race_White..non.Hispanic." | term2 == "race_White..non.Hispanic.k" ) %>% head(15) %>% select(term = term2, estimate) %>% make_wordcloud()

east asian r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "race_Asian..East.Asian." | term2 == "race_Asian..East.Asian." ) %>% select(term = term2, estimate, p = p.value) %>% filter(term != "gender_F..cisgender.1", term != "drugaddiction_I.have.family.members..within.two.generations..with.this.condition1", term != "alcoholism_I.have.family.members..within.two.generations..with.this.condition1", term != "police_crime_Yes..and.I.feel.it.was.reasonable.of.them.to.be.concerned.but.in.the.end.I.was.innocent1", term != "household_Yes..I.remained.with.my.birth.family.during.this.time..and.consider.them.my..household.1", term != "ashkenazi_parents", term != "bio_children5", term != "police_crime_Yes..but.I.feel.it.was.unreasonable.of.them.to.approach.me1", term != "police_traffic_Yes..and.I.feel.it.was.unreasonable.of.them.to.pull.me.over1", term != "police_traffic_Yes..and.I.feel.it.was.reasonable.of.them.to.be.concerned.but.in.the.end.I.was.innocent1") %>% head(14) %>% make_wordcloud()

Prize games

Game question 2 was:

Choose either “cooperate” or “defect”. I will randomly select two people to play the game. If they both cooperate, they will both get $500. If one person cooperates and the other defects, the defector will get $1000. If they both defect, they will both get $100.

I don’t personaly see why one would cooperate here. There is an argument that it increases the overall prize pool. But is it better for me if some SSC user has the money, than if Scott Alexander has the money? Unclear why it would be. Nonetheless, most people cooperated.

df %>% tabyl(game_ii_prisoneraposs_dilemma) %>% as_tibble() game_ii_prisoneraposs_dilemma n percent valid_percent Cooperate 4927 0.675 0.722 Defect 1896 0.26 0.278 - 474 0.065 -

Also puzzling is that most of the people who defected in game 2, nonetheless cooperated when in the same situation but against their clone! My guess would be to then think that its more likely that my clone is a defecting type. But instead most of them changed their mind and now cooperated instead.

Game 3 choice for defectors in game 2 df %>% filter(game_ii_prisoneraposs_dilemma == "Defect") %>% tabyl(game_iii_prisoneraposs_dilemma_against_your_clone) %>% as_tibble() game_iii_prisoneraposs_dilemma_against_your_clone n percent valid_percent Cooperate 1033 0.545 0.546 Defect 859 0.453 0.454 - 4 0.00211 -

Top traits that people who are cooperative in this game tend to have:

r %>% filter(p.value < 0.01) %>% arrange(desc(abs(estimate))) %>% filter(term1 == "game_ii_prisoneraposs_dilemma_Cooperate" | term2 == "game_ii_prisoneraposs_dilemma_Cooperate") %>% filter(!startsWith(term2, "game_i_"), !startsWith(term2, "energy_work2"), !startsWith(term2, "democratic_")) %>% head(20) %>% select(term = term2, estimate, p = p.value) %>% mutate(term = ifelse(term == "blood_Yes1", "donate_blood_Yes", term)) %>% make_wordcloud()

Presidential candidates, degree of defecting.