01_Analyses_Study5

Description

These analyses were conducted for Chapter 1 Study 5 of my dissertation. This study is currently under review at Journal of Experimental Psychology - Applied.

Abstract

In the healthcare context, patient socioeconomic status (SES) informs how patients are perceived and treated, contributing to downstream health disparities. The current experimental research reveals the nature of such interpersonal challenges for low-SES patients. Across four experiments (total N = 1142), participants engaged in a series of mock telehealth visits with a patient who failed to follow treatment recommendations twice and were therefore noncompliant. Evidence suggests that after repeated noncompliance, low-SES patients are perceived disproportionately more harshly, as more lazy, less honest, and as exaggerating their pain more, than high-SES patients exhibiting the same behavior. These worsening perceptions of the patient predict lower intentions to invest in care for the patient in the future. Furthermore, low-SES patients receive less intense treatment than high-SES patients, regardless of patterns of noncompliance. Our findings for low-SES bias in the healthcare context are not moderated by patient race or gender. Internal meta-analyses provide additional support for these findings. This low-SES bias in the healthcare context suggests that biased perceptions of patients by their SES plays a pivotal role in social class health disparities.

Keywords: bias, stereotypes, socioeconomic status, healthcare, health

Set-up

Code

# loading packages
library(psych)
library(ggplot2)
library(effsize)
library(dplyr)
library(kableExtra)
library(GPArotation)
library(stats)
library(plyr)
library(psych)
library(tidyverse)
library("Hmisc")
library(forcats)
library(grid)
library(ggcorrplot)
library(corrplot)
library(gridExtra)
library("ggdark")
library(broom)
library("effects")
library(lsmeans)
library(emmeans)
library(diagram)
library(pwr)
library(dplyr)
library(tidyr)
library(nlme)
library(rstatix)
library(multcomp)
library(lme4)
library(lmerTest)
library(cowplot)
library(report)
library(sjPlot)
library(lavaan)
library(lavaan)
library("corrplot")
library(dplyr)
library(GPArotation)
library(psych)
library(RcmdrMisc)
library(plot3D)
library(effectsize)
library(sjmisc)
library(rstatix)
library(gtsummary)

Code

# creating ggplot functions 
theme_perez <- function() {
    ggplot2::theme_bw() +
    ggplot2::theme(
      axis.text = element_text(colour = "black",  family = "Times New Roman", size = 12),
    axis.title = element_text(colour = "black", family = "Times New Roman", size = 13),
    legend.title = element_text(colour = "black", family = "Times New Roman", size = 13),
    legend.text = element_text(colour = "black", family = "Times New Roman", size = 12),
    plot.title = element_text(colour = "black", family = "Times New Roman", size = 13),
    plot.subtitle = element_text(colour = "black", family = "Times New Roman", size = 13),
    strip.text = element_text(colour = "black", family = "Times New Roman", size = 13))
}

horzi_theme <- theme(    #   remove the gray background
  panel.background    = element_rect( size=.1, colour="black", fill="white") ,
  #   make the major gridlines light gray and thin
  panel.grid.major.y  = element_line( size=.1, colour="#666666" ) ,
  #   suppress the vertical grid lines
  panel.grid.major.x  = element_blank() ,
  #   suppress the minor grid lines
  panel.grid.minor    = element_blank() ,
  #   add axes
  axis.line           = element_line( size=.2 , colour="#666666" ),
  #   adjust the axis ticks
  axis.ticks          = element_line( size=.1 , colour="#666666" ),
  #   move the y-axis over to the left
  #axis.title.y        = element_text( angle=90, vjust=.5, hjust=.5 ),
  #   increase margin moved-over y-axis label fits
  # plot.margin = unit( c(.5,.25,.25,.5) , "in") ,
  title = element_text(  size=12 ) ,
  axis.title.x = element_text( size=12 ) ,
  axis.title.y = element_text( size=12 ) ,
  axis.text.x = element_text( size=12 ) ,
  axis.text.y = element_text( size=12 )
)

horzi <- horzi_theme

stat_sum_df <- function(fun, geom="crossbar", ...) {
  stat_summary(fun.data=fun, colour="black", geom=geom, width=.5,  ...)
}

