Introspection COVID-19 Analyses
Dani Grant
2/2/2021
We use the code in this script to analyze Studies 1 introspection social condition included in the supplemental materials.
The processed data files used in this code are in the “data” folder and can be read directly for analyses. These data files are a subsetted and processed version of aggregate data files.
The code for subsetting and processing is in a different script in the “scripts” folder.
Set up
0. Measures overview
introSpread: How much should your likelihood of spreading Covid-19 influence your decision to attend the gathering? (1=not at all; 7=extremely)
introExpSymp: How much should your likelihood of experiencing severe symptoms from Covid-19 influence your decision to attend the gathering? (1=not at all; 7=extremely)
partyLikely: How likely would you be to attend your friend’s gathering? (1=extremely unlikely; 7=extremely likely)
contLikely: How likely are you to contract Covid-19 at this gathering? (1=extremely unlikely; 7=extremely likely)
spreadLikely: Assuming you do contract Covid-19, what is the likelihood of spreading it to others you interact with in your daily life? (1=extremely unlikely; 7=extremely likely)
groupLikely: How likely do you think the average member of your family, community, or friend group would be to attend the gathering? (1=extremely unlikely; 7=extremely likely)
1. Study 1 (Social scenario)
1.1 Descriptive statistics
For full sample:
studyVars <- c("introSpread","introExpSymp","avgInt","partyLikely","contLikely","spreadLikely","groupLikely")
describe(d[,studyVars])## vars n mean sd median trimmed mad min max range skew
## introSpread 1 6007 5.36 1.77 6 5.64 1.48 1 7 6 -1.04
## introExpSymp 2 6019 5.26 1.80 6 5.52 1.48 1 7 6 -0.92
## avgInt 3 5999 5.31 1.67 6 5.55 1.48 1 7 6 -0.96
## partyLikely 4 6035 2.69 1.89 2 2.43 1.48 1 7 6 0.81
## contLikely 5 6029 4.51 1.72 5 4.60 1.48 1 7 6 -0.43
## spreadLikely 6 6023 4.93 1.91 5 5.14 1.48 1 7 6 -0.71
## groupLikely 7 5240 3.78 1.78 4 3.80 1.48 1 7 6 -0.09
## kurtosis se
## introSpread 0.18 0.02
## introExpSymp -0.12 0.02
## avgInt 0.17 0.02
## partyLikely -0.63 0.02
## contLikely -0.63 0.02
## spreadLikely -0.65 0.02
## groupLikely -1.11 0.02Descriptive statistics by condition:
describeBy(
d[,studyVars],
group = d$introFactor)##
## Descriptive statistics by group
## group: Control
## vars n mean sd median trimmed mad min max range skew
## introSpread 1 3026 5.32 1.79 6.0 5.60 1.48 1 7 6 -1.00
## introExpSymp 2 3038 5.20 1.82 6.0 5.45 1.48 1 7 6 -0.85
## avgInt 3 3018 5.26 1.68 5.5 5.49 2.22 1 7 6 -0.91
## partyLikely 4 3054 2.82 1.95 2.0 2.59 1.48 1 7 6 0.71
## contLikely 5 3053 4.53 1.74 5.0 4.64 1.48 1 7 6 -0.45
## spreadLikely 6 3044 4.93 1.92 5.0 5.14 1.48 1 7 6 -0.70
## groupLikely 7 2652 3.80 1.78 4.0 3.81 1.48 1 7 6 -0.08
## kurtosis se
## introSpread 0.08 0.03
## introExpSymp -0.26 0.03
## avgInt 0.06 0.03
## partyLikely -0.83 0.04
## contLikely -0.64 0.03
## spreadLikely -0.69 0.03
## groupLikely -1.10 0.03
## ------------------------------------------------------------
## group: Introspection
## vars n mean sd median trimmed mad min max range skew
## introSpread 1 2981 5.40 1.76 6 5.69 1.48 1 7 6 -1.08
## introExpSymp 2 2981 5.32 1.78 6 5.59 1.48 1 7 6 -0.99
## avgInt 3 2981 5.36 1.65 6 5.60 1.48 1 7 6 -1.01
## partyLikely 4 2981 2.55 1.81 2 2.29 1.48 1 7 6 0.92
## contLikely 5 2976 4.48 1.70 5 4.56 1.48 1 7 6 -0.41
## spreadLikely 6 2979 4.93 1.89 5 5.14 1.48 1 7 6 -0.73
## groupLikely 7 2588 3.77 1.78 4 3.79 1.48 1 7 6 -0.09
## kurtosis se
## introSpread 0.28 0.03
## introExpSymp 0.04 0.03
## avgInt 0.29 0.03
## partyLikely -0.38 0.03
## contLikely -0.63 0.03
## spreadLikely -0.61 0.03
## groupLikely -1.13 0.031.1.1 t.tests (notice they do not account for clustering at country level)
t.test for condition differences for DV:
t.test(d$partyLikely ~ d$introC)##
## Welch Two Sample t-test
##
## data: d$partyLikely by d$introC
## t = 5.4846, df = 6017.7, p-value = 4.313e-08
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.1709569 0.3611457
## sample estimates:
## mean in group -0.5 mean in group 0.5
## 2.820563 2.554512t.test for condition differences for subjective risk for contracting Covid-19 at party
t.test(d$contLikely ~ d$introC)##
## Welch Two Sample t-test
##
## data: d$contLikely by d$introC
## t = 1.2414, df = 6027, p-value = 0.2145
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.03191103 0.14210275
## sample estimates:
## mean in group -0.5 mean in group 0.5
## 4.532918 4.477823t.test for condition differences for subjective weight for risk of spreading Covid-19 after attending party
t.test(d$spreadLikely ~ d$introC)##
## Welch Two Sample t-test
##
## data: d$spreadLikely by d$introC
## t = -0.064673, df = 6020.8, p-value = 0.9484
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.09957060 0.09321071
## sample estimates:
## mean in group -0.5 mean in group 0.5
## 4.930355 4.933535t.test for condition differences for believe other members of community would attend
t.test(d$groupLikely ~ d$introC)##
## Welch Two Sample t-test
##
## data: d$groupLikely by d$introC
## t = 0.51116, df = 5234.5, p-value = 0.6093
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.07119042 0.12140944
## sample estimates:
## mean in group -0.5 mean in group 0.5
## 3.797134 3.7720251.2 Visualization for primary variables by country and condition
1.2.1 Violin plots
p1 <- ggplot(d,
aes(y = partyLikely,
x = country_factor,
group = interaction(introFactor,country_factor),
fill = introFactor,
color = introFactor)) +
geom_boxplot(color = "gray4") +
geom_violin(alpha = .1, color = "gray4") +
scale_y_continuous(name = "Likelihood of attending the party") +
scale_fill_manual(values = c("indianred1","steelblue1"),
name = "Condition",
labels = c("Control", "Introspection")) +
theme_classic()
p1
1.2.2 Bar plots for means
#Get matrix with means by country and by condition
meanPlotMat <- aggregate(d$partyLikely ~ (d$introFactor*d$country_factor),
FUN = mean, na.rm = T)
#Append SD to table
meanPlotMat$sd <- aggregate(d$partyLikely ~ (d$introFactor*d$country_factor),
FUN = sd, na.rm = T)[,3]
#Get the N for each cell and append to table
getN <- function(vector) sum(!is.na(vector))
meanPlotMat$n <- aggregate(d$partyLikely ~ (d$introFactor*d$country_factor),
FUN = getN)[,3]
#Compute SE per cell and append to table
meanPlotMat$se <- meanPlotMat$sd/sqrt(meanPlotMat$n)
#Change names in table
names(meanPlotMat)[1:3] <- c("introFactor","country_factor","partyLikely")p2 <- ggplot(d,
aes(y = partyLikely,
x = country_factor,
group = interaction(introFactor,country_factor),
fill = introFactor,
color = introFactor)) +
geom_bar(data=meanPlotMat,
stat = "identity",
position = position_dodge(),
color = "gray4") +
geom_errorbar(data = meanPlotMat,
aes(ymin=partyLikely - se,
ymax=partyLikely + se),
position = position_dodge(),
color = "gray4") +
scale_y_continuous(name = "Likelihood of attending the party") +
scale_fill_manual(values = c("indianred1","steelblue1"),
name = "Condition",
labels = c("Control", "Introspection")) +
theme_classic()
p2
1.3 Models
1.3.1 Model 1: Would participants be less likely to attend the part in the introspection condition?
Note: A version of this model estimating random slopes for introspection condition failed to converge. We therefore estimate only random intercepts for country.
m1 <- lmer(partyLikely ~ introC +
(1|country_factor),
data = d
)
summary(m1)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: partyLikely ~ introC + (1 | country_factor)
## Data: d
##
## REML criterion at convergence: 24529.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.4001 -0.7558 -0.3488 0.6964 2.7035
##
## Random effects:
## Groups Name Variance Std.Dev.
## country_factor (Intercept) 0.1999 0.4471
## Residual 3.3921 1.8418
## Number of obs: 6035, groups: country_factor, 7
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.70324 0.17075 6.00020 15.832 4.03e-06 ***
## introC -0.25744 0.04743 6027.13397 -5.427 5.95e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## introC 0.0011.3.2 Model 2: Is there still an effect of introspection condition after controlling for ratings for the introspection intenvention items?
Note: We attempted to include random slopes for introspection “experience symptoms” question, but the model would not converge.
#create mean centered variables
d$introSpread_c <- d$introSpread - mean(d$introSpread, na.rm = T)
d$introExpSymp_c <- d$introExpSymp - mean(d$introExpSymp, na.rm = T)
m1 <- lmer(partyLikely ~ introC * (introSpread_c + introExpSymp_c) +
( introSpread_c | country_factor ),
data = d
)
summary(m1)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## partyLikely ~ introC * (introSpread_c + introExpSymp_c) + (introSpread_c |
## country_factor)
## Data: d
##
## REML criterion at convergence: 22904.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1230 -0.6286 -0.2441 0.6048 3.4544
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## country_factor (Intercept) 0.18972 0.4356
## introSpread_c 0.05218 0.2284 0.20
## Residual 2.63174 1.6223
## Number of obs: 5999, groups: country_factor, 7
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.76325 0.16615 6.01351 16.631 2.95e-06 ***
## introC -0.18784 0.04198 5981.81606 -4.475 7.78e-06 ***
## introSpread_c -0.30999 0.08832 6.26753 -3.510 0.0118 *
## introExpSymp_c -0.17622 0.01772 5985.20558 -9.947 < 2e-16 ***
## introC:introSpread_c -0.08544 0.03563 5982.10181 -2.398 0.0165 *
## introC:introExpSymp_c 0.02382 0.03509 5981.45433 0.679 0.4972
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) introC intrS_ intES_ inC:S_
## introC 0.001
## introSprd_c 0.197 0.000
## intrExpSym_ 0.000 -0.023 -0.149
## intrC:ntrS_ 0.000 -0.001 0.009 -0.040
## intrC:ntES_ -0.003 -0.001 -0.009 0.047 -0.7461.3.3.1 Model 3a: simple effects for conditions
d$cont0Int1 <- d$introC + .5
d$int0Cont1 <- (d$introC * - 1) + .5 1.3.3.2 Model 3b: simple effects for conditions
m2.simpCont <- lmer(partyLikely ~ cont0Int1 * (introSpread_c + introExpSymp_c) +
(cont0Int1 + introSpread_c + introExpSymp_c || country_factor),
data = d
)
summary(m2.simpCont)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: partyLikely ~ cont0Int1 * (introSpread_c + introExpSymp_c) +
## (cont0Int1 + introSpread_c + introExpSymp_c || country_factor)
## Data: d
##
## REML criterion at convergence: 22900.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1406 -0.6274 -0.2351 0.6050 3.4666
##
## Random effects:
## Groups Name Variance Std.Dev.
## country_factor (Intercept) 0.197651 0.44458
## country_factor.1 cont0Int1 0.001775 0.04213
## country_factor.2 introSpread_c 0.038753 0.19686
## country_factor.3 introExpSymp_c 0.004116 0.06416
## Residual 2.627211 1.62087
## Number of obs: 5999, groups: country_factor, 7
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.85577 0.17082 5.81642 16.718 3.87e-06 ***
## cont0Int1 -0.18755 0.04508 4.63203 -4.161 0.010383 *
## introSpread_c -0.27938 0.07873 6.32609 -3.549 0.011072 *
## introExpSymp_c -0.17489 0.03485 9.25214 -5.018 0.000663 ***
## cont0Int1:introSpread_c -0.07822 0.03575 3982.65179 -2.188 0.028718 *
## cont0Int1:introExpSymp_c 0.01630 0.03519 5541.21246 0.463 0.643181
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cnt0I1 intrS_ intES_ c0I1:S
## cont0Int1 -0.115
## introSprd_c 0.000 0.000
## intrExpSym_ 0.003 -0.012 -0.171
## cnt0Int1:S_ -0.001 0.000 -0.219 0.360
## cnt0In1:ES_ -0.003 0.000 0.162 -0.486 -0.746m2.simpInt <- lmer(partyLikely ~ int0Cont1 * (introSpread_c + introExpSymp_c) +
(int0Cont1 + introSpread_c + introExpSymp_c || country_factor),
data = d
)
summary(m2.simpInt)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: partyLikely ~ int0Cont1 * (introSpread_c + introExpSymp_c) +
## (int0Cont1 + introSpread_c + introExpSymp_c || country_factor)
## Data: d
##
## REML criterion at convergence: 22899.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1388 -0.6309 -0.2391 0.6109 3.4635
##
## Random effects:
## Groups Name Variance Std.Dev.
## country_factor (Intercept) 0.166413 0.40794
## country_factor.1 int0Cont1 0.009630 0.09813
## country_factor.2 introSpread_c 0.038849 0.19710
## country_factor.3 introExpSymp_c 0.004141 0.06435
## Residual 2.626030 1.62050
## Number of obs: 5999, groups: country_factor, 7
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.66801 0.15727 5.93414 16.964 2.97e-06 ***
## int0Cont1 0.18721 0.05650 5.51928 3.314 0.01826 *
## introSpread_c -0.35839 0.07912 6.42022 -4.530 0.00336 **
## introExpSymp_c -0.15784 0.03557 10.11322 -4.438 0.00122 **
## int0Cont1:introSpread_c 0.07883 0.03589 4860.62140 2.197 0.02810 *
## int0Cont1:introExpSymp_c -0.01821 0.03524 5808.11677 -0.517 0.60524
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) int0C1 intrS_ intES_ i0C1:S
## int0Cont1 -0.103
## introSprd_c 0.000 0.000
## intrExpSym_ -0.003 0.008 -0.181
## int0Cnt1:S_ 0.001 0.000 -0.235 0.385
## int0Cn1:ES_ 0.002 0.003 0.176 -0.513 -0.744