Background

This is a preregistered nationally representative study. See preregistration.

This is joint work with Prof. Sandra Matz, led by me as the Principal Investigator.

Description

In Study 1, we asked participants to write in which values they believe guide the U.S. on paper and which values they believe guide the U.S. in practice. We then K-means clustered the embeddings of the values they wrote as the ones that guide the U.S. on paper. This helped us identify the overarching values that are seen by Americans as representing what is promised by the state in the American social contract: (1) Democracy; (2) Equality; (3) Freedom; (4) Individualism; (5) Justice; (6) Pursuit of Happiness; (7) Right to Bear Arms; and (8) Tolerance.

The purpose of Study 2 is two-fold: (1) replicate the effects of a broken social contract on political discontent, as observed in Study 1; (2) identify the overarching values that drive this effect. In other words, Study 2 helps us uncover which values are perceived to be under-delivered by the state, which ones are the most important predictors of political discontent, and whether some people care more about some values and others care about other values.

Hypotheses

The perceived extent to which the promise of the US on paper is broken is positively associated with support for radical change.
The perceived extent to which the promise of the US on paper is broken is positively associated with anti-establishment sentiment.
The perceived extent to which the promise of the US on paper is broken is negatively associated with trust in democratic institutions (executive, legislative, and judicial branch).
The perceived extent to which the promise of the US on paper is broken is negatively associated with trust in mainstream societal institutions (media, education, police, military, finance, medicine).

Study design

The study consists of two major parts:

1. Social contract: Participants saw eight overarching values that guide the US on paper. They were asked to indicate their perception of priorities of the US on paper as they relate to these values. Then, they indicated the extent to which they believed the US lives up to each of these values. Then, they indicated their own preferred prioritization of these values, if they were to design a brand new state.
2. Attitudes and individual differences: Participants completed measures of anti-establishment sentiment, trust in institutions, social dominance orientation, personality, support for radical change, and political identification/behavior.

Computational analytic strategy

The broken promise score is a weighted mean of the “values delivered” score, weighted by the perceived priorities of the U.S., as indicated by the participant.

To get to this weighted mean, each score assigned to the values delivered by the US government was be weighted by the participant-assigned priorities indicated in the “priorities of the US on paper” measure. That is, we multiplied the score (0-100) of each value by the weight of the value and took the sum of all weighted value scores.

For example, if a participant indicated that the government largely delivers on the value of “democracy” by assigning 90 points, and indicated that the the value of “democracy” counts for 20% of the US’s priorities on paper, then this value would be weighted 90*0.2. The same logic is applied to all the other values. Then, the sum of those scores was counted as the weighted mean of the US delivering on its prioritized promise.

Then, we reverse-scored that sum by subtracting it from 100 so that higher scores indicate a more broken promise.

Data collection

We collected data on 5/31/2024-6/1/2024 through Connect by CloudResearch; an online participant recruitment platform. The sample was intended to be representative of the U.S. population in May 2024 along the lines of gender (~50.4% women ~49.6% men), race (~58.9% non-Hispanic White, ~18.2% Hispanic or Latino, ~13.6% Black, ~6.3% Asian, and ~3% more than one race or other), age (~20.1% 18-29 years, ~25.9% 30-44 years, ~23.3% 45-59 years, and ~30.7% 60-99 years), and political party affiliation (41% Independents, 30% Republicans, and 28% Democrats). The target sample was set at 1,000 participants.

We excluded participants who failed a simple attention check, embedded in the anti-establishment scale. Let’s see how many eligible participants we end up with:

eligible_N <- df_bsc %>% 
  group_by(is_elg) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  filter(is_elg == 1) %>% 
  select(N) %>% 
  unname() %>% 
  unlist()

df_bsc %>% 
  group_by(is_elg) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

is_elg	N	Perc
0	15	1.49
1	994	98.51

Great. That leaves us with 994 eligible participants.

Demographics

Race and ethnicity

df_bsc_elg %>% 
  group_by(race,hispanic) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

## `summarise()` has grouped output by 'race'. You can override using the
## `.groups` argument.

race	hispanic	N	Perc
White	0	588	59.15
Black or African American	0	152	15.29
NA	1	91	9.15
White	1	54	5.43
Asian	0	49	4.93
multiracial	0	43	4.33
Black or African American	1	6	0.60
Other (please specify)	0	4	0.40
multiracial	1	4	0.40
American Indian or Alaska Native	0	1	0.10
Middle Eastern or North African	0	1	0.10
Native Hawaiian or Other Pacific Islander	0	1	0.10

Gender

df_bsc_elg %>% 
  mutate(gender = ifelse(is.na(gender) | gender == "","other",gender)) %>% 
  group_by(gender) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

gender	N	Perc
woman	530	53.32
man	457	45.98
other	7	0.70

Age

df_bsc_elg %>% 
  summarise(age_mean = round(mean(age,na.rm = T),2),
            age_sd = round(sd(age,na.rm = T),2)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

age_mean	age_sd
40.47	14.31

Education

df_bsc_elg %>% 
  group_by(edu) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

edu	N	Perc
noHS	3	0.30
GED	343	34.51
2yearColl	145	14.59
4yearColl	354	35.61
MA	107	10.76
PHD	34	3.42
NA	8	0.80

Income

df_bsc_elg %>% 
  ggplot(aes(x = income)) +
  geom_bar() +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_blank(),
        axis.title.y = element_blank()) +
  coord_flip()

County inequallity

