03_prereged_model
anjie
6/2/2022
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.8
## ✓ tidyr 1.2.0 ✓ stringr 1.4.0
## ✓ readr 2.1.2 ✓ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(here)## here() starts at /Users/caoanjie/Desktop/projects/CCRR_analysis/study_2library(lme4)## Loading required package: Matrix##
## Attaching package: 'Matrix'## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpacklibrary(lmerTest)##
## Attaching package: 'lmerTest'## The following object is masked from 'package:lme4':
##
## lmer## The following object is masked from 'package:stats':
##
## steptidy_d <- read_csv(here("data/4_processed/with_human_coded_main.csv"))## Warning: One or more parsing issues, see `problems()` for details## Rows: 41284 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): subject, culture, task_name, task_info, trial_info, resp_type, resp
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Change Detection
Model
Change detection (linear regression): log(reaction_time) ~ culture * type_of_change + (type_of_change | subject) + (culture | picture)
cd_df <- tidy_d %>%
filter(task_name == "CD") %>%
mutate(reaction_time = as.numeric(resp),
type_of_change = task_info,
picture = trial_info) %>%
select(culture, subject,reaction_time,type_of_change, picture) %>%
filter(!is.na(reaction_time))## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion#cd_model <- lmer(log(reaction_time) ~ culture * type_of_change + (type_of_change | subject) + (culture | picture), data = cd_df)
#cd_model <- lmer(log(reaction_time) ~ culture * type_of_change + (type_of_change | subject) , data = cd_df)
cd_model <- lmer(log(reaction_time) ~ culture * type_of_change + (1 | subject) , data = cd_df)
summary(cd_model)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: log(reaction_time) ~ culture * type_of_change + (1 | subject)
## Data: cd_df
##
## REML criterion at convergence: 25977.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.8360 -0.6794 -0.0535 0.6175 4.4740
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.2218 0.4710
## Residual 0.4732 0.6879
## Number of obs: 11857, groups: subject, 468
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 8.796e+00 3.849e-02 5.192e+02 228.513 < 2e-16
## cultureUS 1.001e-01 4.859e-02 5.231e+02 2.060 0.039892
## type_of_changefocal 7.093e-02 2.064e-02 1.142e+04 3.436 0.000592
## cultureUS:type_of_changefocal 3.844e-02 2.628e-02 1.143e+04 1.463 0.143551
##
## (Intercept) ***
## cultureUS *
## type_of_changefocal ***
## cultureUS:type_of_changefocal
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cltrUS typ_f_
## cultureUS -0.792
## typ_f_chngf -0.245 0.194
## cltrUS:ty__ 0.192 -0.246 -0.785Visualization
raw_CD <- tidy_d %>%
filter(task_name == "CD") %>%
mutate(log_rt = log(as.numeric(resp))) ## Warning in mask$eval_all_mutate(quo): NAs introduced by coercionggplot(data = raw_CD,
aes(y = log_rt, x = culture, color = culture)) +
geom_point(alpha = .2, position = position_jitter(width = .1)) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("log RT (ms)") +
xlab("") +
theme_classic() +
labs(title = "Change Detection") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8))+
facet_wrap(~task_info)## Warning: Removed 80 rows containing non-finite values (stat_summary).## Warning: Removed 80 rows containing missing values (geom_point).
Free Description
Model
Free description: (logistic regression) first_mention ~ culture + (1 | subject) + (culture | picture)
mention_df <- tidy_d %>%
filter(task_name == "FD", resp_type == "first_mention_focal") %>%
mutate(first_mention = as.factor(case_when(
resp == "1" ~ "focal",
resp == "0" ~ "background")),
scene = trial_info) %>%
select(-resp, -task_info, -resp_type, -trial_info)
mention_model <- glmer(first_mention ~ culture + (1 | subject)+(culture | scene), family = binomial, data = mention_df)
#mention_model <- glmer(first_mention ~ culture + (1 | subject) ,
# family = binomial, data = mention_df)
mention_model## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: first_mention ~ culture + (1 | subject) + (culture | scene)
## Data: mention_df
## AIC BIC logLik deviance df.resid
## 2082.526 2119.103 -1035.263 2070.526 3276
## Random effects:
## Groups Name Std.Dev. Corr
## subject (Intercept) 1.5592
## scene (Intercept) 1.0659
## cultureUS 0.4595 -0.70
## Number of obs: 3282, groups: subject, 469; scene, 7
## Fixed Effects:
## (Intercept) cultureUS
## 1.117 2.994summary(mention_model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: first_mention ~ culture + (1 | subject) + (culture | scene)
## Data: mention_df
##
## AIC BIC logLik deviance df.resid
## 2082.5 2119.1 -1035.3 2070.5 3276
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.7794 0.0901 0.1366 0.3162 3.2930
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 2.4310 1.5592
## scene (Intercept) 1.1362 1.0659
## cultureUS 0.2112 0.4595 -0.70
## Number of obs: 3282, groups: subject, 469; scene, 7
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.1167 0.4290 2.603 0.00924 **
## cultureUS 2.9942 0.3042 9.843 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cultureUS -0.514summary(mention_model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: first_mention ~ culture + (1 | subject) + (culture | scene)
## Data: mention_df
##
## AIC BIC logLik deviance df.resid
## 2082.5 2119.1 -1035.3 2070.5 3276
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.7794 0.0901 0.1366 0.3162 3.2930
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 2.4310 1.5592
## scene (Intercept) 1.1362 1.0659
## cultureUS 0.2112 0.4595 -0.70
## Number of obs: 3282, groups: subject, 469; scene, 7
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.1167 0.4290 2.603 0.00924 **
## cultureUS 2.9942 0.3042 9.843 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cultureUS -0.514Visualization
FD_raw <- tidy_d %>%
filter(task_name == "FD") %>%
group_by(subject, culture) %>%
summarise(first_mention = mean(as.numeric(resp))) ## `summarise()` has grouped output by 'subject'. You can override using the
## `.groups` argument.FD_raw %>%
ggplot(aes(x = culture, y = first_mention, color = culture)) +
geom_point(alpha = .2, position = position_jitter(width = .1)) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_y_continuous(breaks = seq(0,1,0.5),
labels = {function(x) paste0(as.character(x*100),"%")})+
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("proportion first mention focal") +
xlab("") +
theme_classic() +
labs(title = "Free description") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8))
Causal attribution
Model
Causal attribution (linear regression): rating ~ culture * attribution_type + (attribution_type | subject) + (culture | item)
ca_df <- tidy_d %>%
filter(task_name == "CA") %>%
mutate(attribution_type = task_info,
item = trial_info,
rating = as.numeric(resp)) %>%
select(culture, subject,attribution_type,item, rating)
ca_model <- lmer(rating ~ culture * attribution_type + (attribution_type | subject) + (culture | item), data = ca_df)
summary(ca_model)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ culture * attribution_type + (attribution_type | subject) +
## (culture | item)
## Data: ca_df
##
## REML criterion at convergence: 17076.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.8871 -0.6313 -0.0996 0.5959 3.5181
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 0.94212 0.9706
## attribution_typesituational 1.04324 1.0214 -0.72
## item (Intercept) 0.12027 0.3468
## cultureUS 0.08851 0.2975 0.30
## Residual 1.77337 1.3317
## Number of obs: 4703, groups: subject, 409; item, 12
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 3.16954 0.17526 18.14969 18.085
## cultureUS -0.07967 0.17218 25.45322 -0.463
## attribution_typesituational -0.21294 0.23357 14.34566 -0.912
## cultureUS:attribution_typesituational -1.32982 0.22290 17.96075 -5.966
## Pr(>|t|)
## (Intercept) 4.66e-13 ***
## cultureUS 0.648
## attribution_typesituational 0.377
## cultureUS:attribution_typesituational 1.22e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cltrUS attrb_
## cultureUS -0.180
## attrbtn_typ -0.702 0.086
## cltrUS:ttr_ 0.089 -0.701 -0.077Visualization
raw_CA <- tidy_d %>%
filter(task_name == "CA") %>%
mutate(resp = as.numeric(resp) + 1)
ggplot(data = raw_CA,
aes(y = resp, x = culture, color = culture)) +
geom_point(alpha = .2, position = position_jitter(width = .1)) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("LS rating (1-7)") +
xlab("") +
theme_classic() +
labs(title = "Causal Attribution") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8)) +
facet_wrap(~task_info)## Warning: Removed 361 rows containing non-finite values (stat_summary).## Warning: Removed 361 rows containing missing values (geom_point).
Symbolic Self Inflation
Model
Symbolic self-inflation (linear regression): percent_inflation ~ culture
si_df <- tidy_d %>%
filter(task_name == "SSI") %>%
filter(resp_type == "task_score_ratio") %>%
mutate(score = as.numeric(resp)) %>%
select(-resp, -task_info, -trial_info, -resp_type)
si_model <- glm(score ~ culture, family=gaussian, data = si_df)
si_model##
## Call: glm(formula = score ~ culture, family = gaussian, data = si_df)
##
## Coefficients:
## (Intercept) cultureUS
## 1.4392 -0.1268
##
## Degrees of Freedom: 416 Total (i.e. Null); 415 Residual
## Null Deviance: 142.4
## Residual Deviance: 140.9 AIC: 736.8summary(si_model)##
## Call:
## glm(formula = score ~ culture, family = gaussian, data = si_df)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1877 -0.3675 -0.1396 0.2042 3.1062
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.43921 0.04591 31.345 <2e-16 ***
## cultureUS -0.12678 0.05860 -2.163 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.3394127)
##
## Null deviance: 142.44 on 416 degrees of freedom
## Residual deviance: 140.86 on 415 degrees of freedom
## AIC: 736.81
##
## Number of Fisher Scoring iterations: 2Visualization
SSI_raw <- tidy_d %>%
filter(task_name == "SSI") %>%
mutate(resp = as.numeric(resp))
ggplot(data = SSI_raw %>% filter(resp_type == "task_score_ratio"),
aes(y = resp, x = culture, color = culture)) +
geom_point(aes(y = resp, color = culture),
position = position_jitter(width = .15), size = .5, alpha = 0.8) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("") +
xlab("") +
theme_classic() +
labs(title = "Symbolic Self Inflation") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8)) 
Triads
Model
Taxonomic/thematic similarity task: (logistic regression) choice ~ culture + (1 | subject) + (culture | item)
TD_catch_failed <- tidy_d %>%
filter(task_name == "TD") %>%
filter(task_info == "catch") %>%
filter(resp = FALSE) %>%
pull(subject)
triads_d <- tidy_d %>%
filter(!subject %in% TD_catch_failed) %>%
filter(task_name == "TD") %>%
mutate(choice = as.factor(resp),
item = trial_info) %>%
select(choice, culture, subject, item)
triads_model <- glmer(choice ~ culture + (1 | subject) + (culture | item), family = binomial, data = triads_d)
summary(triads_model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice ~ culture + (1 | subject) + (culture | item)
## Data: triads_d
##
## AIC BIC logLik deviance df.resid
## 6370.2 6412.1 -3179.1 6358.2 7967
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -9.7870 -0.3425 0.1279 0.4031 13.3032
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 3.0046 1.7334
## item (Intercept) 5.5174 2.3489
## cultureUS 0.4674 0.6836 1.00
## Number of obs: 7973, groups: subject, 469; item, 60
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.1052 0.4598 -0.229 0.8191
## cultureUS 1.9036 0.8782 2.168 0.0302 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cultureUS -0.524Visualization
TD_catch_failed <- tidy_d %>%
filter(task_name == "TD") %>%
filter(task_info == "catch") %>%
filter(resp = FALSE) %>%
pull(subject)
TD_raw <- tidy_d %>%
filter(!subject %in% TD_catch_failed) %>%
filter(task_name == "TD") %>%
group_by(subject, culture) %>%
summarise(tax_match = mean(as.logical(resp)))## `summarise()` has grouped output by 'subject'. You can override using the
## `.groups` argument.ggplot(data = TD_raw,
aes(y = tax_match, x = culture, color = culture)) +
geom_point(aes(y = tax_match, color = culture),
position = position_jitter(width = .15), size = .5, alpha = 0.8) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_y_continuous(breaks = seq(0,1,0.5),
labels = {function(x) paste0(as.character(x*100),"%")})+
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("Triads taxonomic match") +
xlab("") +
theme_classic() +
labs(title = "Triads") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8))
Semantic Intuition
Model
Semantic intuition: (logistic regression) choice ~ culture + (1 | subject) + (culture | item)
SeI_df <- tidy_d %>%
filter(task_name == "SeI") %>%
filter(task_info == "critical") %>%
mutate(
choice_causal = case_when(
resp == "causal_historical" ~ TRUE,
resp == "descriptivist" ~ FALSE
)
) %>%
mutate(item = trial_info) %>%
select(choice_causal, culture, subject, item)
#SeI_model <- glmer(choice_causal ~ culture + (1 | subject) + (culture | item), family = binomial, data = SeI_df)
SeI_model <- glmer(choice_causal ~ culture + (1 | subject) , family = binomial, data = SeI_df,
control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
summary(SeI_model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice_causal ~ culture + (1 | subject)
## Data: SeI_df
## Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 1086.3 1100.8 -540.1 1080.3 935
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.2532 -0.4073 0.2405 0.3685 0.9718
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 7.242 2.691
## Number of obs: 938, groups: subject, 469
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.2645 0.2771 0.955 0.34
## cultureUS 1.7941 0.3988 4.499 6.83e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cultureUS -0.636Visualization
SeI_raw <- tidy_d %>%
filter(task_name == "SeI") %>%
filter(task_info == "critical") %>%
mutate(causal_historical_choice = case_when(
resp == "causal_historical" ~ TRUE,
resp == "descriptivist" ~ FALSE
)) %>%
group_by(subject, culture) %>%
summarise(causal_historical_resp = mean(causal_historical_choice))## `summarise()` has grouped output by 'subject'. You can override using the
## `.groups` argument.ggplot(data = SeI_raw,
aes(y = causal_historical_resp, x = culture, color = culture)) +
geom_point(aes(y = causal_historical_resp, color = culture),
position = position_jitter(width = .15), size = .5, alpha = 0.8) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_y_continuous(breaks = seq(0,1,0.5),
labels = {function(x) paste0(as.character(x*100),"%")})+
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("Causal Historical Choice") +
xlab("") +
theme_classic() +
labs(title = "Semantic Intuition") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8))
Ambiguous RMTS
Model
Ambiguous RMTS (logistic regression): choice ~ culture + (trial_num | subject)
rmts_df <- tidy_d %>%
filter(task_name == "RMTS") %>%
mutate(choice = as.factor(case_when(
resp == "1" ~ "rel",
resp == "0" ~ "obj"))
) %>%
group_by(subject) %>%
mutate(trial_num = as.factor(row_number())) %>%
select(-resp, -task_info, -trial_info, -resp_type)
# model 0: not converging
#rmts_model <- glmer(choice ~ culture + (trial_num | subject), family = binomial, data = rmts_df)
# model 1:
rmts_model <- glmer(choice ~ culture + (1 | subject), family = binomial, data = rmts_df)
#rmts_model
summary(rmts_model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice ~ culture + (1 | subject)
## Data: rmts_df
##
## AIC BIC logLik deviance df.resid
## 1721.6 1738.2 -857.8 1715.6 1873
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.6016 -0.1880 -0.1848 0.2487 1.7378
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 16.58 4.071
## Number of obs: 1876, groups: subject, 469
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.1874 0.3890 -3.052 0.00227 **
## cultureUS 0.1067 0.4842 0.220 0.82562
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cultureUS -0.770Visualization
RMTS_raw <- tidy_d %>%
filter(task_name == "RMTS") %>%
group_by(subject, culture) %>%
summarise(relational_choice = mean(as.numeric(resp)))## `summarise()` has grouped output by 'subject'. You can override using the
## `.groups` argument.ggplot(data = RMTS_raw,
aes(y = relational_choice, x = culture, color = culture)) +
geom_point(aes(y = relational_choice, color = culture),
position = position_jitter(width = .15), size = .5, alpha = 0.8) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_y_continuous(breaks = seq(0,1,0.5),
labels = {function(x) paste0(as.character(x*100),"%")})+
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("Proportion relational choice") +
xlab("") +
theme_classic() +
labs(title = "Ambiguous RMTS") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8))
Ravens
Model
Raven (logistic regression): acc ~ culture + (1 | subject) + (1 | trial)
rv_df <- tidy_d %>%
filter(task_name == "RV") %>%
mutate(acc = as.numeric(resp)) %>%
group_by(subject) %>%
mutate(trial = as.factor(row_number())) %>%
select(-resp, -task_info, -trial_info, -resp_type)
rv_model <- glmer(acc ~ culture + (1 | subject) + (culture | trial), family = binomial, data = rv_df)
rv_model## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: acc ~ culture + (1 | subject) + (culture | trial)
## Data: rv_df
## AIC BIC logLik deviance df.resid
## 5470.205 5510.018 -2729.103 5458.205 5622
## Random effects:
## Groups Name Std.Dev. Corr
## subject (Intercept) 1.689
## trial (Intercept) 1.336
## cultureUS 0.568 -0.11
## Number of obs: 5628, groups: subject, 469; trial, 12
## Fixed Effects:
## (Intercept) cultureUS
## 1.734 -1.786summary(rv_model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: acc ~ culture + (1 | subject) + (culture | trial)
## Data: rv_df
##
## AIC BIC logLik deviance df.resid
## 5470.2 5510.0 -2729.1 5458.2 5622
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -8.2272 -0.4963 0.1863 0.4771 10.8082
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 2.8515 1.689
## trial (Intercept) 1.7855 1.336
## cultureUS 0.3226 0.568 -0.11
## Number of obs: 5628, groups: subject, 469; trial, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.7343 0.4140 4.189 2.80e-05 ***
## cultureUS -1.7862 0.2472 -7.226 4.99e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cultureUS -0.290Visualization
RV_raw <- tidy_d %>%
filter(task_name == "RV") %>%
group_by(subject, culture) %>%
summarise(RV_resp = mean(as.numeric(resp)))## `summarise()` has grouped output by 'subject'. You can override using the
## `.groups` argument.ggplot(data = RV_raw,
aes(y = RV_resp, x = culture, color = culture)) +
geom_point(aes(y = RV_resp, color = culture),
position = position_jitter(width = .15), size = .5, alpha = 0.8) +
stat_summary(fun.data = "mean_cl_boot", color = "black") +
scale_y_continuous(breaks = seq(0,1,0.5),
labels = {function(x) paste0(as.character(x*100),"%")})+
scale_color_manual(values = c("red", "blue"))+
scale_fill_manual(values = c("red", "blue"))+
guides(fill = "none") +
guides(color = "none") +
ylab("Ravens proportion correct") +
xlab("") +
theme_classic() +
labs(title = "Ravens") +
theme(plot.title = element_text(hjust = 0.5, size = 8),
plot.subtitle = element_text(hjust = 0.5, size = 6),
text = element_text(size=8))