# define the dodge object for equivalent error bar and geom_bar
dodge <- position_dodge(width=0.9)

# define a geom_bar
bars <- geom_bar(stat="summary", fun.y="mean", position="dodge")

Code

# importing data 
data <- read.csv("Data_Processed_Study5.csv")
data_wide <- read.csv("Data_Processed_Study5-Wide.csv")

ns

Code

kable(table(data$study), col.names = c("Study","n"))

Study	n
1	568
2	242
3	534
4	940

Code

kable(table(data_wide$conditionSES), col.names = c("SES Condition", "n"))

SES Condition	n
High SES	569
Low SES	573

Reported Outcomes

Patient Laziness

Code

ggplot(data=data, aes(as.factor(strike), lazy, fill=conditionSES)) +
  geom_bar(stat="summary", fun.y="mean", position="dodge") +
  stat_sum_df("mean_se", geom = "errorbar", position= position_dodge(.9), conf.int=.68, width=0.2) +
  expand_limits(y=c(1:5)) +
  scale_y_continuous(breaks=c(1:5)) +
  theme_perez() +
  scale_fill_grey() +
  xlab("Noncompliance Incident / 'Strike'") +
  ylab("Perceived Patient Laziness") +
  guides(fill=guide_legend(title="Patient SES")) +
  theme(legend.position="bottom") 

Code

modLazy <- lmer(lazy ~ conditionSES * strike + ladder_Self + income_Self + ed_Own + study + conditionRace + (1|ResponseId), data=data, na.action=na.omit)

kable(anova(modLazy), caption = "Model Output")

Model Output

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.0868157	0.0868157	1	1072.5480	0.1594355	0.6897563
strike	158.8268309	158.8268309	1	641.5807	291.6824563	0.0000000
ladder_Self	0.6957271	0.6957271	1	639.2166	1.2776895	0.2587530
income_Self	0.8244455	0.8244455	1	639.3323	1.5140784	0.2189703
ed_Own	0.1102541	0.1102541	1	638.9821	0.2024795	0.6528795
study	0.3310538	0.3310538	1	639.8909	0.6079741	0.4358399
conditionRace	4.3613881	4.3613881	1	639.1973	8.0096064	0.0047991
conditionSES:strike	2.7539884	2.7539884	1	641.5847	5.0576473	0.0248559

Code

effectsize::eta_squared(modLazy, partial=T) %>% 
  select(1:2) %>% 
  kable(caption = "Effect Sizes")

Effect Sizes

Parameter	Eta2_partial
conditionSES	0.0001486
strike	0.3125404
ladder_Self	0.0019948
income_Self	0.0023626
ed_Own	0.0003168
study	0.0009492
conditionRace	0.0123756
conditionSES:strike	0.0078214

Code

kable(emmeans(modLazy, pairwise ~ conditionSES * strike)$contrasts, caption = "Contrasts")

Contrasts

contrast	estimate	SE	df	t.ratio	p.value
High SES strike1 - Low SES strike1	-0.1270827	0.0871313	978.1829	-1.458520	0.4631753
High SES strike1 - High SES strike2	-0.6104077	0.0588507	641.6579	-10.372138	0.0000000
High SES strike1 - Low SES strike2	-0.9226251	0.0871709	979.0184	-10.584100	0.0000000
Low SES strike1 - High SES strike2	-0.4833250	0.0871390	978.3491	-5.546600	0.0000002
Low SES strike1 - Low SES strike2	-0.7955424	0.0575633	642.2758	-13.820296	0.0000000
High SES strike2 - Low SES strike2	-0.3122174	0.0871785	979.1787	-3.581359	0.0020300

Patient Honesty

Model Output

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	1.5722784	1.5722784	1	1042.4821	3.3327546	0.0681990
strike	58.1895127	58.1895127	1	638.5317	123.3441658	0.0000000
ladder_Self	1.9187761	1.9187761	1	641.9340	4.0672250	0.0441389
income_Self	0.4361210	0.4361210	1	640.4218	0.9244446	0.3366735
ed_Own	0.2529271	0.2529271	1	638.0019	0.5361289	0.4643103
study	6.0381069	6.0381069	1	638.2073	12.7989603	0.0003731
conditionRace	3.3232329	3.3232329	1	637.7725	7.0442485	0.0081503
conditionSES:strike	5.2630705	5.2630705	1	638.5657	11.1561175	0.0008863

