Power Analysis
set.seed(123)
N=40
n.trials = 20
n.sim = 10*1000
ps <- future_replicate(n.sim, {
# subjects are assumed to be ~ U(0, 0.5) in a-only speech-in-noise perception
probs = runif(N, min = 0.0, max=0.50)
a_VoiceLeading = rbinom(N, size=n.trials, prob=probs)
a_MouthLeading = rbinom(N, size=n.trials, prob=probs)
# From Rennig et al., the AV benefit is ~ 30%
av_VoiceLeading_probs = probs + 0.2
av_MouthLeading_probs = probs + 0.3
av_VoiceLeading = rbinom(N, size=n.trials, prob=av_VoiceLeading_probs)
av_MouthLeading = rbinom(N, size=n.trials, prob=av_MouthLeading_probs)
# stack all the correct trials together
.correct <- c(a_VoiceLeading,a_MouthLeading, av_VoiceLeading, av_MouthLeading)
# times=4 because there are 4 total conditions
.data <- data.frame(id = rep(1:N, times=4),
lead = rep(c('VoiceLead', 'MouthLead', 'VoiceLead', 'MouthLead'), each=N),
condition=rep(c('A', 'AV'), each=2*N),
correct=.correct,
incorrect=n.trials-.correct)
# run the glmm, get the coef summary, extract the p-value for the interaction term
coef(summary(
glmer(cbind(correct, incorrect) ~ lead*condition + (1|id),
data=.data, family=binomial)
))['leadVoiceLead:conditionAV','Pr(>|z|)']
})
# proportion of simulations with p < 0.05
mean(ps < 0.05)
## [1] 0.7962
Analyze behavioral data
Find subjects that met the minimum accuracy cutoff
# Read in data
subjs <- read.csv('spin_behavior_KarasEtAl.csv')
# Get accuracy in clear AV (the easiest condition) to use as a cutoff
subjs %>% subset((.)$noise == 'N' & (.)$type == 'AV') %>%
do_aggregate(is_correct ~ id, mean) ->
by_subj_corr
accuracy_cutoff = 0.75
keepers <- by_subj_corr %>% subset((.)$is_correct >= accuracy_cutoff, select='id')
good_subjs <- subjs %>% subset((.)$id %in% keepers$id)
Subjects passing 0.75 accuracy criterion: 40 of 46
Accuracy measures for clear and noisy words
# Get the overall accuracy for clear words from the accurate bunch
good_subjs %>% do_aggregate(is_correct ~ noise, mean)
## noise is_correct
## 1 N 0.94875
## 2 Y 0.15375
# first make response_type a factor so that tabulating w/n a subject includes zero tally options
good_subjs$response_type %<>% factor(levels=c('Correct', 'Compatible', 'Incompatible'))
# For the noisy words, we expand the definition of correct to include first-viseme-compatible responses
# counts are needed for the GLMM, note that we are NOT collapsing across word
by_subject_noisy_counts <- good_subjs %>% subset((.)$noise == 'Y') %>%
do_aggregate(response_type ~ type + lead + id + word, table)
by_subject_noisy_counts$correct_or_compatible <- rowSums(by_subject_noisy_counts$response_type[,c('Correct', 'Compatible')])
by_subject_noisy_counts$incompatible <- by_subject_noisy_counts$response_type[,'Incompatible']
# Here we get the proportions for later graphs and descriptive stats
aggregate_noisy_proportions <- good_subjs %>% subset((.)$noise == 'Y') %>%
do_aggregate(response_type ~ type + lead + id, function(x) 100*table(x)/length(x))
aggregate_noisy_proportions$correct_or_compatible <- rowSums(aggregate_noisy_proportions$response_type[,c('Correct', 'Compatible')])
aggregate_noisy_proportions %<>% do_aggregate(correct_or_compatible ~ type + lead, m_se)
aggregate_noisy_proportions
## type lead correct_or_compatible.m correct_or_compatible.se
## 1 A MouthLead 32.375000 5.188707
## 2 AV MouthLead 59.750000 5.485850
## 3 A VoiceLead 77.375000 3.544531
## 4 AV VoiceLead 81.375000 3.476051
Generalized linear mixed model on noisy words
# GLMM on correct+compatible vs. incompatible
# Note: baseline is A:MouthLead b/c of alphabetical ordering of factor levels
glmer.mod <- glmer(cbind(correct_or_compatible, incompatible) ~ type * lead + (1|id) + (1|word),
family=binomial,
data=by_subject_noisy_counts)
print(summary(glmer.mod))
## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: cbind(correct_or_compatible, incompatible) ~ type * lead + (1 |
## id) + (1 | word)
## Data: by_subject_noisy_counts
##
## AIC BIC logLik deviance df.resid
## 2190.1 2212.7 -1089.1 2178.1 314
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -11.688 -1.580 0.331 1.433 7.227
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 2.139 1.462
## word (Intercept) 1.550 1.245
## Number of obs: 320, groups: id, 40; word, 4
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.8838 0.9150 -0.966 0.334
## typeAV 1.5230 0.1244 12.243 < 2e-16 ***
## leadVoiceLead 3.1564 1.2561 2.513 0.012 *
## typeAV:leadVoiceLead -1.1477 0.1963 -5.845 5.06e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) typeAV ldVcLd
## typeAV -0.072
## leadVoiceLd -0.682 0.059
## typAV:ldVcL 0.045 -0.628 -0.079
# put coefficients back into odds-ratio space
exp(coef(summary(glmer.mod))[,1])
## (Intercept) typeAV leadVoiceLead
## 0.4132184 4.5858732 23.4853072
## typeAV:leadVoiceLead
## 0.3173716
Follow-up glmms on each word type
by_subject_noisy_counts %>% split((.)$lead) %>% lapply(function(.data) {
cat('\n-------- Output for', as.character(.data$lead[1]), '--------\n\n')
.mod <- glmer(cbind(correct_or_compatible, incompatible) ~ type + (1|id),
family=binomial,
data=.data)
print(summary(.mod))
round(exp(coef(summary(.mod))[,1]), 1)
})
##
## -------- Output for MouthLead --------
##
## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: cbind(correct_or_compatible, incompatible) ~ type + (1 | id)
## Data: .data
##
## AIC BIC logLik deviance df.resid
## 1169.4 1178.6 -581.7 1163.4 157
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.2677 -1.3077 -0.3268 1.5136 8.1167
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 5.081 2.254
## Number of obs: 160, groups: id, 40
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.0997 0.3744 -2.937 0.00331 **
## typeAV 1.8120 0.1409 12.856 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## typeAV -0.201
##
## -------- Output for VoiceLead --------
##
## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: cbind(correct_or_compatible, incompatible) ~ type + (1 | id)
## Data: .data
##
## AIC BIC logLik deviance df.resid
## 991.1 1000.3 -492.6 985.1 157
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.7094 -1.0023 0.4157 0.8704 3.3272
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 3.47 1.863
## Number of obs: 160, groups: id, 40
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.0241 0.3275 6.180 6.39e-10 ***
## typeAV 0.3267 0.1412 2.314 0.0207 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## typeAV -0.193
## $MouthLead
## (Intercept) typeAV
## 0.3 6.1
##
## $VoiceLead
## (Intercept) typeAV
## 7.6 1.4
Make some graphs
par(mfrow=1:2)
aggregate_noisy_proportions %>% split((.)$lead) %>% lapply(function(.lead) {
xp <- barplot(.lead$correct_or_compatible[,'m'], ylim=c(0,100),
main=.lead$lead[1], ylab='Percent Correct', names.arg = c('A', 'AV'),
col=adjustcolor(.colors, 0.6), las=1, axes=F, border=NA)
draw.axis(2, at=0:2*50)
ebars(xp, .lead$correct_or_compatible, col=.colors, code=0, lwd=2)
})
## $MouthLead
## NULL
##
## $VoiceLead
## NULL