County GINI coefficient was taken from the US Census Website.

df_bsc_elg %>% 
  filter(!is.na(county_gini)) %>% 
  ggplot(aes(x = county_gini)) +
  geom_histogram(fill = "lightblue",
                 binwidth = 0.005) +
  #scale_x_continuous(breaks = seq(0,1,0.1)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_bsc_elg$county_gini,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

County median income

County median income was taken from the US Census Website.

df_bsc_elg %>% 
  filter(!is.na(county_medianincome)) %>% 
  ggplot(aes(x = county_medianincome)) +
  geom_histogram(fill = "lightblue",
                 binwidth = 5000) +
  #scale_x_continuous(breaks = seq(0,1,0.1)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_bsc_elg$county_medianincome,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

County density

County density was taken from the US Census Website.

df_bsc_elg %>% 
  filter(!is.na(county_density)) %>% 
  ggplot(aes(x = county_density)) +
  geom_histogram(fill = "lightblue",
                 binwidth = 500) +
  #scale_x_continuous(breaks = seq(0,1,0.1)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_bsc_elg$county_density,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Politics

Ideology

Participants were asked about the extent to which they subscribe to the following ideologies on a scale of 1-7 (select NA if unfamiliar): Conservatism, Liberalism, Democratic Socialism, Libertarianism, Progressivism.

means <- df_bsc_elg %>%
  dplyr::select(PID,ideo_con:ideo_prog) %>% 
  pivot_longer(-PID,
               names_to = "ideo",
               values_to = "score") %>% 
  filter(!is.na(score)) %>% 
  group_by(ideo) %>% 
  summarise(score = mean(score)) %>% 
  ungroup()