Effect Sizes

Parameter	Eta2_partial
conditionSES	0.0031868
strike	0.1618953
ladder_Self	0.0062960
income_Self	0.0014414
ed_Own	0.0008396
study	0.0196603
conditionRace	0.0109244
conditionSES:strike	0.0171706

Contrasts

contrast	estimate	SE	df	t.ratio	p.value
High SES strike1 - Low SES strike1	0.0116065	0.0787042	1001.8203	0.1474699	0.9988566
High SES strike1 - High SES strike2	0.2980549	0.0548438	639.6212	5.4346141	0.0000005
High SES strike1 - Low SES strike2	0.5660343	0.0788430	1004.8965	7.1792618	0.0000000
Low SES strike1 - High SES strike2	0.2864484	0.0785734	998.9261	3.6456157	0.0015957
Low SES strike1 - Low SES strike2	0.5544278	0.0537029	640.9502	10.3239893	0.0000000
High SES strike2 - Low SES strike2	0.2679794	0.0787115	1001.9751	3.4045784	0.0038398

Patient Exaggerating Pain

Model Output

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.9130411	0.9130411	1	1048.1995	1.9665388	0.1611118
strike	66.7179797	66.7179797	1	643.5929	143.6994494	0.0000000
ladder_Self	0.1674218	0.1674218	1	638.9370	0.3605987	0.5483869
income_Self	0.5014529	0.5014529	1	639.1265	1.0800463	0.2990802
ed_Own	0.0049003	0.0049003	1	639.1704	0.0105545	0.9182055
study	6.7708951	6.7708951	1	639.7015	14.5833836	0.0001471
conditionRace	2.1196033	2.1196033	1	639.6130	4.5652734	0.0330053
conditionSES:strike	1.6194358	1.6194358	1	643.5929	3.4879957	0.0622697

Effect Sizes

Parameter	Eta2_partial
conditionSES	0.0018726
strike	0.1825236
ladder_Self	0.0005641
income_Self	0.0016870
ed_Own	0.0000165
study	0.0222890
conditionRace	0.0070870
conditionSES:strike	0.0053904

Contrasts

contrast	estimate	SE	df	t.ratio	p.value
High SES strike1 - Low SES strike1	0.0439439	0.0776263	1004.3138	0.5660956	0.9421056
High SES strike1 - High SES strike2	-0.3839602	0.0543399	644.5949	-7.0658945	0.0000000
High SES strike1 - Low SES strike2	-0.4817359	0.0776263	1004.3138	-6.2058331	0.0000000
Low SES strike1 - High SES strike2	-0.4279041	0.0777130	1006.2435	-5.5062120	0.0000003
Low SES strike1 - Low SES strike2	-0.5256798	0.0529657	643.1135	-9.9249051	0.0000000
High SES strike2 - Low SES strike2	-0.0977757	0.0777130	1006.2435	-1.2581646	0.5898776

Feel Like Giving Up on Patient

Model Output

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.0041850	0.0041850	1	1037.8062	0.0068989	0.9338202
strike	290.2559191	290.2559191	1	643.8735	478.4752726	0.0000000
ladder_Self	1.7317376	1.7317376	1	639.8380	2.8547001	0.0915944
income_Self	0.6243648	0.6243648	1	639.5342	1.0292404	0.3107208
ed_Own	0.0160595	0.0160595	1	639.6742	0.0264734	0.8708009
study	10.7450764	10.7450764	1	639.7479	17.7128287	0.0000294
conditionRace	0.7125627	0.7125627	1	639.7420	1.1746311	0.2788600
conditionSES:strike	0.0395832	0.0395832	1	643.8731	0.0652513	0.7984622

Effect Sizes

Parameter	Eta2_partial
conditionSES	0.0000066
strike	0.4263160
ladder_Self	0.0044418
income_Self	0.0016068
ed_Own	0.0000414
study	0.0269413
conditionRace	0.0018327
conditionSES:strike	0.0001013

Pred. by Change in Perceptions

Change in Patient Laziness

Code

