RA102824
Trina Chou
Data Set-Up
Importing
data <- read_xlsx("~/Desktop/UTK/Tanner Lab/Fall 2024 - RA/R/Data.xlsx")
# One line for each trial, with latency and speakers that "won" and "lost"
realized <- read_xlsx("~/Desktop/UTK/Tanner Lab/Fall 2024 - RA/R/TC_Realized_Values.xlsx")
# each speaker's realized CR, CV, and scores
format2 <- read_xlsx("~/Desktop/UTK/Tanner Lab/Fall 2024 - RA/R/TC_NSF_Format2.xlsx")
# One line for each speaker, with their associated data + realized CR and CV. Labeled as whether they "won" or "lost", and later in this script "chosen" v "not chosen"
no.choice <- read_csv("~/Desktop/UTK/Tanner Lab/Fall 2024 - RA/R/10102024_no_choice_females_edited.csv")## Rows: 43 Columns: 23
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): FemaleID, Choice_ID, W_Identity, L_Identity, L2_Identity, L3_Ident...
## dbl (12): StimulusSet, SetOrder, Trial_ID, NumStimuli, W_Speaker, L_Speaker,...
## lgl (1): Latency
##
## ℹ 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.# identities of females who didn't choose
no.choice.identities <- read_xlsx("~/Desktop/UTK/Tanner Lab/Fall 2024 - RA/R/101024_no_choice_speaker_identities.xlsx")Type 1
Type 2
Cleaning up Type 1 & 2
final <- final %>%
mutate(best = pmax(W_Score, L_Score, L2_Score, L3_Score, L4_Score, L5_Score, L6_Score, L7_Score,
na.rm = TRUE))
final <- final %>%
mutate(correct = case_when(best == W_Score ~ 'Correct',
best != W_Score ~ 'Incorrect'))final <- as.data.frame(final)
final_type2 <- as.data.frame(final_type2)
final$NumStimuli <- as.factor(final$NumStimuli)
final <- final %>% mutate(LogLatency = log(Latency))
final <- final %>% mutate(Correct = case_when(correct == 'Correct' ~ 1,
correct == 'Incorrect' ~ 0))
final_type2 <- final_type2 %>% mutate(Chosen = case_when(Choice == 'W' ~ 'Chosen',
Choice != 'W' ~ 'Not_Chosen'))Subsetting
dat2 <- final %>% filter(NumStimuli == '2')
dat4 <- final %>% filter(NumStimuli == '4')
dat8 <- final %>% filter(NumStimuli == '8')
dat2_type2 <- final_type2 %>% filter(NumStimuli == '2')
dat4_type2 <- final_type2 %>% filter(NumStimuli == '4')
dat8_type2 <- final_type2 %>% filter(NumStimuli == '8')Getting second bests for 2, 4, and 8 choice tests
2-choice
dat2_type3 <- dat2_type2 %>% group_by(Trial_ID) %>%
summarize(maxscore = max(Score),
secondscore = min(Score),
maxCR = max(CR_Z),
secondCR = min(CR_Z),
maxCV = max(CV_Z),
secondCV = min(CV_Z))
dat2_type3 <- as.data.frame(dat2_type3)
dat2_type3 <- dat2_type3 %>% mutate(CRdif = maxCR - secondCR)
dat2_type3 <- dat2_type3 %>% mutate(CVdif = maxCV - secondCV)
dat2_type3 <- dat2_type3 %>% mutate(scoredif = maxscore - secondscore)
dat2_type_1_3 <- left_join(dat2,dat2_type3,
by = join_by(Trial_ID == Trial_ID)
)
dat2_type_1_3_na <- subset(dat2_type_1_3, (!is.na(dat2_type_1_3[,7])))4-choice
dat4_type3 <- dat4_type2 %>% group_by(Trial_ID) %>%
summarize(maxscore = max(Score),
secondscore = nth(Score, 3, order_by = Score),
thirdscore = nth(Score, 2, order_by = Score),
worstscore = nth(Score, 1, order_by = Score),
maxCR = max(CR_Z),
secondCR = nth(CR_Z, 3, order_by = CR_Z),
thirdCR = nth(CR_Z, 2, order_by = CR_Z),
worstCR = nth(CR_Z, 1, order_by = CR_Z),
maxCV = max(CV_Z),
secondCV = nth(CV_Z, 3, order_by = CV_Z),
thirdCV = nth(CV_Z, 2, order_by = CV_Z),
worstCV = nth(CV_Z, 1, order_by = CV_Z),
)
dat4_type3 <- as.data.frame(dat4_type3)
dat4_type3 <- dat4_type3 %>% mutate(CRdif = maxCR - secondCR)
dat4_type3 <- dat4_type3 %>% mutate(CVdif = maxCV - secondCV)
dat4_type3 <- dat4_type3 %>% mutate(scoredif = maxscore - secondscore)
dat4_type_1_3 <- left_join(dat4,dat4_type3,
by = join_by(Trial_ID == Trial_ID)
)
dat4_type_1_3_na <- subset(dat4_type_1_3, (!is.na(dat4_type_1_3[,7])))8-choice
dat8_type3 <- dat8_type2 %>% group_by(Trial_ID) %>%
summarize(maxscore = max(Score),
secondscore = nth(Score, 7, order_by = Score),
thirdscore = nth(Score, 6, order_by = Score),
fourthscore = nth(Score, 5, order_by = Score),
fifthscore = nth(Score, 4, order_by = Score),
sixthscore = nth(Score, 3, order_by = Score),
seventhscore = nth(Score, 2, order_by = Score),
worstscore = nth(Score, 1, order_by = Score),
maxCR = max(CR_Z),
secondCR = nth(CR_Z, 7, order_by = CR_Z),
thirdCR = nth(CR_Z, 6, order_by = CR_Z),
fourthCR = nth(CR_Z, 5, order_by = CR_Z),
fifthCR = nth(CR_Z, 4, order_by = CR_Z),
sixthCR = nth(CR_Z, 3, order_by = CR_Z),
seventhCR = nth(CR_Z, 2, order_by = CR_Z),
worstCR = nth(CR_Z, 1, order_by = CR_Z),
maxCV = max(CV_Z),
secondCV = nth(CV_Z, 7, order_by = CV_Z),
thirdCV = nth(CV_Z, 6, order_by = CV_Z),
fourthCV = nth(CV_Z, 5, order_by = CV_Z),
fifthCV = nth(CV_Z, 4, order_by = CV_Z),
sixthCV = nth(CV_Z, 3, order_by = CV_Z),
seventhCV = nth(CV_Z, 2, order_by = CV_Z),
worstCV = nth(CV_Z, 1, order_by = CV_Z),
)
dat8_type3 <- as.data.frame(dat8_type3)
dat8_type3 <- dat8_type3 %>% mutate(CRdif = maxCR - secondCR)
dat8_type3 <- dat8_type3 %>% mutate(CVdif = maxCV - secondCV)
dat8_type3 <- dat8_type3 %>% mutate(scoredif = maxscore - secondscore)
dat8_type_1_3 <- left_join(dat8,dat8_type3,
by = join_by(Trial_ID == Trial_ID)
)
dat8_type_1_3_na <- subset(dat8_type_1_3, (!is.na(dat8_type_1_3[,7])))Choice Dataset
choice <- final %>% filter(!is.na(Latency))No Choice Dataset
nochoice1 <- left_join(no.choice,no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(W_Identity == Identity)
)
nochoice1 <- nochoice1 %>% rename(W_CR = CR,
W_CVw = CVw,
W_CR_Z = CR_Z,
W_CV_Z = CV_Z,
W_Score = Score)
nochoice2 <- left_join(nochoice1, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L_Identity == Identity)
)
nochoice2 <- nochoice2 %>% rename(L_CR = CR,
L_CVw = CVw,
L_CR_Z = CR_Z,
L_CV_Z = CV_Z,
L_Score = Score)
nochoice3 <- left_join(nochoice2, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L2_Identity == Identity)
)
nochoice3 <- nochoice3 %>% rename(L2_CR = CR,
L2_CVw = CVw,
L2_CR_Z = CR_Z,
L2_CV_Z = CV_Z,
L2_Score = Score)
nochoice4 <- left_join(nochoice3, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L3_Identity == Identity)
)
nochoice4 <- nochoice4 %>% rename(L3_CR = CR,
L3_CVw = CVw,
L3_CR_Z = CR_Z,
L3_CV_Z = CV_Z,
L3_Score = Score)
nochoice5 <- left_join(nochoice4, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L4_Identity == Identity)
)
nochoice5 <- nochoice5 %>% rename(L4_CR = CR,
L4_CVw = CVw,
L4_CR_Z = CR_Z,
L4_CV_Z = CV_Z,
L4_Score = Score)
nochoice6 <- left_join(nochoice5, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L5_Identity == Identity)
)
nochoice6 <- nochoice6 %>% rename(L5_CR = CR,
L5_CVw = CVw,
L5_CR_Z = CR_Z,
L5_CV_Z = CV_Z,
L5_Score = Score)
nochoice7 <- left_join(nochoice6, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L6_Identity == Identity)
)
nochoice7 <- nochoice7 %>% rename(L6_CR = CR,
L6_CVw = CVw,
L6_CR_Z = CR_Z,
L6_CV_Z = CV_Z,
L6_Score = Score)
nochoicefinal <- left_join(nochoice7, no.choice.identities[ , c("Identity", "CR", "CVw", "CR_Z", "CV_Z", "Score")],
by = join_by(L7_Identity == Identity)
)
nochoicefinal <- nochoicefinal %>% rename(L7_CR = CR,
L7_CVw = CVw,
L7_CR_Z = CR_Z,
L7_CV_Z = CV_Z,
L7_Score = Score)nochoiceidentities.test <- no.choice.identities %>% group_by(Trial_ID) %>%
summarize(maxscore = max(Score),
secondscore = nth(Score, 6, order_by = Score),
thirdscore = nth(Score, 5, order_by = Score),
fourthscore = nth(Score, 4, order_by = Score),
fifthscore = nth(Score, 3, order_by = Score),
sixthscore = nth(Score, 2, order_by = Score),
worstscore = nth(Score, 1, order_by = Score),
maxCR = max(CR),
secondCR = nth(CR, 6, order_by = CR),
thirdCR = nth(CR, 5, order_by = CR),
fourthCR = nth(CR, 4, order_by = CR),
fifthCR = nth(CR, 3, order_by = CR),
sixthCR = nth(CR, 2, order_by = CR),
worstCR = nth(CR, 1, order_by = CR),
maxCV = max(CVw),
secondCV = nth(CVw, 6, order_by = CVw),
thirdCV = nth(CVw, 5, order_by = CVw),
fourthCV = nth(CVw, 4, order_by = CVw),
fifthCV = nth(CVw, 3, order_by = CVw),
sixthCV = nth(CVw, 2, order_by = CVw),
worstCV = nth(CVw, 1, order_by = CVw),
)
nochoiceidentities.test <- as.data.frame(nochoiceidentities.test)
nochoicefinalfinal <- left_join(nochoicefinal,nochoiceidentities.test,
by = join_by(Trial_ID == Trial_ID)
)
nochoicefinalfinal <- nochoicefinalfinal %>% mutate(CRdif = maxCR-secondCR)
nochoicefinalfinal <- nochoicefinalfinal %>% mutate(CVdif = maxCV-secondCV)
nochoicefinalfinal <- nochoicefinalfinal %>% mutate(scoredif = maxscore-secondscore)Combining Datasets
full.cleaned.data <- bind_rows(dat8_type_1_3_na, dat4_type_1_3_na, dat2_type_1_3_na, .id = NULL)
test.dataset <- plyr::rbind.fill(full.cleaned.data, nochoicefinalfinal)test.dataset <- test.dataset %>%
mutate(CRclose = case_when(CRdif <= 1 ~ 'Close',
CRdif >= 1 ~ 'Far')) %>%
mutate(CVclose = case_when(CVdif <= 1 ~ 'Close',
CVdif >= 1 ~ 'Far')) %>%
mutate(Scoreclose = case_when(scoredif <= 1 ~ 'Close',
scoredif >= 1 ~ 'Far'))
summary(test.dataset$CRdif)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000097 0.310392 0.689324 0.926580 1.272599 4.816300summary(test.dataset$CVdif)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.1928 0.4589 0.6964 0.9342 6.3487test.dataset <- test.dataset %>%
mutate(Closeness = case_when(CRclose == "Far" & CVclose == "Far" ~ "Both CR and CV far",
CRclose == "Far" & CVclose == "Close" ~ 'CV close and CR far',
CRclose == "Close" & CVclose == "Far" ~ 'CR close and CV far',
CRclose == "Close" & CVclose == "Close" ~ 'Both CR and CV close')
) %>%
mutate(OneClose = case_when(Closeness == "Both CR and CV far" ~ "Two Dimensions - Far",
Closeness == 'Both CR and CV close' ~ "Two Dimensions - Close",
Closeness == "CV close and CR far" ~ "One Dimension",
Closeness == "CR close and CV far" ~ "One Dimension"
))
test.dataset <- test.dataset %>%
mutate(MakeAChoice = case_when(is.na(Latency) ~ "No Choice",
Latency > 0 ~ "Choice"))
test.dataset <- test.dataset %>%
mutate(Scoredifclass = case_when(scoredif <=1 ~ '<1',
scoredif >=1 & scoredif <=2 ~ '1-2',
scoredif >=2 ~ '2+'))
test.dataset <- test.dataset %>% mutate(bestClass = case_when(best <= -2 ~ '<-2',
best >= -2 & best <= -1 ~ '-2 to -1',
best >= -1 & best <= 0~ '-1 to 0',
best >= 0 & best <= 1~ '0 to 1',
best >= 1 & best <= 2~ '1 to 2',
best >= 2 ~ '>2',))
test.dataset <- test.dataset %>%
mutate(CRdifClass = case_when(CRdif <= 1 ~ '<1',
CRdif >=1 & CRdif <=(2) ~ '1-2',
CRdif >=(2) ~ '2+'))
test.dataset <- test.dataset %>%
mutate(CVdifClass = case_when(CVdif <=1 ~ '<1',
CVdif >=1 & CVdif <=(2) ~ '1-2',
CVdif >=(2) ~ '2+'))
test.dataset$bestClass <- factor(test.dataset$bestClass,
levels = c("<-2", "-2 to -1", "-1 to 0", "0 to 1", "1 to 2", ">2"))
test.dataset <- test.dataset %>% group_by(Trial_ID, Correct) %>%
mutate(meanCV = mean(c(W_CV_Z, L_CV_Z, L2_CV_Z, L3_CR_Z, L4_CR_Z, L5_CR_Z, L6_CR_Z, L7_CR_Z),
na.rm = TRUE))
test.dataset <- ungroup(test.dataset)
test.dataset <- as.data.frame(test.dataset)
test.dataset <- test.dataset %>% mutate(MakeAChoice2 = case_when(MakeAChoice == "Choice" ~ 1,
MakeAChoice == "No Choice" ~ 0))
less.than.one <- test.dataset %>% filter(Scoredifclass == '<1')
one.to.two <- test.dataset %>% filter(Scoredifclass == '1-2')
more.than.2 <- test.dataset %>% filter(Scoredifclass == '2+')
choice.final <- test.dataset %>% filter(MakeAChoice == "Choice")
no.choice.final <- test.dataset %>% filter(MakeAChoice == "No Choice")
two.final <- test.dataset %>% filter(NumStimuli == "2")
four.final <- test.dataset %>% filter(NumStimuli == "4")
eight.final <- test.dataset %>% filter(NumStimuli == "8")# write.csv(test.dataset,"10282024_NSF_Data_Scores_Best_Worst.csv",row.names=FALSE)Summary Data
Z-Scores
ggplot(realized, aes(x = CR_Z, y = CV_Z, color = Score))+
geom_point()+
theme_classic()+
xlim(-3,4.5)+
ylim(-5.5,2.5)
ggplot(realized, aes(x = CR_Z, y = CV_Z, color = Score))+
geom_point()+
theme_classic()+
scale_color_gradient(low = "dodgerblue", high = "firebrick2")+
xlim(-3,4.5)+
ylim(-5.5,2.5)
ggplot(data = full.cleaned.data, aes(x = scoredif, y = Latency))+
geom_point()+
theme_minimal()
ggplot(data = full.cleaned.data, aes(x = CRdif, y = Latency))+
geom_point()+
theme_minimal()
ggplot(data = full.cleaned.data, aes(x = CVdif, y = Latency))+
geom_point()+
theme_minimal()
General Choice Overload
X Variable = NumStimuli
Response: less likely to make a choice
final.table <- final %>% group_by(NumStimuli) %>%
summarize(n = n(),
n.na = sum(is.na(Latency)),
n.respond = sum(!is.na(Latency)),
Latency = mean(Latency, na.rm = TRUE),
perc = n.na/n(),
)
final.table <- as.data.frame(final.table)
x <- binom.confint(x = 5, n = 508, conf.level = 0.95, method = "exact")
x1 <- binom.confint(x = 4, n = 508, conf.level = 0.95, method = "exact")
x2 <- binom.confint(x = 33, n = 508, conf.level = 0.95, method = "exact")
x3 <- rbind(x, x1, x2)
final.table <- cbind(final.table,x3[,c(5,6)])
final.table %>% kbl() %>% kable_classic(full_width = F, html_font = "Cambria")| NumStimuli | n | n.na | n.respond | Latency | perc | lower | upper |
|---|---|---|---|---|---|---|---|
| 2 | 500 | 5 | 495 | 89.77576 | 0.010 | 0.0032033 | 0.0228187 |
| 4 | 500 | 4 | 496 | 108.51210 | 0.008 | 0.0021495 | 0.0200370 |
| 8 | 500 | 33 | 467 | 130.57388 | 0.066 | 0.0451342 | 0.0900223 |
ggplot(final.table, aes(x = NumStimuli, y = perc, fill = NumStimuli))+
geom_bar(stat = "identity")+
theme_classic()+
labs(y = "Probability of No Response",
x = "Number of Stimuli")+
geom_errorbar(aes(ymin = lower, ymax = upper),
width = 0.2
)+
theme(legend.position = "none")+
scale_fill_brewer(palette = "Set1")
3960+1984+934## [1] 6878Response: take longer to decide
ggplot(final,aes(x=NumStimuli,y=LogLatency, fill = NumStimuli))+
geom_boxplot()+
theme_classic()+
scale_fill_brewer(palette = "Set1")+
theme(legend.position = "none")## Warning: Removed 42 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
Response: less likely to make preferred choice
final %>%
count(NumStimuli, correct) %>%
group_by(NumStimuli) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() +
aes(NumStimuli, pct, fill=correct) +
geom_bar(stat="identity") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
labs(title = "% Correct Identifications given Number of Stimuli",
x = "Number of Stimuli",
y = "% Correct Identification") +
theme_classic()
choice %>%
count(NumStimuli, correct) %>%
group_by(NumStimuli) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() +
aes(NumStimuli, pct, fill=correct) +
geom_bar(stat="identity") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
labs(title = "% Correct Identifications given Number of Stimuli",
x = "Number of Stimuli",
y = "% Correct Identification") +
theme_classic()
# Plot 1: just straight up loess smoothing
ggplot(choice, aes(x = W_Score, y = Correct, group = NumStimuli, color = NumStimuli))+
geom_jitter(alpha = 0.3)+
theme_classic()+
geom_smooth(se = FALSE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
# Test 1: linear model with binomial response variable
linear.model <- glmer(Correct~W_Score*NumStimuli+(1|FemaleID),
data = choice,
family = "binomial"
)
Anova(linear.model)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: Correct
## Chisq Df Pr(>Chisq)
## W_Score 221.990 1 < 2.2e-16 ***
## NumStimuli 192.147 2 < 2.2e-16 ***
## W_Score:NumStimuli 21.976 2 1.69e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(linear.model)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: Correct ~ W_Score * NumStimuli + (1 | FemaleID)
## Data: choice
##
## AIC BIC logLik deviance df.resid
## 1060.4 1097.4 -523.2 1046.4 1451
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -8.0124 -0.3367 -0.0389 0.3726 5.0255
##
## Random effects:
## Groups Name Variance Std.Dev.
## FemaleID (Intercept) 0.6499 0.8062
## Number of obs: 1458, groups: FemaleID, 125
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.6881 0.1447 4.754 2.00e-06 ***
## W_Score 1.3190 0.1313 10.046 < 2e-16 ***
## NumStimuli4 -2.3164 0.2163 -10.710 < 2e-16 ***
## NumStimuli8 -5.6073 0.5195 -10.793 < 2e-16 ***
## W_Score:NumStimuli4 0.2238 0.1822 1.228 0.219
## W_Score:NumStimuli8 1.5160 0.3234 4.688 2.76e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) W_Scor NmStm4 NmStm8 W_S:NS4
## W_Score 0.091
## NumStimuli4 -0.520 -0.146
## NumStimuli8 -0.231 -0.103 0.209
## W_Scr:NmSt4 -0.044 -0.605 -0.336 0.006
## W_Scr:NmSt8 -0.018 -0.320 -0.006 -0.810 0.252emmeans(linear.model, pairwise ~ W_Score |NumStimuli)## $emmeans
## NumStimuli = 2:
## W_Score emmean SE df asymp.LCL asymp.UCL
## 0.402 1.22 0.159 Inf 0.908 1.529
##
## NumStimuli = 4:
## W_Score emmean SE df asymp.LCL asymp.UCL
## 0.402 -1.01 0.159 Inf -1.318 -0.697
##
## NumStimuli = 8:
## W_Score emmean SE df asymp.LCL asymp.UCL
## 0.402 -3.78 0.396 Inf -4.555 -3.002
##
## Results are given on the logit (not the response) scale.
## Confidence level used: 0.95
##
## $contrasts
## NumStimuli = 2:
## contrast estimate SE df z.ratio p.value
## (nothing) nonEst NA NA NA NA
##
## NumStimuli = 4:
## contrast estimate SE df z.ratio p.value
## (nothing) nonEst NA NA NA NA
##
## NumStimuli = 8:
## contrast estimate SE df z.ratio p.value
## (nothing) nonEst NA NA NA NA
##
## Note: contrasts are still on the logit scaleemmeans(linear.model, pairwise ~ NumStimuli |W_Score)## $emmeans
## W_Score = 0.402:
## NumStimuli emmean SE df asymp.LCL asymp.UCL
## 2 1.22 0.159 Inf 0.908 1.529
## 4 -1.01 0.159 Inf -1.318 -0.697
## 8 -3.78 0.396 Inf -4.555 -3.002
##
## Results are given on the logit (not the response) scale.
## Confidence level used: 0.95
##
## $contrasts
## W_Score = 0.402:
## contrast estimate SE df z.ratio p.value
## NumStimuli2 - NumStimuli4 2.23 0.204 Inf 10.929 <.0001
## NumStimuli2 - NumStimuli8 5.00 0.421 Inf 11.866 <.0001
## NumStimuli4 - NumStimuli8 2.77 0.409 Inf 6.782 <.0001
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: tukey method for comparing a family of 3 estimates# Plot 2: predictions of linear model
plot_model(linear.model,
type = "pred",
terms = c("W_Score [all]", "NumStimuli")
) +
labs(y = "Prob(correct)")+
theme_classic()
General Summary
Scores
ggplot(full.cleaned.data, aes(scoredif, fill = NumStimuli))+
geom_histogram(bins = 50, position="identity", alpha = 0.5,
mapping = aes(y = after_stat(density)))+
theme_classic()
ggplot(data = full.cleaned.data, mapping = aes(x = scoredif, y = Latency, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_classic()+
stat_smooth(method = 'lm', formula = y ~ x + I(x^2), se = FALSE)+
scale_color_brewer(palette = "Set1")
CRs
ggplot(full.cleaned.data, aes(CRdif, fill = NumStimuli))+
geom_histogram(bins = 50, position="identity", alpha = 0.5,
mapping = aes(y = after_stat(density)))+
theme_classic()
ggplot(data = full.cleaned.data, mapping = aes(x = CRdif, y = Latency, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_classic()+
stat_smooth(method = 'lm', formula = y ~ x + I(x^2), se = FALSE)+
scale_color_brewer(palette = "Set1")
CVs
ggplot(full.cleaned.data, aes(CVdif, fill = NumStimuli))+
geom_histogram(bins = 50, position="identity", alpha = 0.5,
mapping = aes(y = after_stat(density)))+
theme_classic()
ggplot(data = full.cleaned.data, mapping = aes(x = CVdif, y = Latency, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_classic()+
stat_smooth(method = 'lm', formula = y ~ x + I(x^2), se = FALSE)+
scale_color_brewer(palette = "Set1")
Decision Task Difficulty
Choosing from a set of items described along a single dimension is likely to be less cognitively taxing than choosing from a set of items described along multiple attributes.
X Variable = OneClose / Closeness
General
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = Closeness))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")+
scale_color_brewer(palette = "Set2")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = OneClose))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = Closeness))+
geom_point()+
theme_minimal()+
scale_color_brewer(palette = "Set2")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = OneClose))+
geom_point()+
theme_minimal()
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = Scoredifclass))+
geom_point()+
theme_minimal()
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = CRdifClass))+
geom_point()+
theme_minimal()
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = CVdifClass))+
geom_point()+
theme_minimal()
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = MakeAChoice))+
geom_point()+
theme_minimal()
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = correct))+
geom_point()+
theme_minimal()
Response: less likely to make a choice
Choice v No Choice: Closeness
summary.test <- test.dataset %>% group_by(MakeAChoice, Closeness) %>%
dplyr::summarize(n = n()) ## `summarise()` has grouped output by 'MakeAChoice'. You can override using the
## `.groups` argument.summary.test <- as.data.frame(summary.test)
summary.test <- summary.test %>% add_row(MakeAChoice = "No Choice", Closeness = "Both CR and CV far", n = 0)
summary.test <- summary.test %>% add_row(MakeAChoice = "No Choice", Closeness = "CR close and CV far", n = 0)
summary.test <- summary.test %>% group_by(MakeAChoice) %>%
dplyr::mutate(per = 100*n/sum(n))
summary.test <- as.data.frame(summary.test)
summary.test$Closeness <- factor(summary.test$Closeness, levels = c("Both CR and CV close", "CV close and CR far", "CR close and CV far", "Both CR and CV far"))ggplot(summary.test, aes(x = Closeness, y = per, fill = MakeAChoice))+
geom_bar(stat = "identity", position = "dodge")+
theme_bw()+
theme(legend.position = "none",
axis.text.x = element_text(angle = 45, vjust = 0.5))+
ggh4x::facet_grid2(.~MakeAChoice,
scales = "free_y",
independent = "y")+
labs(y = "%")+
scale_fill_brewer(palette = "Set2")
Closeness: % no choice per type
summary.test2 <- test.dataset %>% group_by(Closeness, MakeAChoice) %>%
dplyr::summarize(n = n())## `summarise()` has grouped output by 'Closeness'. You can override using the
## `.groups` argument.summary.test2 <- as.data.frame(summary.test2)
summary.test2 <- summary.test2 %>% add_row(Closeness = "Both CR and CV far",MakeAChoice = "No Choice",n = 0)
summary.test2 <- summary.test2 %>% add_row(Closeness = "CR close and CV far",MakeAChoice = "No Choice",n = 0)
summary.test2 <- summary.test2 %>% group_by(Closeness) %>%
dplyr::mutate(per = 100*n/sum(n))
summary.test2 <- as.data.frame(summary.test2)
no.choice.test <- summary.test2 %>% filter(MakeAChoice == "No Choice")
no.choice.test$Closeness <- factor(no.choice.test$Closeness, levels = c("Both CR and CV close", "CV close and CR far", "CR close and CV far", "Both CR and CV far"))
ggplot(no.choice.test, aes(x = Closeness, y = per, fill = Closeness))+
geom_bar(stat = "identity")+
theme_minimal()+
scale_fill_brewer(palette = "Set2")+
labs(y = "% of trials with no choice")+
theme(legend.position = "none",
axis.text.x = element_text(angle = 45, vjust = 0.5))
Closeness: % no choice per type per NumStimuli
summary.test2.b <- test.dataset %>% group_by(Closeness, MakeAChoice,NumStimuli) %>%
dplyr::summarize(n = n())## `summarise()` has grouped output by 'Closeness', 'MakeAChoice'. You can
## override using the `.groups` argument.summary.test2.b <- as.data.frame(summary.test2.b)
summary.test2.b <- summary.test2.b %>% add_row(Closeness = "Both CR and CV far",MakeAChoice = "No Choice",NumStimuli = "2",n = 0)
summary.test2.b <- summary.test2.b %>% add_row(Closeness = "Both CR and CV far",MakeAChoice = "No Choice",NumStimuli = "4",n = 0)
summary.test2.b <- summary.test2.b %>% add_row(Closeness = "Both CR and CV far",MakeAChoice = "No Choice",NumStimuli = "8",n = 0)
summary.test2.b <- summary.test2.b %>% add_row(Closeness = "CR close and CV far",MakeAChoice = "No Choice",NumStimuli = "2",n = 0)
summary.test2.b <- summary.test2.b %>% add_row(Closeness = "CR close and CV far",MakeAChoice = "No Choice",NumStimuli = "4",n = 0)
summary.test2.b <- summary.test2.b %>% add_row(Closeness = "CR close and CV far",MakeAChoice = "No Choice",NumStimuli = "8",n = 0)
summary.test2.b <- summary.test2.b %>% group_by(Closeness,NumStimuli) %>%
dplyr::mutate(per = 100*n/sum(n))
summary.test2.b <- as.data.frame(summary.test2.b)
no.choice.test2.b <- summary.test2.b %>% filter(MakeAChoice == "No Choice")
no.choice.test2.b$Closeness <- factor(no.choice.test2.b$Closeness, levels = c("Both CR and CV close", "CV close and CR far", "CR close and CV far", "Both CR and CV far"))
ggplot(no.choice.test2.b, aes(x = Closeness, y = per, fill = Closeness))+
geom_bar(stat = "identity")+
theme_minimal()+
scale_fill_brewer(palette = "Set2")+
labs(y = "% of trials with no choice")+
facet_grid(.~NumStimuli)+
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = 0.5))
Response: take longer to decide
choice.final$Closeness <- factor(choice.final$Closeness, levels = c("Both CR and CV close", "CV close and CR far", "CR close and CV far", "Both CR and CV far"))
choice.final$OneClose <- factor(choice.final$OneClose, levels = c("Two Dimensions - Close", "One Dimension", "Two Dimensions - Far"))choice.latency.table <- choice.final %>% group_by(OneClose) %>%
summarize(n = n(),
Latency = mean(Latency))
choice.latency.table <- as.data.frame(choice.latency.table)
choice.latency.table %>% kbl() %>% kable_classic(full_width = F, html_font = "Cambria")| OneClose | n | Latency |
|---|---|---|
| Two Dimensions - Close | 751 | 122.94141 |
| One Dimension | 559 | 98.63506 |
| Two Dimensions - Far | 148 | 79.54730 |
library(rstatix)##
## Attaching package: 'rstatix'## The following object is masked from 'package:MASS':
##
## select## The following object is masked from 'package:stats':
##
## filterres.aov <- choice.final %>% anova_test(Latency ~ OneClose)
res.aov## ANOVA Table (type II tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 OneClose 2 1455 26.832 3.6e-12 * 0.036pwc <- choice.final %>% pairwise_t_test(Latency ~ OneClose, p.adjust.method = "bonferroni")
pwc %>% kbl() %>% kable_classic(full_width = F, html_font = "Cambria")| .y. | group1 | group2 | n1 | n2 | p | p.signif | p.adj | p.adj.signif |
|---|---|---|---|---|---|---|---|---|
| Latency | Two Dimensions - Close | One Dimension | 751 | 559 | 0.00000 | **** | 1.0e-07 | **** |
| Latency | Two Dimensions - Close | Two Dimensions - Far | 751 | 148 | 0.00000 | **** | 0.0e+00 | **** |
| Latency | One Dimension | Two Dimensions - Far | 559 | 148 | 0.00899 | ** | 2.7e-02 |
|
library(ggpubr)
# Show adjusted p-values
pwc <- pwc %>% add_xy_position(x = "OneClose")
ggboxplot(choice.final, x = "OneClose", y = "Latency", fill = "OneClose") +
stat_pvalue_manual(pwc, label = "p.adj", tip.length = 0, step.increase = 0.1) +
labs(
subtitle = get_test_label(res.aov, detailed = TRUE),
caption = get_pwc_label(pwc)
)+
theme_minimal()+
theme(legend.position = "none")
plot_ly(full.cleaned.data, x = ~CRdif, y = ~CVdif, z = ~(Latency), color = ~(NumStimuli),
size = 1,
type = "scatter3d",
mode = "markers")ggplot(choice.final, aes(x = Closeness, y = Latency, fill = Closeness))+
geom_boxplot()+
theme_minimal()+
theme(legend.position = "none")+
scale_fill_brewer(palette = "Set2")
ggplot(choice.final, aes(x = OneClose, y = Latency, fill = OneClose))+
geom_boxplot()+
theme_minimal()+
theme(legend.position = "none")
ggplot(choice.final, aes(x = OneClose, y = Latency, fill = OneClose))+
geom_boxplot()+
theme_minimal()+
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = 0.5))+
facet_grid(.~NumStimuli)
pwc2 <- two.final %>% pairwise_t_test(Latency ~ OneClose, p.adjust.method = "bonferroni")
pwc2 %>% kbl() %>% kable_classic(full_width = F, html_font = "Cambria")| .y. | group1 | group2 | n1 | n2 | p | p.signif | p.adj | p.adj.signif |
|---|---|---|---|---|---|---|---|---|
| Latency | One Dimension | Two Dimensions - Close | 236 | 155 | 6.30e-06 | **** | 1.89e-05 | **** |
| Latency | One Dimension | Two Dimensions - Far | 236 | 110 | 1.62e-01 | ns | 4.85e-01 | ns |
| Latency | Two Dimensions - Close | Two Dimensions - Far | 155 | 110 | 5.00e-07 | **** | 1.50e-06 | **** |
pwc4 <- four.final %>% pairwise_t_test(Latency ~ OneClose, p.adjust.method = "bonferroni")
pwc4 %>% kbl() %>% kable_classic(full_width = F, html_font = "Cambria")| .y. | group1 | group2 | n1 | n2 | p | p.signif | p.adj | p.adj.signif |
|---|---|---|---|---|---|---|---|---|
| Latency | One Dimension | Two Dimensions - Close | 222 | 246 | 0.150 | ns | 0.45 | ns |
| Latency | One Dimension | Two Dimensions - Far | 222 | 32 | 0.656 | ns | 1.00 | ns |
| Latency | Two Dimensions - Close | Two Dimensions - Far | 246 | 32 | 0.792 | ns | 1.00 | ns |
pwc8 <- eight.final %>% pairwise_t_test(Latency ~ OneClose, p.adjust.method = "bonferroni")
pwc8 %>% kbl() %>% kable_classic(full_width = F, html_font = "Cambria")| .y. | group1 | group2 | n1 | n2 | p | p.signif | p.adj | p.adj.signif |
|---|---|---|---|---|---|---|---|---|
| Latency | One Dimension | Two Dimensions - Close | 133 | 361 | 0.3260 | ns | 0.978 | ns |
| Latency | One Dimension | Two Dimensions - Far | 133 | 6 | 0.0923 | ns | 0.277 | ns |
| Latency | Two Dimensions - Close | Two Dimensions - Far | 361 | 6 | 0.0478 |
|
0.143 | ns |
ggplot(full.cleaned.data, aes(x = CRdif, y = CVdif, color = log(Latency)))+
geom_point()+
theme_minimal()+
scale_color_gradient(low = "dodgerblue", high = "firebrick2")
ggplot(full.cleaned.data, aes(x = CRdif, y = CVdif, color = scoredif))+
geom_point()+
theme_minimal()+
scale_color_gradient(low = "dodgerblue", high = "firebrick2")
Response: less likely to make preferred choice
choice.final %>%
count(OneClose, correct) %>%
group_by(OneClose) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(OneClose, pct, fill=correct) +
geom_bar(stat="identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
theme_minimal()
choice.final %>%
count(NumStimuli, OneClose, correct) %>%
group_by(NumStimuli,OneClose) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(OneClose, pct, fill = correct)+
geom_bar(stat = "identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
facet_grid(.~NumStimuli)+
theme_minimal()
choice.final %>%
count(Closeness, correct) %>%
group_by(Closeness) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(Closeness, pct, fill=correct) +
geom_bar(stat="identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
theme_minimal()
choice.final %>%
count(NumStimuli, Closeness, correct) %>%
group_by(NumStimuli,Closeness) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(Closeness, pct, fill = correct)+
geom_bar(stat = "identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
facet_grid(.~NumStimuli)+
theme_minimal()
Choice Set Complexity
Individuals are more likely to make a purchase when it contains a dominant option. Having equally attractive options will increase the likelihood of choice deferral.
X = Scoredif
General
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = OneClose))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = CRdifClass))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = CVdifClass))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = MakeAChoice))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
ggplot(test.dataset, aes(x = CRdif, y = CVdif, color = correct))+
geom_point()+
theme_minimal()+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
Response: less likely to make a choice
Scoredif x Num Choices
summary.test3 <- test.dataset %>% group_by(Scoredifclass, MakeAChoice,NumStimuli) %>%
dplyr::summarize(n = n())## `summarise()` has grouped output by 'Scoredifclass', 'MakeAChoice'. You can
## override using the `.groups` argument.summary.test3 <- as.data.frame(summary.test3)
summary.test3 <- summary.test3 %>% add_row(Scoredifclass = "2+",MakeAChoice = "No Choice",NumStimuli = "2",n = 0)
summary.test3 <- summary.test3 %>% add_row(Scoredifclass = "2+",MakeAChoice = "No Choice",NumStimuli = "4",n = 0)
summary.test3 <- summary.test3 %>% group_by(Scoredifclass, NumStimuli) %>%
dplyr::mutate(per = 100*n/sum(n))
summary.test3 <- as.data.frame(summary.test3)
no.choice.test.3 <- summary.test3 %>% filter(MakeAChoice == "No Choice")
ggplot(no.choice.test.3, aes(x = Scoredifclass, y = per, fill = Scoredifclass))+
geom_bar(stat = "identity")+
theme_minimal()+
scale_fill_brewer(palette = "Accent")+
labs(y = "% of trials with no choice",
title = "Difference between Best and next Best Score")+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
CRdif x Num Choices
summary.test4 <- test.dataset %>% group_by(CRdifClass, MakeAChoice,NumStimuli) %>%
dplyr::summarize(n = n())## `summarise()` has grouped output by 'CRdifClass', 'MakeAChoice'. You can
## override using the `.groups` argument.summary.test4 <- as.data.frame(summary.test4)
summary.test4 <- summary.test4 %>% group_by(CRdifClass, NumStimuli) %>%
dplyr::mutate(per = 100*n/sum(n))
summary.test4 <- as.data.frame(summary.test4)
no.choice.test.4 <- summary.test4 %>% filter(MakeAChoice == "No Choice")
ggplot(no.choice.test.4, aes(x = CRdifClass, y = per, fill = CRdifClass))+
geom_bar(stat = "identity")+
theme_minimal()+
scale_fill_brewer(palette = "Set2")+
labs(y = "% of trials with no choice",
title = "Difference between Best and next Best CR")+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")
CVdif x Num Choices
summary.test5 <- test.dataset %>% group_by(CVdifClass, MakeAChoice,NumStimuli) %>%
dplyr::summarize(n = n())## `summarise()` has grouped output by 'CVdifClass', 'MakeAChoice'. You can
## override using the `.groups` argument.summary.test5 <- as.data.frame(summary.test5)
summary.test5 <- summary.test5 %>% add_row(CVdifClass = "1-2",MakeAChoice = "No Choice",NumStimuli = "2",n = 0)
summary.test5 <- summary.test5 %>% add_row(CVdifClass = "1-2",MakeAChoice = "No Choice",NumStimuli = "4",n = 0)
summary.test5 <- summary.test5 %>% add_row(CVdifClass = "1-2",MakeAChoice = "No Choice",NumStimuli = "8",n = 0)
summary.test5 <- summary.test5 %>% add_row(CVdifClass = "2+",MakeAChoice = "No Choice",NumStimuli = "2",n = 0)
summary.test5 <- summary.test5 %>% add_row(CVdifClass = "2+",MakeAChoice = "No Choice",NumStimuli = "4",n = 0)
summary.test5 <- summary.test5 %>% add_row(CVdifClass = "2+",MakeAChoice = "No Choice",NumStimuli = "8",n = 0)
summary.test5 <- summary.test5 %>% group_by(CVdifClass, NumStimuli) %>%
dplyr::mutate(per = 100*n/sum(n))
summary.test5 <- as.data.frame(summary.test5)
no.choice.test.5 <- summary.test5 %>% filter(MakeAChoice == "No Choice")
ggplot(no.choice.test.5, aes(x = CVdifClass, y = per, fill = CVdifClass))+
geom_bar(stat = "identity")+
theme_minimal()+
scale_fill_brewer(palette = "Set2")+
labs(y = "% of trials with no choice",
title = "Difference between Best and next Best CV")+
facet_grid(.~NumStimuli)+
theme(legend.position = "none")## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_bar()`).
Response: take longer to decide
ggplot(data = choice.final, mapping = aes(x = scoredif, y = Latency, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
stat_smooth(method = 'lm', formula = y ~ x + I(x^2), se = FALSE)+
scale_color_brewer(palette = "Set1")
ggplot(data = choice.final, mapping = aes(x = CRdif, y = Latency, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
stat_smooth(method = 'lm', formula = y ~ x + I(x^2), se = FALSE)+
scale_color_brewer(palette = "Set1")
ggplot(data = choice.final, mapping = aes(x = CVdif, y = Latency, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
stat_smooth(method = 'lm', formula = y ~ x + I(x^2), se = FALSE)+
scale_color_brewer(palette = "Set1")
ggplot(choice.final, aes(x = scoredif, y = Latency, color = OneClose))+
geom_point(alpha = 0.3)+
theme_minimal()+
stat_smooth(se = FALSE,
method = "lm")+
ylim(0,600)## `geom_smooth()` using formula = 'y ~ x'
ggplot(choice.final, aes(x = scoredif, y = Latency, color = Closeness))+
geom_point(alpha = 0.3)+
theme_minimal()+
stat_smooth(se = FALSE,
method = "lm")+
ylim(0,600)+
scale_color_brewer(palette = "Set2")## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_smooth()`).
Response: less likely to make preferred choice
test.dataset %>%
count(Scoredifclass, correct) %>%
group_by(Scoredifclass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(Scoredifclass, pct, fill=correct) +
geom_bar(stat="identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
theme_minimal()
choice.final %>%
count(Scoredifclass, correct) %>%
group_by(Scoredifclass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(Scoredifclass, pct, fill=correct) +
geom_bar(stat="identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
theme_minimal()
choice.final %>%
count(CRdifClass, correct) %>%
group_by(CRdifClass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(CRdifClass, pct, fill=correct) +
geom_bar(stat="identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
theme_minimal()
choice.final %>%
count(CVdifClass, correct) %>%
group_by(CVdifClass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(CVdifClass, pct, fill=correct) +
geom_bar(stat="identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
theme_minimal()
choice.final %>%
count(NumStimuli, Scoredifclass, correct) %>%
group_by(NumStimuli,Scoredifclass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(Scoredifclass, pct, fill = correct)+
geom_bar(stat = "identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
facet_grid(.~NumStimuli)+
theme_minimal()
choice.final %>%
count(NumStimuli, CRdifClass, correct) %>%
group_by(NumStimuli,CRdifClass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(CRdifClass, pct, fill = correct)+
geom_bar(stat = "identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
facet_grid(.~NumStimuli)+
theme_minimal()
choice.final %>%
count(NumStimuli, CVdifClass, correct) %>%
group_by(NumStimuli,CVdifClass) %>%
mutate(pct= prop.table(n) * 100) %>%
ggplot() + aes(CVdifClass, pct, fill = correct)+
geom_bar(stat = "identity") +
ylab("% Correct Identifications") +
geom_text(aes(label=paste0(sprintf("%1.1f", pct),"%")),
position=position_stack(vjust=0.5)) +
facet_grid(.~NumStimuli)+
theme_minimal()
Preference Uncertainty
Response: less likely to make a choice
ggplot(test.dataset, aes(x = maxCV, y = MakeAChoice2, group = NumStimuli, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
ggplot(test.dataset, aes(x = maxCV, y = MakeAChoice2, group = NumStimuli, color = NumStimuli))+
geom_jitter(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
ggplot(test.dataset, aes(x = meanCV, y = MakeAChoice2, group = NumStimuli, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
ggplot(no.choice.final, aes(x = maxCV, y = NumStimuli, group = NumStimuli, fill = NumStimuli))+
geom_boxplot()+
theme_minimal()+
theme(legend.position = "none")+
scale_fill_brewer(palette = "Set1")+
labs(title = "Best CV Z-Scores for trials with no choice")
ggplot(no.choice.final, aes(x = meanCV, y = NumStimuli, group = NumStimuli, fill = NumStimuli))+
geom_boxplot()+
theme_minimal()+
theme(legend.position = "none")+
scale_fill_brewer(palette = "Set1")+
labs(title = "Mean CV Z-Scores for trials with no choice")
ggplot(no.choice.final, aes(x = NumStimuli, y = maxCV, group = NumStimuli, color = NumStimuli))+
geom_point()+
theme_minimal()+
theme(legend.position = "none")+
scale_color_brewer(palette = "Set1")
ggplot(no.choice.final, aes(x = NumStimuli, y = meanCV, group = NumStimuli, color = NumStimuli))+
geom_point()+
theme_minimal()+
theme(legend.position = "none")+
scale_color_brewer(palette = "Set1")
Response: take longer to decide
ggplot(choice.final, aes(x = W_CV_Z, y = Latency, group = NumStimuli, color = NumStimuli))+
geom_jitter(alpha = 0.3)+
theme_minimal()+
geom_smooth(se = FALSE,
method = "lm",
formula = y ~ x + I(x^2))+
scale_color_brewer(palette = "Set1")+
ylim(0, 600)
ggplot(choice.final, aes(x = maxCV, y = Latency, group = NumStimuli, color = NumStimuli))+
geom_jitter(alpha = 0.3)+
theme_minimal()+
geom_smooth(se = FALSE,
method = "lm",
formula = y ~ x + I(x^2))+
scale_color_brewer(palette = "Set1")+
ylim(0, 600)
ggplot(choice.final, aes(x = meanCV, y = Latency, group = NumStimuli, color = NumStimuli))+
geom_jitter(alpha = 0.3)+
theme_minimal()+
geom_smooth(se = FALSE,
method = "lm",
formula = y ~ x + I(x^2))+
scale_color_brewer(palette = "Set1")+
ylim(0, 600)
Response: less likely to make preferred choice
ggplot(choice.final, aes(x = W_CV_Z, y = Correct, group = NumStimuli, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
ggplot(choice.final, aes(x = best, y = Correct, group = NumStimuli, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
ggplot(choice.final, aes(x = maxCV, y = Correct, group = NumStimuli, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
ggplot(choice.final, aes(x = meanCV, y = Correct, group = NumStimuli, color = NumStimuli))+
geom_point(alpha = 0.3)+
theme_minimal()+
geom_smooth(method = "glm",
method.args = list(family = "binomial"),
se = FALSE, fullrange = TRUE)+
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
hist(choice.final$meanCV)
hist(choice.final$maxCV)
hist(choice.final$W_CV_Z)
By Males
realized = subset(realized, FemaleID != "Hch181-23") #Given 2 of same test and missing another test, so exclude
realized = subset(realized, FemaleID != "Hch117-23") #There are 13 responses from this female and I'm not sure why so omit her
realized## # A tibble: 6,710 × 15
## FemaleID NumChoices TrialID Latency SignalSet SpeakerNumber SpeakerChosen
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Hch085-23 8 1 105 1 1 3
## 2 Hch085-23 8 1 105 1 2 3
## 3 Hch085-23 8 1 105 1 3 3
## 4 Hch085-23 8 1 105 1 4 3
## 5 Hch085-23 8 1 105 1 5 3
## 6 Hch085-23 8 1 105 1 6 3
## 7 Hch085-23 8 1 105 1 7 3
## 8 Hch085-23 8 1 105 1 8 3
## 9 Hch085-23 8 2 520 1 1 5
## 10 Hch085-23 8 2 520 1 2 5
## # ℹ 6,700 more rows
## # ℹ 8 more variables: CallPeriodsHeard <dbl>, RealizedCR <dbl>,
## # RealizedCVw <dbl>, Identity <chr>, CR_Z <dbl>, CV_Z <dbl>, Score <dbl>,
## # Winner_Identity <chr>plot_ly(final_type2, x = ~CR_Z, y = ~CV_Z, z = ~(Latency),
size = 1,
type = "scatter3d",
mode = "markers")## Warning: Ignoring 290 observations