df_bsc_elg %>%
  dplyr::select(PID,ideo_con:ideo_prog) %>% 
  pivot_longer(-PID,
               names_to = "ideo",
               values_to = "score") %>% 
  filter(!is.na(score)) %>%  
  ggplot() +
  geom_density(aes(x = score), fill = "lightblue") +
  scale_x_continuous(limits = c(1,7),
                     breaks = seq(1,7,1)) +
  geom_vline(data = means,mapping = aes(xintercept = score),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold")) +
  facet_wrap(~ideo,nrow = 2)

Party ID

df_bsc_elg %>% 
  group_by(party_id) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

party_id	N	Perc
Democrat	355	35.71
Independent	333	33.50
Republican	306	30.78

Vote in 2020

df_bsc_elg %>% 
  group_by(vote_2020) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(N)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

vote_2020	N	Perc
Joe Biden	438	44.06
Donald Trump	322	32.39
I did not vote	187	18.81
Third-party candidate	47	4.73

Vote in 2024

df_bsc_elg %>% 
  group_by(vote_2024) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(N)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

vote_2024	N	Perc
Joe Biden	425	42.76
Donald Trump	369	37.12
Robert F. Kennedy Jr.	88	8.85
Other	74	7.44
Jill Stein	23	2.31
Cornel West	13	1.31
NA	2	0.20

Measures

US priorities on paper

Since its independence and onwards, the formation of the United States as a sovereign country was based on a number of values, all of which were inscribed in the constitution. This document, importantly, has evolved since it was first written.

On paper (in the constitution), what are the values that the U.S. stands for? We want you to indicate the United State’s priorities on paper.

To that end, you have a sum of 100 points. Please allocate those points to the following values based on how important you think they are to the U.S. on paper.

The values, presented in alphabetical order, are: Democracy, Equality, Freedom, Individualism, Justice, Pursuit of Happiness, Right to Bear Arms, Tolerance.

So, If you think a certain value is more important to the U.S. on paper than another value, then the first value would get more points than the second. If you think a certain value is not important at all to the U.S. on paper, it would get zero points. The total must add up to 100 points.

df_bsc_long_elg %>% 
  filter(type == "paper") %>% 
  group_by(value) %>% 
  summarise(priority_us = round(mean(weight),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

value	priority_us
arms	10.37
democracy	19.40
equality	13.36
freedom	20.94
happiness	10.01
individualism	8.20
justice	11.88
tolerance	5.85

US delivering on its promise

Now, please indicate the extent to which the U.S. government, regardless of party, is living up to each of these values, in practice.

In the scale below, 0 means that the U.S. is not living up to what this value stands for at all (it cannot get any worse) and 100 means that the U.S. is living up to what this value stands for to a great extent (it cannot get any better).

df_bsc_long_elg %>% 
  filter(type == "paper") %>% 
  group_by(value) %>% 
  summarise(score = round(mean(score,na.rm = T),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

value	score
arms	57.88
democracy	47.83
equality	41.32
freedom	50.59
happiness	41.78
individualism	49.74
justice	39.11
tolerance	39.32

Participants’ ideal

And now, we want you to imagine your ideal country.

Importantly, imagine this ideal country as if you are randomly born into its population. You can end up in any level of its citizenry. So, if you could design a country completely from scratch and write its constitution, what would be its guiding values?

Again, you have a sum of 100 points. Please allocate those points to the following values based on how important they are to you.

The values, presented in alphabetical order, are: Democracy, Equality, Freedom, Individualism, Justice, Pursuit of Happiness, Right to Bear Arms, Tolerance.

So, If a certain value is more important to you than another value, then the first value would get more points than the second. If a certain value is not important at all to you, it would get zero points. Must total 100 points.

df_bsc_long_elg %>% 
  filter(type == "ideal") %>% 
  group_by(value) %>% 
  summarise(priority_ideal = round(mean(weight),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

value	priority_ideal
arms	6.14
democracy	17.34
equality	15.93
freedom	19.56
happiness	11.22
individualism	8.03
justice	14.13
tolerance	7.64

Broken promise

The score was computed from two questions: US priorities on paper and US delivering on its promise.

For every value, we multiplied the weight (priorities of the US on paper) by the score (US delivering on its promise) to created weighted scores - one per value. Then, we summed all the weighted mean scores. Then, we subtracted that sum score from 100 to create the broken social contract score.

df_bsc_elg %>%
  ggplot(aes(x = brokenpromise)) +
  geom_histogram(fill = "lightblue",
                 binwidth = 1) +
  geom_vline(xintercept = mean(df_bsc_elg$brokenpromise,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  scale_x_continuous(limits = c(-1,101),
                     breaks = seq(0,100,20)) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"))

Personal disappointment

The score was computed from two questions: personal priorities and US delivering on its promise.

Same way as the broken promise score.

df_bsc_elg %>%
  ggplot(aes(x = personaldisappoint)) +
  geom_histogram(fill = "lightblue",
                 binwidth = 1) +
  geom_vline(xintercept = mean(df_bsc_elg$personaldisappoint,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  scale_x_continuous(limits = c(-1,101),
                     breaks = seq(0,100,20)) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"))

Anti-Establishment

The US’s economy is rigged to advantage the rich and powerful
Traditional politicians and parties don’t care about people like me
Experts in this country don’t understand the lives of people like me
Most of the time we can trust people in the government to do what is right [R]
alpha = 0.77

df_bsc_elg %>% 
  ggplot(aes(x = antiest)) +
  geom_density(fill = "lightblue",
                 color = NA) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(1,7)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_bsc_elg$antiest,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Trust in democratic institutions

Please indicate how much you trust or distrust the following institutions (1 = Strongly Distrust to 7 = Strongly Trust)

1. The US Congress / Legislative Branch
2. The US Government / Executive Branch
3. The US Courts / Judicial Branch

alpha = 0.86

df_bsc_elg %>% 
  ggplot(aes(x = trust_deminst)) +
  geom_density(fill = "lightblue",
                 color = NA) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(1,7)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_bsc_elg$trust_deminst,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Trust in national mainstream institutions

Please indicate how much you trust or distrust the following institutions (1 = Strongly Distrust to 7 = Strongly Trust)

1. Mainstream media in the US (e.g., CNN, FOX News, MSNBC, New York Times, Wall-Street Journal, USA Today)
2. The education system in the US
3. Law enforcement / police in the US
4. The US Military
5. Financial institutions in the US (e.g., Wall Street, The Fed, The Big Banks)
6. The medical system in the US

alpha = 0.83

df_bsc_elg %>% 
  ggplot(aes(x = trust_natinst)) +
  geom_density(fill = "lightblue",
                 color = NA) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(1,7)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_bsc_elg$trust_natinst,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Support for radical change

To what extent do you agree with the following statement?

The way this country works needs to be radically changed

df_bsc_elg %>% 
  ggplot(aes(x = change)) +
  geom_density(fill = "lightblue",
                 color = NA) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(1,7)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_bsc_elg$change,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Social Dominance Orientiation

An ideal society requires some groups to be on top and others to be on the bottom
Some groups of people are simply inferior to other groups
No one group should dominate in society [R]
Groups at the bottom are just as deserving as groups at the top [R]
Group equality should not be our primary goal
It is unjust to try to make groups equal
We should do what we can to equalize conditions for different groups [R]
We should work to give all groups an equal chance to succeed [R]

alpha = 0.9

df_bsc_elg %>% 
  ggplot(aes(x = SDO)) +
  geom_density(fill = "lightblue",
                 color = NA) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(1,7)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_bsc_elg$SDO,na.rm = T),
             color = "grey15",
             size = 1,
             linetype = "dashed") +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Personality

I see myself as… (1 = Strongly Disagree to 7 = Strongly Agree)

Extraverted, enthusiastic
Critical, quarrelsome [R]
Dependable, self-disciplined
Anxious, easily upset
Open to new experiences, complex
Reserved, quiet [R]
Sympathetic, warm
Disorganized, careless [R]
Calm, emotionally stable [R]
Conventional, uncreative [R]

Extraversion: Mean score of items 1 and 6
Agreeableness: Mean score of items 2 and 7
Conscientiousness: Mean score of items 3 and 8
Neuroticism: Mean score of items 4 and 9
Openness: Mean score of items 5 and 10

means <- df_bsc_elg %>%
  dplyr::select(PID,TIPI_extra:TIPI_open) %>% 
  pivot_longer(-PID,
               names_to = "trait",
               values_to = "score") %>% 
  filter(!is.na(score)) %>% 
  group_by(trait) %>% 
  summarise(score = mean(score)) %>% 
  ungroup()

df_bsc_elg %>%
  dplyr::select(PID,TIPI_extra:TIPI_open) %>% 
  pivot_longer(-PID,
               names_to = "trait",
               values_to = "score") %>% 
  filter(!is.na(score)) %>%  
  ggplot() +
  geom_density(aes(x = score), fill = "lightblue",color = NA) +
  scale_x_continuous(limits = c(1,7),
                     breaks = seq(1,7,1)) +
  geom_vline(data = means,mapping = aes(xintercept = score),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold")) +
  facet_wrap(~trait,nrow = 2)

Voting intentions

What is the likelihood that you will vote in the 2024 Presidential Elections?

df_bsc_elg %>% 
  ggplot(aes(x = vote_likely)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(1,5,1),
                     limits = c(0,6)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_bsc_elg$vote_likely,na.rm = T),
             color = "grey15",
             size = 1,
             linetype = "dashed") +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Analysis

Correlation matrix

EXPLORE CORRELATIONS ↗

Broken promise score, personal disappointment score, support for radical change, anti-establishment sentiment, trust in democratic institutions, trust in mainstream societal institutions, conservatism, SDO, TIPI extroversion, TIPI agreeableness, TIPI Conscientiousness, TIPI neuroticism, TIPI openness.

df_bsc_elg %>% 
  dplyr::select(brokenpromise:personaldisappoint,change,antiest:trust_natinst,ideo_con,SDO,TIPI_extra:TIPI_open) %>%
  corPlot(upper = TRUE,stars = TRUE,xsrt = 270)

Linear models

Here, I report the preregistered analyses (all variables are z-scored). Feel free to explore different linear models, with original scales, here:

EXPLORE MODELS ↗

DV: Antiestablishment sentiment

Model 1

Outcome: Antiestablishment sentiment
Predictor: Broken promise
Controls: conservatism

m1 <- lm(antiest_z ~ brokenpromise_z + ideo_con_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.34	930	.735
Brokenpromise z	0.33	[0.27, 0.39]	10.65	930	< .001
Ideo con z	-0.10	[-0.16, -0.03]	-3.07	930	.002

Model 2

Outcome: Antiestablishment sentiment
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness

m1 <- lm(antiest_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.31	928	.753
Brokenpromise z	0.32	[0.26, 0.38]	10.33	928	< .001
Ideo con z	-0.04	[-0.11, 0.03]	-1.02	928	.306
SDO z	-0.10	[-0.17, -0.02]	-2.58	928	.010
TIPI agree z	-0.10	[-0.16, -0.04]	-3.14	928	.002

Model 3

Outcome: Antiestablishment sentiment
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age

m1 <- lm(antiest_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.06	[-0.20, 0.07]	-0.92	805	.358
Brokenpromise z	0.34	[0.28, 0.41]	10.27	805	< .001
Ideo con z	-0.04	[-0.12, 0.03]	-1.14	805	.253
SDO z	-0.07	[-0.15, 0.00]	-1.86	805	.064
TIPI agree z	-0.08	[-0.15, -0.02]	-2.41	805	.016
Man	-0.08	[-0.21, 0.05]	-1.24	805	.217
White	0.10	[-0.05, 0.24]	1.29	805	.199
Hispanic	0.15	[-0.09, 0.39]	1.20	805	.229
Income num z	-0.05	[-0.12, 0.01]	-1.62	805	.105
Edu num z	-0.17	[-0.24, -0.10]	-4.81	805	< .001
Age z	-0.01	[-0.07, 0.06]	-0.23	805	.819

Model 4

Outcome: Antiestablishment sentiment
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age, county median income, county GINI coefficient (i.e., county inequality), and county density

m1 <- lm(antiest_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z + county_medianincome_z + county_gini_z + county_density_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.05	[-0.19, 0.09]	-0.75	794	.456
Brokenpromise z	0.34	[0.27, 0.40]	10.18	794	< .001
Ideo con z	-0.05	[-0.12, 0.03]	-1.19	794	.233
SDO z	-0.08	[-0.16, 0.00]	-2.08	794	.038
TIPI agree z	-0.08	[-0.15, -0.01]	-2.33	794	.020
Man	-0.07	[-0.20, 0.06]	-1.06	794	.289
White	0.06	[-0.08, 0.21]	0.83	794	.404
Hispanic	0.18	[-0.06, 0.42]	1.46	794	.146
Income num z	-0.06	[-0.13, 0.01]	-1.67	794	.096
Edu num z	-0.15	[-0.22, -0.08]	-4.31	794	< .001
Age z	-0.01	[-0.08, 0.05]	-0.42	794	.675
County medianincome z	-0.02	[-0.09, 0.04]	-0.65	794	.513
County gini z	-0.14	[-0.22, -0.06]	-3.32	794	< .001
County density z	0.05	[-0.03, 0.13]	1.19	794	.236

DV: Support for radical change

Model 1

Outcome: Support for radical change
Predictor: Broken promise
Controls: conservatism

m1 <- lm(change_z ~ brokenpromise_z + ideo_con_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.08, 0.05]	-0.48	930	.633
Brokenpromise z	0.28	[0.21, 0.34]	8.76	930	< .001
Ideo con z	-0.16	[-0.22, -0.10]	-5.05	930	< .001

Model 2

Outcome: Support for radical change
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness

m1 <- lm(change_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.46	928	.647
Brokenpromise z	0.28	[0.21, 0.34]	8.80	928	< .001
Ideo con z	-0.04	[-0.12, 0.03]	-1.14	928	.256
SDO z	-0.21	[-0.28, -0.13]	-5.54	928	< .001
TIPI agree z	-0.06	[-0.12, 0.01]	-1.73	928	.083

Model 3

Outcome: Support for radical change
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age

m1 <- lm(change_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.21	[0.07, 0.36]	2.99	805	.003
Brokenpromise z	0.30	[0.24, 0.37]	8.91	805	< .001
Ideo con z	-0.03	[-0.11, 0.04]	-0.88	805	.379
SDO z	-0.15	[-0.23, -0.07]	-3.71	805	< .001
TIPI agree z	-0.02	[-0.09, 0.05]	-0.61	805	.539
Man	-0.20	[-0.33, -0.06]	-2.87	805	.004
White	-0.22	[-0.37, -0.07]	-2.85	805	.005
Hispanic	0.07	[-0.18, 0.32]	0.57	805	.571
Income num z	-0.03	[-0.10, 0.04]	-0.87	805	.384
Edu num z	-0.05	[-0.12, 0.02]	-1.38	805	.168
Age z	-0.17	[-0.24, -0.10]	-4.87	805	< .001

Model 4

Outcome: Support for radical change
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age, county median income, county GINI coefficient (i.e., county inequality), and county density

m1 <- lm(change_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z + county_medianincome_z + county_gini_z + county_density_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.22	[0.08, 0.37]	3.07	794	.002
Brokenpromise z	0.30	[0.24, 0.37]	8.84	794	< .001
Ideo con z	-0.03	[-0.11, 0.04]	-0.87	794	.382
SDO z	-0.15	[-0.23, -0.07]	-3.68	794	< .001
TIPI agree z	-0.02	[-0.09, 0.05]	-0.69	794	.493
Man	-0.19	[-0.33, -0.06]	-2.83	794	.005
White	-0.24	[-0.39, -0.08]	-3.04	794	.002
Hispanic	0.08	[-0.17, 0.33]	0.65	794	.518
Income num z	-0.03	[-0.11, 0.04]	-0.95	794	.340
Edu num z	-0.05	[-0.12, 0.02]	-1.32	794	.187
Age z	-0.17	[-0.24, -0.10]	-4.83	794	< .001
County medianincome z	0.01	[-0.06, 0.08]	0.18	794	.853
County gini z	-0.03	[-0.11, 0.05]	-0.74	794	.461
County density z	0.01	[-0.07, 0.09]	0.21	794	.838

DV: Trust in democratic political institutions

Model 1

Outcome: Trust in democratic political institutions
Predictor: Broken promise
Controls: conservatism

m1 <- lm(trust_deminst_z ~ brokenpromise_z + ideo_con_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.38	930	.700
Brokenpromise z	-0.41	[-0.47, -0.35]	-13.54	930	< .001
Ideo con z	0.05	[0.00, 0.11]	1.83	930	.067

Model 2

Outcome: Trust in democratic political institutions
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness

m1 <- lm(trust_deminst_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.41	928	.683
Brokenpromise z	-0.39	[-0.45, -0.33]	-13.04	928	< .001
Ideo con z	0.06	[-0.01, 0.13]	1.56	928	.119
SDO z	-0.01	[-0.08, 0.06]	-0.32	928	.749
TIPI agree z	0.12	[0.06, 0.18]	3.92	928	< .001

Model 3

m1 <- lm(trust_deminst_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.07	[-0.07, 0.20]	0.96	805	.337
Brokenpromise z	-0.38	[-0.44, -0.32]	-11.83	805	< .001
Ideo con z	0.06	[-0.01, 0.13]	1.59	805	.113
SDO z	-0.02	[-0.09, 0.06]	-0.46	805	.649
TIPI agree z	0.13	[0.07, 0.20]	4.01	805	< .001
Man	0.09	[-0.04, 0.22]	1.40	805	.161
White	-0.14	[-0.28, 0.01]	-1.89	805	.059
Hispanic	-0.11	[-0.34, 0.13]	-0.90	805	.368
Income num z	0.01	[-0.06, 0.07]	0.29	805	.775
Edu num z	0.14	[0.08, 0.21]	4.26	805	< .001
Age z	-0.03	[-0.09, 0.04]	-0.78	805	.434

Model 4

Outcome: Trust in democratic political institutions
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age, county median income, county GINI coefficient (i.e., county inequality), and county density

m1 <- lm(trust_deminst_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z + county_medianincome_z + county_gini_z + county_density_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.05	[-0.08, 0.19]	0.79	794	.428
Brokenpromise z	-0.38	[-0.44, -0.31]	-11.69	794	< .001
Ideo con z	0.06	[-0.01, 0.13]	1.60	794	.109
SDO z	-0.01	[-0.09, 0.06]	-0.31	794	.756
TIPI agree z	0.13	[0.07, 0.20]	3.97	794	< .001
Man	0.08	[-0.05, 0.21]	1.26	794	.207
White	-0.11	[-0.25, 0.03]	-1.51	794	.133
Hispanic	-0.13	[-0.36, 0.11]	-1.07	794	.284
Income num z	0.01	[-0.06, 0.08]	0.28	794	.779
Edu num z	0.13	[0.06, 0.20]	3.76	794	< .001
Age z	-0.01	[-0.08, 0.05]	-0.35	794	.724
County medianincome z	0.02	[-0.04, 0.08]	0.60	794	.551
County gini z	0.08	[0.00, 0.16]	1.95	794	.052
County density z	0.03	[-0.05, 0.10]	0.65	794	.519

DV: Trust in non-political mainstream institutions

Model 1

Outcome: Trust in non-political mainstream institutions
Predictor: Broken promise
Controls: conservatism

m1 <- lm(trust_natinst_z ~ brokenpromise_z + ideo_con_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.37	930	.715
Brokenpromise z	-0.38	[-0.44, -0.32]	-12.50	930	< .001
Ideo con z	0.12	[0.06, 0.18]	3.94	930	< .001

Model 2

Outcome: Trust in non-political mainstream institutions
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness

m1 <- lm(trust_natinst_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.01	[-0.07, 0.05]	-0.41	928	.681
Brokenpromise z	-0.36	[-0.41, -0.30]	-11.89	928	< .001
Ideo con z	0.10	[0.03, 0.17]	2.74	928	.006
SDO z	0.02	[-0.05, 0.09]	0.64	928	.521
TIPI agree z	0.20	[0.14, 0.26]	6.45	928	< .001

Model 3

m1 <- lm(trust_natinst_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.09	[-0.04, 0.22]	1.41	805	.160
Brokenpromise z	-0.37	[-0.43, -0.31]	-11.72	805	< .001
Ideo con z	0.10	[0.03, 0.17]	2.75	805	.006
SDO z	-0.01	[-0.08, 0.07]	-0.16	805	.876
TIPI agree z	0.18	[0.11, 0.24]	5.41	805	< .001
Man	-0.01	[-0.14, 0.11]	-0.22	805	.829
White	-0.08	[-0.22, 0.06]	-1.09	805	.278
Hispanic	-0.24	[-0.47, -0.01]	-2.07	805	.039
Income num z	0.08	[0.01, 0.14]	2.35	805	.019
Edu num z	0.14	[0.08, 0.21]	4.32	805	< .001
Age z	0.07	[0.01, 0.13]	2.15	805	.032

Model 4

Outcome: Trust in non-political mainstream institutions
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age, county median income, county GINI coefficient (i.e., county inequality), and county density

m1 <- lm(trust_natinst_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z + county_medianincome_z + county_gini_z + county_density_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.07	[-0.06, 0.20]	1.04	794	.300
Brokenpromise z	-0.37	[-0.43, -0.30]	-11.53	794	< .001
Ideo con z	0.10	[0.03, 0.17]	2.81	794	.005
SDO z	0.00	[-0.08, 0.07]	-0.13	794	.900
TIPI agree z	0.17	[0.11, 0.24]	5.34	794	< .001
Man	-0.03	[-0.15, 0.10]	-0.43	794	.671
White	-0.03	[-0.17, 0.11]	-0.42	794	.671
Hispanic	-0.26	[-0.49, -0.04]	-2.28	794	.023
Income num z	0.07	[0.01, 0.14]	2.21	794	.028
Edu num z	0.13	[0.06, 0.19]	3.77	794	< .001
Age z	0.09	[0.02, 0.15]	2.65	794	.008
County medianincome z	0.03	[-0.04, 0.09]	0.80	794	.422
County gini z	0.07	[-0.01, 0.14]	1.70	794	.090
County density z	0.07	[-0.01, 0.14]	1.82	794	.070

DV: Turnout for Presidential Election

Model 1

Outcome: Turnout for Presidential Election
Predictor: Broken promise
Controls: conservatism

m1 <- lm(vote_likely_z ~ brokenpromise_z + ideo_con_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.03	[-0.03, 0.09]	0.95	930	.343
Brokenpromise z	0.04	[-0.03, 0.10]	1.16	930	.247
Ideo con z	0.05	[-0.01, 0.11]	1.56	930	.120

Model 2

Outcome: Turnout for Presidential Election
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness

m1 <- lm(vote_likely_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	0.03	[-0.03, 0.09]	0.93	928	.350
Brokenpromise z	0.05	[-0.01, 0.12]	1.61	928	.108
Ideo con z	0.05	[-0.03, 0.12]	1.21	928	.228
SDO z	0.00	[-0.08, 0.07]	-0.07	928	.941
TIPI agree z	0.12	[0.05, 0.18]	3.55	928	< .001

Model 3

Outcome: Turnout for Presidential Election
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age

m1 <- lm(vote_likely_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.08	[-0.23, 0.06]	-1.17	805	.244
Brokenpromise z	0.02	[-0.05, 0.09]	0.50	805	.616
Ideo con z	0.07	[-0.01, 0.15]	1.79	805	.073
SDO z	-0.07	[-0.15, 0.01]	-1.65	805	.100
TIPI agree z	0.09	[0.02, 0.16]	2.63	805	.009
Man	-0.01	[-0.15, 0.12]	-0.17	805	.868
White	0.12	[-0.04, 0.27]	1.51	805	.132
Hispanic	0.24	[-0.01, 0.49]	1.88	805	.060
Income num z	0.09	[0.02, 0.16]	2.56	805	.011
Edu num z	0.11	[0.04, 0.18]	3.06	805	.002
Age z	0.19	[0.12, 0.26]	5.51	805	< .001

Model 4

Outcome: Turnout for Presidential Election
Predictor: Broken promise
Controls: conservatism, social dominance orientation, agreeableness, gender, race, ethnicity, income, education, age, county median income, county GINI coefficient (i.e., county inequality), and county density

m1 <- lm(vote_likely_z ~ brokenpromise_z + ideo_con_z + SDO_z + TIPI_agree_z + man + white + hispanic + income_num_z + edu_num_z + age_z + county_medianincome_z + county_gini_z + county_density_z,data = df_bsc_elg)

apa_lm <- apa_print(m1)
 
kbl(apa_lm$table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value
Intercept	-0.09	[-0.23, 0.06]	-1.19	794	.235
Brokenpromise z	0.02	[-0.05, 0.09]	0.52	794	.603
Ideo con z	0.07	[0.00, 0.15]	1.85	794	.065
SDO z	-0.06	[-0.15, 0.02]	-1.59	794	.113
TIPI agree z	0.09	[0.02, 0.17]	2.63	794	.009
Man	0.00	[-0.14, 0.13]	-0.04	794	.964
White	0.11	[-0.04, 0.27]	1.46	794	.146
Hispanic	0.24	[-0.01, 0.49]	1.85	794	.064
Income num z	0.10	[0.02, 0.17]	2.64	794	.008
Edu num z	0.11	[0.04, 0.19]	3.09	794	.002
Age z	0.19	[0.12, 0.26]	5.35	794	< .001
County medianincome z	-0.02	[-0.09, 0.05]	-0.44	794	.662
County gini z	0.03	[-0.05, 0.12]	0.76	794	.445
County density z	-0.04	[-0.13, 0.04]	-1.06	794	.292

Identifying the driving values

In this study, we can identify the driving values behind our effects. That is, by looking at the unique variance in our outcome measures, explained by each guiding value’s perceived fulfillment, and controlling for the same variables as those in out preregistered models, we can identify which of the eight values are most important for explaining political discontent. Potentially, we could just insert the eight values’ perceived fulfillment (weighted score) into the same model and see what emerges. However, there is a clear problem of multicolinearity. Below, we outline three approaches to handle this problem.

LMG Shapley Decomposition: The LMG (Lindeman–Merenda–Gold) or Shapley decomposition approach partitions the model’s explained variance (\(R^2\)) into non-overlapping components attributable to each predictor. It does this by averaging the incremental contribution of a predictor across all possible orderings in which variables could be entered into the model.
Ridge Regression: Ridge regression introduces an L² penalty term into the ordinary least squares estimation, shrinking regression coefficients toward zero in proportion to their size. By stabilizing the coefficient estimates, ridge regression distributes shared explanatory power across correlated predictors and reduces variance in the estimates.
Lasso Regression: Lasso regression incorporates an \(L^1\) penalty into the estimation, which both shrinks coefficients and sets some of them exactly to zero. This property allows lasso to act as a variable selection procedure, identifying the subset of predictors that most strongly retain predictive utility under penalization.

Below, I show each value’s contribution to each outcome of interest:

Antiestablishment sentiment

df_lmg <- lmg_all %>% 
  filter(outcome == "antiest_z") %>% 
  select(predictor,share_among_values) %>% 
  mutate(share_among_values = round(share_among_values,3)) %>% 
  rename("lmg-share" = share_among_values)

df_ridgepen <- ridge_all %>% 
  filter(outcome == "antiest_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-penalized-coef" = coef)

df_ridgeunpen <- ridge_unpen %>% 
  filter(outcome == "antiest_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-unpenalized-coef" = coef)

df_lassopen <- lasso_all %>% 
  filter(outcome == "antiest_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-penalized-coef" = coef)

df_lassounpen <- lasso_unpen %>% 
  filter(outcome == "antiest_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-unpenalized-coef" = coef)

df_lmg %>% 
  left_join(df_ridgepen,by = "predictor") %>% 
  left_join(df_ridgeunpen,by = "predictor") %>% 
  left_join(df_lassopen,by = "predictor") %>% 
  left_join(df_lassounpen,by = "predictor") %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

predictor	lmg-share	ridge-penalized-coef	ridge-unpenalized-coef	lasso-penalized-coef	lasso-unpenalized-coef
justice	0.302	-0.173	-0.171	-0.196	-0.183
democracy	0.260	-0.162	-0.163	-0.175	-0.176
tolerance	0.148	-0.125	-0.130	-0.127	-0.139
freedom	0.106	-0.083	-0.085	-0.076	-0.085
happiness	0.085	-0.079	-0.078	-0.072	-0.077
equality	0.077	-0.052	-0.047	-0.037	-0.039
arms	0.020	0.039	0.037	0.026	0.034
individualism	0.002	0.016	0.017	0.000	0.013

Support for radical change

df_lmg <- lmg_all %>% 
  filter(outcome == "change_z") %>% 
  select(predictor,share_among_values) %>% 
  mutate(share_among_values = round(share_among_values,3)) %>% 
  rename("lmg-share" = share_among_values)

df_ridgepen <- ridge_all %>% 
  filter(outcome == "change_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-penalized-coef" = coef)

df_ridgeunpen <- ridge_unpen %>% 
  filter(outcome == "change_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-unpenalized-coef" = coef)

df_lassopen <- lasso_all %>% 
  filter(outcome == "change_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-penalized-coef" = coef)

df_lassounpen <- lasso_unpen %>% 
  filter(outcome == "change_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-unpenalized-coef" = coef)

df_lmg %>% 
  left_join(df_ridgepen,by = "predictor") %>% 
  left_join(df_ridgeunpen,by = "predictor") %>% 
  left_join(df_lassopen,by = "predictor") %>% 
  left_join(df_lassounpen,by = "predictor") %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

predictor	lmg-share	ridge-penalized-coef	ridge-unpenalized-coef	lasso-penalized-coef	lasso-unpenalized-coef
freedom	0.245	-0.136	-0.145	-0.140	-0.146
justice	0.244	-0.138	-0.139	-0.144	-0.138
democracy	0.197	-0.128	-0.136	-0.131	-0.136
happiness	0.167	-0.112	-0.114	-0.112	-0.112
tolerance	0.122	-0.103	-0.113	-0.103	-0.111
equality	0.016	0.041	0.052	0.026	0.046
arms	0.007	0.022	0.023	0.007	0.015
individualism	0.001	0.004	0.004	0.000	0.000

Trust in democratic political institutions

df_lmg <- lmg_all %>% 
  filter(outcome == "trust_deminst_z") %>% 
  select(predictor,share_among_values) %>% 
  mutate(share_among_values = round(share_among_values,3)) %>% 
  rename("lmg-share" = share_among_values)

df_ridgepen <- ridge_all %>% 
  filter(outcome == "trust_deminst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-penalized-coef" = coef)

df_ridgeunpen <- ridge_unpen %>% 
  filter(outcome == "trust_deminst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-unpenalized-coef" = coef)

df_lassopen <- lasso_all %>% 
  filter(outcome == "trust_deminst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-penalized-coef" = coef)

df_lassounpen <- lasso_unpen %>% 
  filter(outcome == "trust_deminst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-unpenalized-coef" = coef)

df_lmg %>% 
  left_join(df_ridgepen,by = "predictor") %>% 
  left_join(df_ridgeunpen,by = "predictor") %>% 
  left_join(df_lassopen,by = "predictor") %>% 
  left_join(df_lassounpen,by = "predictor") %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

predictor	lmg-share	ridge-penalized-coef	ridge-unpenalized-coef	lasso-penalized-coef	lasso-unpenalized-coef
justice	0.332	0.194	0.189	0.241	0.221
democracy	0.240	0.160	0.155	0.179	0.172
equality	0.124	0.096	0.090	0.094	0.082
freedom	0.123	0.097	0.098	0.092	0.092
happiness	0.107	0.098	0.097	0.101	0.097
arms	0.048	-0.069	-0.069	-0.063	-0.062
tolerance	0.024	0.044	0.043	0.030	0.026
individualism	0.001	0.002	0.000	0.000	0.000

Trust in non-political mainstream institutions

df_lmg <- lmg_all %>% 
  filter(outcome == "trust_natinst_z") %>% 
  select(predictor,share_among_values) %>% 
  mutate(share_among_values = round(share_among_values,3)) %>% 
  rename("lmg-share" = share_among_values)

df_ridgepen <- ridge_all %>% 
  filter(outcome == "trust_natinst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-penalized-coef" = coef)

df_ridgeunpen <- ridge_unpen %>% 
  filter(outcome == "trust_natinst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("ridge-unpenalized-coef" = coef)

df_lassopen <- lasso_all %>% 
  filter(outcome == "trust_natinst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-penalized-coef" = coef)

df_lassounpen <- lasso_unpen %>% 
  filter(outcome == "trust_natinst_z") %>% 
  select(predictor,coef) %>% 
  mutate(coef = round(coef,3)) %>% 
  rename("lasso-unpenalized-coef" = coef)

df_lmg %>% 
  left_join(df_ridgepen,by = "predictor") %>% 
  left_join(df_ridgeunpen,by = "predictor") %>% 
  left_join(df_lassopen,by = "predictor") %>% 
  left_join(df_lassounpen,by = "predictor") %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

predictor	lmg-share	ridge-penalized-coef	ridge-unpenalized-coef	lasso-penalized-coef	lasso-unpenalized-coef
justice	0.407	0.225	0.218	0.274	0.256
democracy	0.273	0.173	0.168	0.196	0.181
equality	0.120	0.093	0.087	0.085	0.077
freedom	0.102	0.086	0.084	0.078	0.072
happiness	0.051	0.060	0.056	0.046	0.039
arms	0.032	-0.055	-0.052	-0.047	-0.037
tolerance	0.015	0.031	0.029	0.011	0.006
individualism	0.001	-0.003	-0.001	0.000	0.000

Different Contracts for different people

Until now, we painted the social contract for the entire nationally representative sample. Here, we can see if people of different backgrounds see the social contract differently from one another. For example, conservatives might believe that the U.S.’s promise is different from what liberals believe. And not only that, they also may believe the U.S. is fulfilling its promise to a different degree than what liberals believe. Of course, there are infinite ways to break the data. In this app, you can break the data along big five personality traits, political ideology, party affiliation, education, income, age, race, gender, region, and state.

EXPLORE CROSS-SECTIONS ↗

Broken Social Contract

Study 2: Analysis Report

Background

Description

Hypotheses

Study design

Computational analytic strategy

Data collection

Demographics

Race and ethnicity

Gender

Age

Education

Income

County inequallity

County median income

County density

Politics

Ideology

Party ID

Vote in 2020

Vote in 2024

Measures

US priorities on paper

US delivering on its promise

Participants’ ideal

Broken promise

Personal disappointment

Anti-Establishment

Trust in democratic institutions

Trust in national mainstream institutions

Support for radical change

Social Dominance Orientiation

Personality

Voting intentions

Analysis

Correlation matrix

Linear models

DV: Antiestablishment sentiment

Model 1

Model 2

Model 3

Model 4

DV: Support for radical change

Model 1

Model 2

Model 3

Model 4

DV: Trust in democratic political institutions

Model 1

Model 2

Model 3

Model 4

DV: Trust in non-political mainstream institutions

Model 1

Model 2

Model 3

Model 4

DV: Turnout for Presidential Election

Model 1

Model 2

Model 3

Model 4

Identifying the driving values

Antiestablishment sentiment

Support for radical change

Trust in democratic political institutions

Trust in non-political mainstream institutions

Different Contracts for different people