mod <- lm(givingUp_2 ~ lazy_2 + conditionSES + lazy_1 + income_Self + ladder_Self + ed_Own + conditionRace + study, data_wide)

tab_model(mod)

	givingUp_2
Predictors	Estimates	CI	p
(Intercept)	0.23	-0.28 – 0.74	0.379
lazy 2	0.42	0.33 – 0.51	<0.001
conditionSES [Low SES]	-0.13	-0.30 – 0.03	0.118
lazy 1	0.23	0.14 – 0.33	<0.001
income Self	-0.02	-0.06 – 0.03	0.530
ladder Self	0.04	-0.01 – 0.09	0.083
ed Own	0.01	-0.12 – 0.14	0.858
conditionRace [White]	0.02	-0.15 – 0.19	0.806
study	0.18	0.09 – 0.28	<0.001
Observations	641
R2 / R2 adjusted	0.289 / 0.280

Code

effectsize::eta_squared(mod, partial=T) %>% 
  select(1:2) %>% 
  kable(caption = "Effect Sizes")

Effect Sizes

Parameter	Eta2_partial
lazy_2	0.2483449
conditionSES	0.0036602
lazy_1	0.0421355
income_Self	0.0001989
ladder_Self	0.0037633
ed_Own	0.0015023
conditionRace	0.0000335
study	0.0215421

Code

data_wide$lazy_change <- data_wide$lazy_2 - data_wide$lazy_1
data_wide$lazyIncrease <- case_when(data_wide$lazy_change >= 1 ~ "1",
                              data_wide$lazy_change == 0 ~ "0",
                              TRUE ~ "-1")

ggplot(data_wide, aes(lazy_change, givingUp_2)) +
  geom_jitter(aes(colour=factor(lazyIncrease)), alpha=0.5) +
  stat_smooth(method="lm", color="#003f5c") +
  scale_x_continuous(breaks=c(-4:4)) +
  labs(x = "Change in Perceived Patient Laziness from Strike 1 to Strike 2",
       y = "Desire to 'Give Up' after Strike 2",
       title = "\U0394 Laziness \U2192 Giving Up",
       subtitle = "Meta-Analysis") +
  guides(colour=guide_legend(title="Direction\nof Change")) +
  scale_color_manual(values=c("#B3DFFF", "#768fe8", "#0a7cfc"), labels=c("Decrease", "No Change", "Increase")) +
  theme_perez() +
  theme(legend.position="bottom")

Code

ggplot(data_wide, aes(lazy_change, givingUp_2, fill=conditionSES)) +
  geom_jitter() +
  stat_smooth(method="lm") +
  scale_x_continuous(breaks=c(-3:4)) +
  labs(x = "Change in Perceived Patient Laziness from Strike 1 to Strike 2",
       y = "Desire to 'Give Up' after Strike 2") +
  theme_perez() +
  theme(legend.position="bottom")

Change in Patient Honesty

Code

mod <- lm(givingUp_2 ~ honest_2 + conditionSES + honest_1 + income_Self + ladder_Self + ed_Own + conditionRace + study, data_wide)

tab_model(mod)

	givingUp_2
Predictors	Estimates	CI	p
(Intercept)	2.62	1.96 – 3.29	<0.001
honest 2	-0.13	-0.23 – -0.02	0.018
conditionSES [Low SES]	-0.00	-0.20 – 0.19	0.995
honest 1	-0.03	-0.16 – 0.11	0.681
income Self	-0.04	-0.10 – 0.02	0.164
ladder Self	0.07	0.02 – 0.13	0.009
ed Own	-0.01	-0.16 – 0.13	0.843
conditionRace [White]	0.15	-0.05 – 0.34	0.137
study	0.22	0.11 – 0.33	<0.001
Observations	638
R2 / R2 adjusted	0.048 / 0.036

Code

effectsize::eta_squared(mod, partial=T) %>% 
  select(1:2) %>% 
  kable(caption = "Effect Sizes")

Effect Sizes

Parameter	Eta2_partial
honest_2	0.0132327
conditionSES	0.0000466
honest_1	0.0000648
income_Self	0.0012717
ladder_Self	0.0086612
ed_Own	0.0005270
conditionRace	0.0032088
study	0.0229624

Code

