Code
cat('\014') # clean terminalCode
rm(list = ls()) # clean workspace
library(tidyverse)
library(afex)
library(emmeans)
library(psych)
library(performance)Common Humanity & Mindfulness 2023
Common Humanity questionnaires
Code
options(mc_doScale_quiet = TRUE)
theme_set(
theme_minimal()
)Code
first_day <- as.Date('2023/11/10')
xcluded <- c('d20', 'd21', 'd26', 'd33')
df_age <- read_csv('data/df_age_2023_data_clean.csv', col_types = cols()) |>
mutate_if(is.character, as.factor)
df_humanity <- read_csv('gsheets/HC.csv', col_types = cols()) |>
rename(Subject = `Código de participante:`) |>
mutate(Subject = replace(Subject, Subject == 'd06_s11_t01_m' & `Sesión:` == 'Después', 'd06_s11_t02_m')) |>
mutate(Subject = replace(Subject, Subject == 'd14_s27_t01_m' & `Sesión:` == 'Después', 'd14_s27_t02_m')) |>
mutate(Subject = replace(Subject, Subject == 'd17_s34_t02_f' & str_detect(`Marca temporal`, '2024/01/19 11:24:04 a.m.'), 'd17_s33_t02_f')) |>
mutate(Subject = replace(Subject, Subject == 'd19_s37_t01_m' & `Sesión:` == 'Después', 'd19_s37_t02_m')) |>
mutate(Subject = replace(Subject, Subject == 'd19_s38_t01_m' & `Sesión:` == 'Después', 'd19_s38_t02_m')) |>
mutate(Subject = replace(Subject, Subject == 'd21_s42_t01_f' & `Sesión:` == 'Después', 'd21_s42_t02_f')) |>
mutate(Subject = replace(Subject, Subject == 'd24_s46_t01_f' , 'd24_s47_t01_f')) |>
mutate(Subject = replace(Subject, Subject == 'd25_s49_test01_f', 'd25_s49_t01_f')) |>
mutate(Subject = replace(Subject, Subject == 'd28_s57_t01_m' , 'd29_s57_t01_m')) |>
mutate(Subject = replace(Subject, Subject == 'd28_s58_t01_m' , 'd29_s58_t01_m')) |>
mutate(Subject = replace(Subject, Subject == 'd32_64_t01_f' , 'd32_s64_t01_f')) |>
mutate(the_day = as.Date(word(`Marca temporal`, 1))) |>
filter(grepl('d[0-9]{2}_s.*', Subject) & the_day >= first_day) |>
separate(Subject, c('duo', 'id', 'session', 'sex'), sep = '_', remove = FALSE) |>
mutate(sex = if_else(sex == 'f', 'female', 'male')) |>
filter(!(duo %in% xcluded)) |>
left_join(y = df_age[c('id', 'group', 'age')], by = 'id') |>
mutate(duo = ifelse(id %in% c('s57', 's58'), 'd29', duo)) |>
mutate(p1 = recode(`En relación a tu compañero(a) que conoces poco:`,
'Creo que somos muy diferentes en todo o casi todo' = 0,
'Aunque no lo(a) conozco mucho, me imagino que debemos compartir algunos intereses o gustos' = 1,
'Aunque tengamos diferentes intereses o gustos, compartimos sentimientos y experiencias comunes a todos los seres humanos' = 2
)) |>
mutate(p2 = recode(`Si comparas tus amigos(as) con los de tu compañero(a) que conoces poco:`,
'Tenemos amigos(as) totalmente diferentes' = 0,
'Creo que entre sus amigos y mis amigos(as) podemos tener algunos gustos o intereses similares y otros distintos' = 1,
'Creo que, pese a que tenemos amigos(as) diferentes o con intereses distintos, ambos queremos tener buenos amigos(as)' = 2
)) |>
mutate(p3 = recode(`Si comparas el trato que tú mereces con el trato que merece tu compañero(a) que conoces poco:`,
'No se merece el mismo trato que yo' = 0,
'Ambos(as) somos personas que merecemos ser tratados con respeto y dignidad, excepto si hemos sido malo/a con otros' = 1,
'Ambos(as) somos personas que merecemos ser tratados con respeto y dignidad, no importa las acciones que realicemos' = 2
)) |>
mutate(p4 = recode(`Si comparas la felicidad que tú y tu compañero(a) que conoces poco merecen:`,
'No merece ser igual de feliz que yo' = 0,
'Creo que ambos merecemos ser felices y no sufrir, sólo si somos buenos/as con otros' = 1,
'Creo que ambos merecemos ser felices y no sufrir, independiente de nuestras acciones' = 2
)) |>
mutate(p5 = recode(`Si comparas tus ganas de ser bueno(a) en algo y las de tu compañero(a) que conoces poco:`,
'Mis ganas son totalmente diferentes a las de él o ella' = 0,
'A pesar de que nuestras ganas de ser buenos en algo sean similares, lo realmente importante son los talentos que cada uno tiene o no tiene' = 1,
'Ambos queremos y merecemos sentirnos buenos en algo' = 2
)) |>
mutate(p6 = recode(`En relación a lo que los diferencia a ti y a tu compañero(a) que conoces poco:`,
'Creo que somos muy diferentes en todo' = 0,
'Tenemos diferentes gustos o intereses, pero probablemente también tenemos gustos o intereses comunes' = 1,
'Las diferencias que tenemos no son tan importantes como los aspectos que tenemos en común' = 2
)) |>
mutate(p7 = recode(`Siguiendo con las diferencias que tienes con tu compañero(a) que conoces poco:`,
'Creo que nuestras diferencias nos separan y nada que hacer, somos demasiado distintos(as)' = 0,
'Creo que nuestras diferencias lamentablemente nos separan' = 0,
'Me parece bien que seamos diferentes, podemos convivir así sin problemas' = 1,
'Valoro nuestras diferencias, creo que puedo aprender de ellas' = 2
)) |>
mutate(p8 = recode(`En relación a los aspectos en que somos semejantes con el compañero(a) que conocemos poco:`,
'Creo que si no tenemos nada en común es difícil ser amigos(as) o pasar tiempo juntos(as)' = 0,
'Creo que con todas las personas podemos tener algún interés o gusto parecido que nos permita compartir en algún momento' = 1,
'Siento que lo que compartimos va más allá de nosotros(as), más allá de nuestros gustos o intereses y nos hace ser parte de algo más grande' = 2
)) |>
mutate(humanity_score = p1 + p2 + p3 + p4 + p5 + p6 + p7 + p8) |>
mutate_if(is.character, as.factor)
write_csv(df_humanity, 'data/df_humanity_2023_data_clean.csv')General description
Code
questions <- c('p1', 'p2', 'p3', 'p4', 'p5', 'p6', 'p7', 'p8')
summary(df_humanity[c('Subject', 'duo', 'id', 'session', 'sex', 'group', questions, 'humanity_score')]) Subject duo id session sex
d01_s01_t01_m: 1 d01 : 4 s01 : 2 t01:64 female:64
d01_s01_t02_m: 1 d02 : 4 s02 : 2 t02:64 male :64
d01_s02_t01_m: 1 d03 : 4 s03 : 2
d01_s02_t02_m: 1 d04 : 4 s04 : 2
d02_s03_t01_m: 1 d05 : 4 s05 : 2
d02_s03_t02_m: 1 d06 : 4 s06 : 2
(Other) :122 (Other):104 (Other):116
group p1 p2 p3
humanity :64 Min. :0.000 Min. :0.000 Min. :1.000
mindfulness:64 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
Median :1.000 Median :2.000 Median :2.000
Mean :1.453 Mean :1.633 Mean :1.742
3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:2.000
Max. :2.000 Max. :2.000 Max. :2.000
p4 p5 p6 p7
Min. :1.000 Min. :0.000 Min. :0.000 Min. :0.000
1st Qu.:1.000 1st Qu.:2.000 1st Qu.:1.000 1st Qu.:1.000
Median :2.000 Median :2.000 Median :1.000 Median :2.000
Mean :1.688 Mean :1.727 Mean :1.164 Mean :1.578
3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:1.000 3rd Qu.:2.000
Max. :2.000 Max. :2.000 Max. :2.000 Max. :2.000
p8 humanity_score
Min. :0.000 Min. : 5.00
1st Qu.:1.000 1st Qu.:11.00
Median :1.000 Median :12.00
Mean :1.305 Mean :12.29
3rd Qu.:2.000 3rd Qu.:14.00
Max. :2.000 Max. :16.00
Reliability Pre
Code
poly_pre <- df_humanity |>
filter(session == 't01') |>
select(all_of(questions)) |>
polychoric()
splitHalf(poly_pre$rho, check.keys = FALSE)Split half reliabilities
Call: splitHalf(r = poly_pre$rho, check.keys = FALSE)
Maximum split half reliability (lambda 4) = 0.8
Guttman lambda 6 = 0.65
Average split half reliability = 0.5
Guttman lambda 3 (alpha) = 0.5
Guttman lambda 2 = 0.57
Minimum split half reliability (beta) = 0.17
Average interitem r = 0.11 with median = 0.1Code
alpha(poly_pre$rho)Warning in alpha(poly_pre$rho): Some items were negatively correlated with the first principal component and probably
should be reversed.
To do this, run the function again with the 'check.keys=TRUE' optionSome items ( p6 ) were negatively correlated with the first principal component and
probably should be reversed.
To do this, run the function again with the 'check.keys=TRUE' option
Reliability analysis
Call: alpha(x = poly_pre$rho)
raw_alpha std.alpha G6(smc) average_r S/N median_r
0.5 0.5 0.65 0.11 0.99 0.1
95% confidence boundaries
lower alpha upper
Feldt -0.28 0.5 0.88
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N var.r med.r
p1 0.46 0.46 0.60 0.107 0.84 0.055 0.111
p2 0.43 0.43 0.60 0.097 0.75 0.047 0.075
p3 0.46 0.46 0.55 0.107 0.84 0.041 0.129
p4 0.37 0.37 0.46 0.078 0.59 0.031 0.075
p5 0.51 0.51 0.65 0.129 1.04 0.053 0.116
p6 0.59 0.59 0.70 0.171 1.44 0.038 0.129
p7 0.45 0.45 0.61 0.106 0.83 0.055 0.075
p8 0.40 0.40 0.55 0.088 0.68 0.039 0.071
Item statistics
r r.cor r.drop
p1 0.49 0.38 0.25
p2 0.54 0.45 0.32
p3 0.49 0.48 0.25
p4 0.65 0.71 0.45
p5 0.37 0.20 0.11
p6 0.13 -0.11 -0.13
p7 0.50 0.37 0.26
p8 0.60 0.58 0.38Reliability Post
Code
poly_post <- df_humanity |>
filter(session == 't02') |>
select(all_of(questions)) |>
polychoric()Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
doneCode
splitHalf(poly_post$rho, check.keys = FALSE)In smc, smcs < 0 were set to .0Split half reliabilities
Call: splitHalf(r = poly_post$rho, check.keys = FALSE)
Maximum split half reliability (lambda 4) = 0.96
Guttman lambda 6 = 0.51
Average split half reliability = 0.46
Guttman lambda 3 (alpha) = 0.43
Guttman lambda 2 = 0.59
Minimum split half reliability (beta) = 0.03
Average interitem r = 0.09 with median = 0.06Code
alpha(poly_post$rho)Warning in alpha(poly_post$rho): Some items were negatively correlated with the first principal component and probably
should be reversed.
To do this, run the function again with the 'check.keys=TRUE' optionSome items ( p3 p4 ) were negatively correlated with the first principal component and
probably should be reversed.
To do this, run the function again with the 'check.keys=TRUE' optionIn smc, smcs < 0 were set to .0
In smc, smcs < 0 were set to .0
Reliability analysis
Call: alpha(x = poly_post$rho)
raw_alpha std.alpha G6(smc) average_r S/N median_r
0.43 0.43 0.51 0.086 0.75 0.056
95% confidence boundaries
lower alpha upper
Feldt -0.46 0.43 0.87
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N var.r med.r
p1 0.26 0.26 0.64 0.047 0.34 0.087 0.045
p2 0.29 0.29 0.64 0.055 0.41 0.117 0.042
p3 0.54 0.54 0.86 0.146 1.19 0.087 0.102
p4 0.52 0.52 0.73 0.133 1.08 0.097 0.074
p5 0.44 0.44 0.81 0.100 0.78 0.145 0.068
p6 0.42 0.42 0.78 0.094 0.73 0.129 0.042
p7 0.32 0.32 0.83 0.064 0.48 0.111 0.045
p8 0.27 0.27 0.71 0.049 0.36 0.132 0.030
Item statistics
r r.cor r.drop
p1 0.678 0.725 0.477
p2 0.630 0.505 0.411
p3 0.097 -0.049 -0.180
p4 0.171 -0.046 -0.109
p5 0.364 0.119 0.091
p6 0.398 0.168 0.129
p7 0.578 0.537 0.344
p8 0.664 0.588 0.457Common Humanity Score
Code
humanity_score_lmer <- lmer(humanity_score ~ group*sex*session+age + (1|duo:id), df_humanity)
afex_plot(
humanity_score_lmer,
id = 'id',
x = 'session',
trace = 'group',
panel = 'sex',
# error = 'within',
error_arg = list(width = .4, lwd = .75),
dodge = .3,
data_arg = list(
position =
position_jitterdodge(
jitter.width = .2,
jitter.height = .1,
dodge.width = .3 ## needs to be same as dodge
)),
mapping = c('color'),
point_arg = list(size = 3)
)
Code
options(width = 100)
summary(humanity_score_lmer)Linear mixed model fit by REML. t-tests use Satterthwaite's method ['lmerModLmerTest']
Formula: humanity_score ~ group * sex * session + age + (1 | duo:id)
Data: df_humanity
REML criterion at convergence: 498.3
Scaled residuals:
Min 1Q Median 3Q Max
-3.3858 -0.4645 -0.0006 0.4961 2.1223
Random effects:
Groups Name Variance Std.Dev.
duo:id (Intercept) 2.002 1.415
Residual 1.608 1.268
Number of obs: 128, groups: duo:id, 64
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 10.37173 1.05745 64.54170 9.808 2.06e-14 ***
groupmindfulness 0.33005 0.69057 88.50518 0.478 0.6339
sexmale 0.19572 0.67181 90.34925 0.291 0.7715
sessiont02 1.12500 0.44830 60.00000 2.509 0.0148 *
age 0.04386 0.04130 59.00000 1.062 0.2926
groupmindfulness:sexmale -0.02029 0.96298 89.43363 -0.021 0.9832
groupmindfulness:sessiont02 0.50000 0.63400 60.00000 0.789 0.4334
sexmale:sessiont02 0.56250 0.63400 60.00000 0.887 0.3785
groupmindfulness:sexmale:sessiont02 -1.68750 0.89661 60.00000 -1.882 0.0647 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) grpmnd sexmal sssn02 age grpmn: grp:02 sxm:02
grpmndflnss -0.102
sexmale -0.328 0.484
sessiont02 -0.212 0.325 0.334
age -0.893 -0.232 0.012 0.000
grpmndflns: 0.075 -0.716 -0.696 -0.233 0.164
grpmndfl:02 0.150 -0.459 -0.236 -0.707 0.000 0.329
sxml:sssn02 0.150 -0.230 -0.472 -0.707 0.000 0.329 0.500
grpmndf::02 -0.106 0.325 0.334 0.500 0.000 -0.466 -0.707 -0.707Code
cat(rep('_', 100), '\n', sep = '')____________________________________________________________________________________________________Code
anova(humanity_score_lmer)Type III Analysis of Variance Table with Satterthwaite's method
Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
group 0.194 0.194 1 59 0.1204 0.72984
sex 0.018 0.018 1 59 0.0111 0.91663
session 48.758 48.758 1 60 30.3256 8.042e-07 ***
age 1.813 1.813 1 59 1.1277 0.29259
group:sex 1.653 1.653 1 59 1.0278 0.31481
group:session 0.945 0.945 1 60 0.5879 0.44622
sex:session 0.633 0.633 1 60 0.3936 0.53280
group:sex:session 5.695 5.695 1 60 3.5423 0.06468 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Code
cat(rep('_', 100), '\n', sep = '')____________________________________________________________________________________________________Code
emmeans(humanity_score_lmer, pairwise ~ session)NOTE: Results may be misleading due to involvement in interactions$emmeans
session emmean SE df lower.CL upper.CL
t01 11.7 0.238 90.3 11.2 12.1
t02 12.9 0.238 90.3 12.4 13.4
Results are averaged over the levels of: group, sex
Degrees-of-freedom method: kenward-roger
Confidence level used: 0.95
$contrasts
contrast estimate SE df t.ratio p.value
t01 - t02 -1.23 0.224 60 -5.507 <.0001
Results are averaged over the levels of: group, sex
Degrees-of-freedom method: kenward-roger Code
cat(rep('_', 100), '\n', sep = '')____________________________________________________________________________________________________Code
emmeans(humanity_score_lmer, pairwise ~ session|sex*group)$emmeans
sex = female, group = humanity:
session emmean SE df lower.CL upper.CL
t01 11.4 0.476 90.2 10.5 12.4
t02 12.5 0.476 90.2 11.6 13.5
sex = male, group = humanity:
session emmean SE df lower.CL upper.CL
t01 11.6 0.477 90.0 10.7 12.6
t02 13.3 0.477 90.0 12.3 14.2
sex = female, group = mindfulness:
session emmean SE df lower.CL upper.CL
t01 11.7 0.491 88.2 10.8 12.7
t02 13.4 0.491 88.2 12.4 14.3
sex = male, group = mindfulness:
session emmean SE df lower.CL upper.CL
t01 11.9 0.477 90.1 11.0 12.9
t02 12.4 0.477 90.1 11.5 13.4
Degrees-of-freedom method: kenward-roger
Confidence level used: 0.95
$contrasts
sex = female, group = humanity:
contrast estimate SE df t.ratio p.value
t01 - t02 -1.12 0.448 60 -2.509 0.0148
sex = male, group = humanity:
contrast estimate SE df t.ratio p.value
t01 - t02 -1.69 0.448 60 -3.764 0.0004
sex = female, group = mindfulness:
contrast estimate SE df t.ratio p.value
t01 - t02 -1.62 0.448 60 -3.625 0.0006
sex = male, group = mindfulness:
contrast estimate SE df t.ratio p.value
t01 - t02 -0.50 0.448 60 -1.115 0.2692
Degrees-of-freedom method: kenward-roger Code
check_model(humanity_score_lmer)