# settings for plots
data_wide$honest_change <- data_wide$honest_1 - data_wide$honest_2

data_wide$honIncrease <- case_when(data_wide$honest_change >= 1 ~ "1",
                              data_wide$honest_change == 0 ~ "0",
                              TRUE ~ "-1")

ggplot(data_wide, aes(honest_change, givingUp_2)) +
  geom_jitter(aes(colour=factor(honIncrease)), alpha=0.5) +
  stat_smooth(method="lm", color="#003f5c") +
  scale_x_continuous(breaks=c(-4:4)) +
  labs(x = "Change in Perceived Patient Honesty from Strike 1 to Strike 2",
       y = "Desire to 'Give Up' after Strike 2",
       title = "\U0394 Honesty \U2192 Giving Up",
       subtitle = "Meta-Analysis") +
  guides(colour=guide_legend(title="Direction\nof Change")) +
  scale_color_manual(values=c("#B3DFFF", "#768fe8", "#0a7cfc"), labels=c("Decrease", "No Change", "Increase")) +
  theme_perez() +
  theme(legend.position="bottom")

Change in Patient Pain Exaggeration

Code

mod <- lm(givingUp_2 ~ exaggerate_2 * conditionSES + exaggerate_1 + income_Self + ladder_Self + ed_Own + conditionRace + study, data_wide)

tab_model(mod)

	givingUp_2
Predictors	Estimates	CI	p
(Intercept)	0.89	0.28 – 1.51	0.005
exaggerate 2	0.33	0.20 – 0.46	<0.001
conditionSES [Low SES]	-0.15	-0.70 – 0.39	0.582
exaggerate 1	0.12	0.00 – 0.24	0.049
income Self	-0.02	-0.07 – 0.03	0.408
ladder Self	0.06	0.01 – 0.11	0.022
ed Own	-0.00	-0.14 – 0.14	0.974
conditionRace [White]	0.08	-0.10 – 0.26	0.376
study	0.12	0.01 – 0.22	0.025
exaggerate 2 × conditionSES [Low SES]	0.05	-0.11 – 0.22	0.534
Observations	644
R2 / R2 adjusted	0.158 / 0.146

Code

effectsize::eta_squared(mod, partial=T) %>% 
  select(1:2) %>% 
  kable(caption = "Effect Sizes")

Effect Sizes

Parameter	Eta2_partial
exaggerate_2	0.1414097
conditionSES	0.0000261
exaggerate_1	0.0058366
income_Self	0.0000318
ladder_Self	0.0070529
ed_Own	0.0002448
conditionRace	0.0010366
study	0.0078065
exaggerate_2:conditionSES	0.0006090

Code

data_wide$exag_change <- data_wide$exaggerate_2 - data_wide$exaggerate_1

data_wide$exagIncrease <- case_when(data_wide$exag_change >= 1 ~ "1",
                              data_wide$exag_change == 0 ~ "0",
                              TRUE ~ "-1")

ggplot(data_wide, aes(exag_change, givingUp_2)) +
  geom_jitter(aes(colour=factor(exagIncrease)), alpha=0.5) +
  stat_smooth(method="lm", color="#003f5c") +
  scale_x_continuous(breaks=c(-4:4)) +
  labs(x = "Change in Perceived Pain Exaggeration from Strike 1 to Strike 2",
       y = "Desire to 'Give Up' after Strike 2",
       title = "\U0394 Pain Exaggeration \U2192 Giving Up",
       subtitle = "Meta-Analysis") +
  guides(colour=guide_legend(title="Direction\nof Change")) +
  scale_color_manual(values=c("#B3DFFF", "#768fe8", "#0a7cfc"), labels=c("Decrease", "No Change", "Increase")) +
  theme_perez() +
  theme(legend.position="bottom")

Treatment Decisions

Code

ggplot(data=data, aes(conditionSES, treatAvg, fill=factor(strike))) +
  geom_bar(stat="summary", fun.y="mean", position="dodge") +
  stat_sum_df("mean_cl_boot", geom = "errorbar", position= position_dodge(.9), conf.int=.68, width=0.2) +
  expand_limits(y=c(1:4)) +
  scale_y_continuous(breaks=c(1:4), labels=c("1-Lowest\nTreatment\nIntensity","2","3","4-Highest\nTreatment\nIntensity")) +
  xlab("Patient SES") +
  ylab("Treatment Intensity") +
  theme_perez() +
  scale_fill_grey() +
  guides(fill=guide_legend(title="Noncompliance Incident / 'Strike'")) +
  theme(legend.position="bottom") +
  theme(axis.text.x=element_text(angle=15, vjust=.8, hjust=0.8))

Code

modTreat <- lmer(treatAvg ~ conditionSES + strike + income_Self + ladder_Self + ed_Own + study + conditionRace + (1|ResponseId), data=data)

anova(modTreat)

Type III Analysis of Variance Table with Satterthwaite's method
               Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
conditionSES   1.6953  1.6953     1 638.66  7.7669 0.0054793 ** 
strike        13.5223 13.5223     1 643.98 61.9503 1.496e-14 ***
income_Self    0.1880  0.1880     1 638.28  0.8611 0.3537711    
ladder_Self    0.2148  0.2148     1 639.05  0.9840 0.3216007    
ed_Own         0.0133  0.0133     1 638.45  0.0608 0.8053193    
study          2.7543  2.7543     1 638.29 12.6186 0.0004101 ***
conditionRace  0.0121  0.0121     1 638.68  0.0555 0.8137926    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Code

effectsize::eta_squared(modTreat, partial=T) %>% 
  select(1:2) %>% 
  kable(caption = "Effect Sizes")

Effect Sizes

Parameter	Eta2_partial
conditionSES	0.0120152
strike	0.0877569
income_Self	0.0013473
ladder_Self	0.0015373
ed_Own	0.0000952
study	0.0193863
conditionRace	0.0000869

Code

emmeans(modTreat, pairwise ~ conditionSES)

$emmeans
 conditionSES emmean     SE  df lower.CL upper.CL
 High SES       1.71 0.0360 639     1.64     1.78
 Low SES        1.57 0.0352 639     1.50     1.63

Results are averaged over the levels of: strike, conditionRace 
Degrees-of-freedom method: kenward-roger 
Confidence level used: 0.95 

$contrasts
 contrast           estimate     SE  df t.ratio p.value
 High SES - Low SES    0.141 0.0505 639   2.787  0.0055

Results are averaged over the levels of: strike, conditionRace 
Degrees-of-freedom method: kenward-roger 

Code

emmeans(modTreat, pairwise ~ strike)

$emmeans
 strike emmean     SE  df lower.CL upper.CL
      1   1.53 0.0283 958     1.48     1.59
      2   1.74 0.0283 959     1.68     1.79

Results are averaged over the levels of: conditionSES, conditionRace 
Degrees-of-freedom method: kenward-roger 
Confidence level used: 0.95 

$contrasts
 contrast          estimate    SE  df t.ratio p.value
 strike1 - strike2   -0.205 0.026 644  -7.871  <.0001

Results are averaged over the levels of: conditionSES, conditionRace 
Degrees-of-freedom method: kenward-roger 

Patient SES Manipulation Check

Perceived Patient Subjective SES (Ladder)

Code

tab_model(t.test(data_wide$ladder_Patient ~ data_wide$SES))

	Dependent variable
Predictors	Estimates	CI	p
data_wide$ladder_Patient	1.15	0.93 – 1.38	<0.001

Perceived Patient Objective SES (Income)

Code

tab_model(t.test(data_wide$income_Patient ~ data_wide$SES))

	Dependent variable
Predictors	Estimates	CI	p
data_wide$income_Patient	1.07	0.89 – 1.25	<0.001

Perceived Patient Education Level

Code

tab_model(t.test(data_wide$ed_Patient ~ data_wide$SES))

	Dependent variable
Predictors	Estimates	CI	p
data_wide$ed_Patient	0.49	0.41 – 0.58	<0.001

Participant Demographics

Subjective SES (Ladder)

Code

hist(data_wide$ladder_Self, xlab = "Ladder Position", main = "Subjective SES (Ladder)")

Code

kable(psych::describe(data_wide$ladder_Self), caption = "Subjective SES (Ladder)", row.names = NA)

Subjective SES (Ladder)

	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
X1	1	1124	6.772242	1.837498	7	6.911111	1.4826	1	10	9	-0.6708252	0.1092646	0.054808

Objective SES (Income)

Code

hist(data_wide$income_Self, xlab = "Income", main = "Objective SES (Income)")

Code

kable(psych::describe(data_wide$income_Self), row.names = NA, caption = "Objective SES (Income)") 

Objective SES (Income)

	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
X1	1	1110	4.779279	1.989812	5	4.949324	2.9652	1	7	6	-0.4790811	-1.066997	0.0597242

Education Level

Code

kable(table(factor(data_wide$ed_Own, labels = c("< HS", "HS", "College", "Post-grad"))), col.names = c("Education Level", "n"), caption = "Objective SES (Education Level)", row.names = NA)

Objective SES (Education Level)

Education Level	n
< HS	8
HS	277
College	303
Post-grad	67

Race

Code

kable(table(factor(data_wide$race_Self, labels = c("White/Caucasian", "Asian/Asian-American", "Black/African American", "Hispanic/Latinx", "East Asian/East Asian-American", "Multiracial", "Other"))), col.names = c("Race", "n"), caption = "Race", row.names = NA) 

Race

Race	n
White/Caucasian	721
Asian/Asian-American	198
Black/African American	58
Hispanic/Latinx	70
East Asian/East Asian-American	15
Multiracial	47
Other	16

Gender

Code

kable(table(data_wide$gender_Self), col.names = c("Gender", "n"), caption = "Gender", row.names = NA) 

Gender

Gender	n
Female	759
Male	354
Non-Conform	5
Other	3
Trans	5

Additional Outcomes

Patient Motivation

Code

ggplot(data=data, aes(conditionSES, motivated, fill=as.factor(strike))) +
  geom_bar(stat="summary", fun.y="mean", position="dodge") +
  stat_sum_df("mean_cl_boot", geom = "errorbar", position= position_dodge(.9), conf.int=.68, width=0.2) +
  expand_limits(y=c(1:5)) +
  scale_y_continuous(breaks=c(1:5)) +
  theme_perez() +
  scale_fill_grey() +
  xlab("Patient SES") +
  ylab("Perception of Patient Motivation to Improve") +
  guides(fill=guide_legend(title="Noncompliance Incident / 'Strike'")) +
  theme(legend.position="bottom") +
  theme(axis.text.x=element_text(angle=15, vjust=.8, hjust=0.8))

Code

modMotiv <- lmer(motivated ~ conditionSES * strike + ladder_Self + income_Self + ed_Own + study + conditionRace + (1|ResponseId), data=data, na.action=na.omit)

kable(anova(modMotiv))

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.2317683	0.2317683	1	1094.6963	0.5337076	0.4652086
strike	50.8918421	50.8918421	1	644.0302	117.1918670	0.0000000
ladder_Self	0.0827748	0.0827748	1	640.1766	0.1906107	0.6625561
income_Self	1.3344852	1.3344852	1	640.4835	3.0730035	0.0800807
ed_Own	0.2456570	0.2456570	1	640.9898	0.5656900	0.4522528
study	2.9229805	2.9229805	1	641.5510	6.7309323	0.0096920
conditionRace	3.5255331	3.5255331	1	640.6298	8.1184683	0.0045224
conditionSES:strike	0.0690768	0.0690768	1	644.0359	0.1590675	0.6901487

First Impression of Patient Pain Severity

Code

ggplot(data=data, aes(conditionSES, severe)) +
  geom_bar(stat="summary", fun.y="mean", position="dodge") +
  facet_wrap(~study) +
  stat_sum_df("mean_cl_boot", geom = "errorbar", position= position_dodge(.9), conf.int=.68, width=0.2) +
  expand_limits(y=c(1:5)) +
  theme_perez() +
  scale_fill_grey() +
  xlab("Condition") +
  ylab("Initial Perceived Pain Severity") +
  theme(legend.position="bottom")

Code

modSevere <- lm(severe ~ conditionSES + study + income_Self + ladder_Self + ed_Own + study + conditionRace, data=data_wide)

kable(anova(modSevere))

	Df	Sum Sq	Mean Sq	F value	Pr(>F)
conditionSES	1	0.0423033	0.0423033	0.0518208	0.8199975
study	1	42.0621719	42.0621719	51.5254714	0.0000000
income_Self	1	1.1183138	1.1183138	1.3699161	0.2422626
ladder_Self	1	0.3357819	0.3357819	0.4113273	0.5215266
ed_Own	1	0.1522614	0.1522614	0.1865177	0.6659765
conditionRace	1	1.2315807	1.2315807	1.5086662	0.2197949
Residuals	639	521.6396304	0.8163374	NA	NA

Important to Me that Patient Health Improves

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.1509537	0.1509537	1	1157.1000	0.6201895	0.4311382
strike	16.6743110	16.6743110	1	643.4295	68.5059771	0.0000000
ladder_Self	0.3313833	0.3313833	1	639.9235	1.3614796	0.2437158
income_Self	0.0033396	0.0033396	1	639.2686	0.0137207	0.9067895
ed_Own	0.5087823	0.5087823	1	639.7310	2.0903190	0.1487248
study	2.5210513	2.5210513	1	639.8163	10.3576745	0.0013545
conditionRace	0.6540915	0.6540915	1	639.5736	2.6873180	0.1016417
conditionSES:strike	0.0000742	0.0000742	1	643.4295	0.0003050	0.9860726

I Should Have Been Clearer

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.0070500	0.0070500	1	405.2264	0.0103466	0.9190306
strike	68.3020135	68.3020135	1	254.5020	100.2397843	0.0000000
ladder_Self	1.2126889	1.2126889	1	252.0845	1.7797377	0.1833855
income_Self	0.5717784	0.5717784	1	252.7423	0.8391398	0.3605161
ed_Own	1.0458907	1.0458907	1	252.0512	1.5349453	0.2165242
conditionRace	4.5902363	4.5902363	1	252.0304	6.7366139	0.0099994
conditionSES:strike	0.4118554	0.4118554	1	254.4978	0.6044374	0.4376120

Attributions for Patient’s Noncompliant Behavior

	Sum Sq	Mean Sq	NumDF	DenDF	F value	Pr(>F)
conditionSES	0.0020823	0.0020823	1	1661.960	0.0020563	0.9638367
strike	293.3453541	293.3453541	1	1104.559	289.6833921	0.0000000
ladder_Self	5.1737741	5.1737741	1	1101.229	5.1091875	0.0239941
race_Self	1.4052377	1.4052377	1	1102.830	1.3876955	0.2390488
income_Self	2.8745511	2.8745511	1	1100.882	2.8386668	0.0923040
study	1.1776692	1.1776692	1	1100.640	1.1629679	0.2810872
conditionRace	0.0041485	0.0041485	1	1100.822	0.0040967	0.9489772
conditionSES:strike	0.2001312	0.2001312	1	1104.556	0.1976329	0.6567254

Perceived Likelihood of Patient Health Insurance

	Df	Sum Sq	Mean Sq	F value	Pr(>F)
conditionSES	1	89.7868803	89.7868803	94.5818825	0.0000000
ladder_Self	1	0.4096606	0.4096606	0.4315383	0.5114716
race_Self	1	0.9760359	0.9760359	1.0281603	0.3109749
income_Self	1	1.8541792	1.8541792	1.9532003	0.1627274
ed_Own	1	0.1664168	0.1664168	0.1753042	0.6755809
study	1	0.4852871	0.4852871	0.5112035	0.4748795
conditionRace	1	0.6318106	0.6318106	0.6655519	0.4149107
Residuals	639	606.6047218	0.9493032	NA	NA

Perceived Patient Health Literacy

	Df	Sum Sq	Mean Sq	F value	Pr(>F)
conditionSES	1	44.515853	44.515853	24.6625003	0.0000009
conditionRace	1	14.388469	14.388469	7.9714440	0.0048999
ladder_Self	1	1.114672	1.114672	0.6175464	0.4322514
race_Self	1	6.094320	6.094320	3.3763517	0.0666017
income_Self	1	1.050241	1.050241	0.5818502	0.4458691
ed_Own	1	2.184482	2.184482	1.2102382	0.2716986
study	1	5.745687	5.745687	3.1832035	0.0748724
Residuals	640	1155.201029	1.805002	NA	NA