Analyses Project Generalizability ASE
Sophie Scharf
July 12, 2019
This markdown provides the R Code for the analyses of the three experiments from the Information Search in Everyday Decisions: The Generalizability of the Attraction Search Effect paper and allows the reproduction of all reported results and plots. The code has been written by me, Sophie Scharf - if you see any errors or have any questions, please email me directly to so.scharf@gmail.com.
The reported analyses and the reported code will have the following structure:
- General overview of the project and the experiments
- Load data and packages
- Packages
- Data
- Functions
- Analyses Experiment 1
- Demographic data
- Statistical analyses
- Analyses Experiment 2
- Demographic data
- Pre-registered analyses
- Exploratory analyses
- Analyses Experiment 3
- Demographic data
- Pre-registered analyses
- Exploratory analyses
- Plots
1 1. General overview
In this project, the goal was to test the generalizability of the Attraction Search Effect, the core prediction for information search from the new integrated coherence-based decision and search model (iCodes, Jekel, Glöckner, & Bröder, 2018). This effect states that people have a tendency to search for information on the more attractive option based on the already available evidence.
As the available evidence for the Attraction Search Effect is all based on the same semantic content of the decision task and the same cue value patterns, we try to dispose of the inherent restrictions from the original experiments and to replicate the Attraction Search Effect in this new contexts. For this purpose three online experiments were run that vary the semantic context of the decision task (Experiment 1, 2, and 3), the cue value patterns (Experiment 2), and the way of presenting the decision task (Experiment 3). The main hypothesis for all three experiments was that we find an overall positive Attraction Search Score, an index that represents the difference between search behavior consistent with the Attraction Search Effect and search behavior inconsistent with the Attraction Search Effect. This score, therefore, is positive if subjects tend to search for the attractive option and is zero if subjects’ information search is unaffected by the options’ attractiveness.
2 2. Data and packages
These packages were used for the following analyses:
# Packages for data manipulation
library(tidyr)
library(dplyr)
library(knitr)
library(kableExtra)
library(tibble)
# Packages for plotting
library(ggplot2)
library(Cairo)
library(cowplot)
library(gridExtra)
library(viridis)
# Packages for multi-level analyses
library(lme4)
library(lmerTest)
# Packages for calculating effect sizes
library(effsize)For each of the three experiments, there is one data set with demographic data and one with the behavioral data of the experiment:
# Experiment 1
demo.Exp1 <- read.csv("demo_data_Exp1.csv") # demographic data
data.Exp1 <- read.csv("clean_data_Exp1.csv") # behavioral data
# Experiment 2
demo.Exp2 <- read.csv("demo_data_Exp2.csv") # demographic data
data.Exp2 <- read.csv("clean_data_Exp2.csv") # behavioral data
# Experiment 3
demo.Exp3 <- read.csv("demo_data_Exp3.csv") # demographic data
data.Exp3 <- read.csv("clean_data_Exp3.csv") # behavioral data3 3. Functions
I only used one custom function which allows me to identify whether an instance x is not part of an vector y. This function returns TRUE if a value x is not in the vector y.
"%w/o%" <- function(x, y)!('%in%'(x,y))4 4. Analyses Experiment 1
4.1 Analysis of demographic data
As a first step, we will take a look at the demographic characteristics of the sample in Experiment 1.
# Age of subjects
demo.Exp1 %>%
summarise(mean.age = mean(age),
sd.age = sd(age),
min.age = min(age),
max.age = max(age))# Gender of subjects
demo.Exp1 %>%
group_by(sex) %>%
summarise(n.sex = n()) %>%
ungroup() %>%
mutate(percent.sex = n.sex/sum(n.sex))# Job of subjects
demo.Exp1 %>%
group_by(job) %>%
summarise(n.job = n()) %>%
ungroup() %>%
mutate(percent.job = n.job/sum(n.job))4.2 Analysis of behavioral data
The first analysis concerns the subjective importance ratings by subjects given for the cues used in the decision task. In the following analysis, we calculated the means and the standard deviations for the importance ratings for every cue in every scenario.
# Create data fram with importance ratings data
importanceRatings.Exp1 <- data.Exp1 %>%
# keep only importance rating data and relevant variables
filter(data == "importance.data") %>%
select(ID, scenario, cue, importance.rating) %>%
group_by(scenario, cue) %>%
# Calculate mean & sd per scenario & cue
summarise(mean.rating = mean(importance.rating),
sd.rating = sd(importance.rating))
# Create table of means and standard deviations of importance ratings
kable(importanceRatings.Exp1, format = "html", padding = 2) %>%
kable_styling(bootstrap_options = "striped", font_size = 10) %>%
group_rows("City", 1, 4) %>%
group_rows("Hair Salon", 5, 8) %>%
group_rows("Hotel", 9, 12) %>%
group_rows("Job", 13, 16) %>%
group_rows("Pizza", 17, 20) %>%
group_rows("Weather", 21, 24)| scenario | cue | mean.rating | sd.rating |
|---|---|---|---|
| City | |||
| city | capital | 57.465347 | 32.65946 |
| city | international.airport | 68.052805 | 29.81184 |
| city | opera | 36.993399 | 29.94730 |
| city | university | 47.363036 | 28.23753 |
| Hair Salon | |||
| hair | appointment | 36.310231 | 26.67693 |
| hair | competency | 85.161716 | 22.04324 |
| hair | price | 58.016502 | 26.02374 |
| hair | proximity.home | 37.587459 | 26.62030 |
| Hotel | |||
| hotel | clean | 76.333333 | 27.14868 |
| hotel | price | 64.699670 | 24.83986 |
| hotel | proximity.beach | 59.069307 | 29.51167 |
| hotel | proximity.citycenter | 37.669967 | 26.00898 |
| Job | |||
| job | colleagues | 64.640264 | 28.43371 |
| job | pay | 72.409241 | 23.32049 |
| job | proximity.home | 44.947195 | 27.34893 |
| job | work.conditions | 73.521452 | 27.33067 |
| Pizza | |||
| pizza | friendly | 33.330033 | 27.03977 |
| pizza | on.time | 47.250825 | 28.03905 |
| pizza | price | 55.122112 | 26.31662 |
| pizza | quality | 89.155115 | 18.21448 |
| Weather | |||
| weather | bild.private.news | 23.689769 | 24.08517 |
| weather | GWS | 82.679868 | 24.88583 |
| weather | horoscope | 5.171617 | 12.53988 |
| weather | zdf.public.news | 63.224422 | 30.12396 |
For testing our hypothesis, the first relevant analysis step is to calculate the Attraction Search Score. In general the Attraction Search Score is the difference of the probability of searching for one option, given that this option is attractive, minus the probability of searching for the same option, given that this option is not attractive. Thus, a key experimental manipulation is the attractiveness of the options. The attractiveness of the options is manipulated in this experiment via the version of the patterns: in Version a of a pattern Option A is attractive, in Version b Option B is attractive (and, thus, Option A is unattractive). Therefore, the Attraction Search Score is calculated as the probability of searching for information on Option A in Version a minus the probability of searching for Option A in Version b, \(AS\ Score= p(Searching\ for\ Option\ A\ |\ Version\ a) - p(Searching\ for\ Option\ A\ |\ Version\ b)\). As a first step, we created a data frame which contains the individual Attraction Search Scores.
# Calculating the AS-Score for every participant
ASScore.Exp1 <- data.Exp1 %>%
# keep only information search data in decision task
filter(data == "choice.data" & answer.type == "search") %>%
select(ID, version, option.answer) %>%
group_by(ID, version, option.answer) %>%
# calculate number of searches per version and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(ID,version,option.answer,fill = list(n.searches=0)) %>%
group_by(ID, version) %>%
# calculate probability of search given version
mutate(percent.searches = n.searches/sum(n.searches)) %>%
# select only probabilities of searching for Option A
filter(option.answer == "OptionA") %>%
select(-option.answer, -n.searches) %>%
spread(version, percent.searches) %>%
select(ID, VersionA = a, VersionB = b) %>%
# Substract probabilities of searching Option A given Version a from probability of searching Option A given Version b
mutate(ASScore = VersionA - VersionB) To test the hypothesis, that subjects show behavior consistent with the Attraction Search Effect, we run a one-sided, one-sample t-test against zero with the Attraction Search Score as dependent variable, as a positive Attraction Search Score indicates behavior consistent with the Attraction Search Effect.
# One-sided, one-sample t test against zero
t.test(ASScore.Exp1$ASScore, mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.Exp1$ASScore
## t = 14.549, df = 302, p-value < 2.2e-16
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2877284 Inf
## sample estimates:
## mean of x
## 0.3245325# Calculate Cohen's d
ES.ASScore.Exp1 <- mean(ASScore.Exp1$ASScore)/sd(ASScore.Exp1$ASScore)
print(ES.ASScore.Exp1)## [1] 0.8358009The next analysis step is to test whether the Attraction Search Score is significant for the separate cue value patterns. In order to test this hypothesis, we need to calculate the Attraction Search Score on the level of patterns. It is important to note, that the three used cue patterns are described in the data by the number they had in the Jekel et al. (2018) paper - in the manuscript, we gave new numbers to the used cue value patterns. Therefore, Pattern 4 in this Markdown is Pattern 1 in the manuscript, Pattern 5 is Pattern 2, and Pattern 7 is Pattern 3 in the manuscript.
# Calculate Attraction Search Score per pattern
ASScore.pattern.Exp1 <- data.Exp1 %>%
# keep only information search data in decision task
filter(data == "choice.data" & answer.type == "search") %>%
select(ID, pattern, version, option.answer) %>%
group_by(ID, pattern, version, option.answer) %>%
# calculate number of searches per pattern, version, and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(ID, pattern, version, option.answer, fill = list(n.searches=0)) %>%
group_by(ID, pattern, version) %>%
# calculate probability of search given version
mutate(percent.searches = n.searches/sum(n.searches)) %>%
# select only probabilities of searching for Option A
filter(option.answer == "OptionA") %>%
select(-option.answer, -n.searches) %>%
spread(version, percent.searches) %>%
select(ID, pattern, VersionA = a, VersionB = b) %>%
# Substract probabilities of searching Option A given Version a from probability of searching Option A given Version b
mutate(ASScore = VersionA - VersionB)To test the hypothesis, that subjects show behavior consistent with the Attraction Search Effect in each cue value pattern, we run a one-sided, one-sample t-test against zero with the Attraction Search Score as dependent variable for each pattern, as a positive Attraction Search Score indicates behavior consistent with the Attraction Search Effect.
# One-sided, one-sample t test against zero for Pattern 4
t.test(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 4], mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 4]
## t = 6.0646, df = 302, p-value = 1.974e-09
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.1801837 Inf
## sample estimates:
## mean of x
## 0.2475248# Cohen's d for Pattern 4
ES.ASScore.pattern4.Exp1 <- mean(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 4])/sd(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 4])
print(ES.ASScore.pattern4.Exp1)## [1] 0.3484006# One-sided, one-sample t test against zero for Pattern 5
t.test(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 5], mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 5]
## t = 8.2874, df = 302, p-value = 1.917e-15
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2114619 Inf
## sample estimates:
## mean of x
## 0.2640264# Cohen's d for Pattern 5
ES.ASScore.pattern5.Exp1 <- mean(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 5])/sd(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 5])
print(ES.ASScore.pattern5.Exp1)## [1] 0.4760961# One-sided, one-sample t test against zero for Pattern 7
t.test(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 7], mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 7]
## t = 13.62, df = 302, p-value < 2.2e-16
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.4060732 Inf
## sample estimates:
## mean of x
## 0.4620462# Cohen's d for Pattern 7
ES.ASScore.pattern7.Exp1 <- mean(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 7])/sd(ASScore.pattern.Exp1$ASScore[ASScore.pattern.Exp1$pattern == 7])
print(ES.ASScore.pattern7.Exp1)## [1] 0.7824323Lastly, we want to test whether the Attraction Search Effect also exists in every content scenario. For this purpose, we calculate the Attraction Search Score across individuals and cue patterns for each decision context. As there are no repetitions of scenarios, this analysis results in only one Attraction Search Score per scenario and, thus, does not allow statistical significance tests. We will take a closer look at the between-decision context heterogeneity with a mixed logistic regression analysis with crossed-random effects for subjects and scenarios.
ASScore.Scenarios.Exp1 <- data.Exp1 %>%
# keep only information search data in decision task
filter(data == "choice.data" & answer.type == "search") %>%
select(scenario, pattern, version, option.answer) %>%
group_by(scenario, version, option.answer) %>%
# calculate number of searches per pattern, version, and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(scenario, version, option.answer, fill = list(n.searches=0)) %>%
group_by(scenario, version) %>%
# calculate probability of search given version
mutate(percent.searches = n.searches/sum(n.searches)) %>%
# select only probabilities of searching for Option A
filter(option.answer == "OptionA") %>%
select(-option.answer, -n.searches) %>%
spread(version, percent.searches) %>%
select(scenario, VersionA = a, VersionB = b) %>%
# Substract probabilities of searching Option A given Version a from probability of searching Option A given Version b
mutate(ASScore = VersionA - VersionB)
# Create table of means and standard deviations of importance ratings
kable(ASScore.Scenarios.Exp1, format = "html", padding = 2) %>%
kable_styling(bootstrap_options = "striped", font_size = 10)| scenario | VersionA | VersionB | ASScore |
|---|---|---|---|
| city | 0.4466667 | 0.2418301 | 0.2048366 |
| hair | 0.6405229 | 0.1800000 | 0.4605229 |
| hotel | 0.4400000 | 0.1307190 | 0.3092810 |
| job | 0.5751634 | 0.2400000 | 0.3351634 |
| pizza | 0.6862745 | 0.2266667 | 0.4596078 |
| weather | 0.5266667 | 0.3529412 | 0.1737255 |
4.2.1 Generalized linear mixed model analyses
Due to the fact that the Attraction Search Score is range restricted ([-1,1]) and can only take on distinct values, a t test might not be the most adequate analysis. Therefore, in order to test the main hypothesis more adequately as well as account for several sources of heterogeneity, we also ran a trial-level generalized linear mixed model, with searching for Option A vs. searching for Option B as the dependent variable, random intercepts and slopes for subjects and scenarios, and pattern version as a Level 1 predictor.
# Create dataframe for generalized linear mixed model analysis
GLMER.data.Exp1 <- data.Exp1 %>%
# select only search data
filter(data == "choice.data" & answer.type == "search") %>%
select(ID, scenario:version, option.answer) %>%
mutate(# recode DV for logistic multilevel regression
option.answer.av = recode(option.answer, OptionA = 1, OptionB = 0)) %>%
mutate(scenario = as.factor(scenario),
ID = as.factor(ID))
# Assign effect-coding contrast to version predictor
contrasts(GLMER.data.Exp1$version) <- contr.sum(2)
contrasts(GLMER.data.Exp1$version)## [,1]
## a 1
## b -1# Run generalized linear mixes model - full model
glmer.ASScore.Exp1.full <- glmer(option.answer.av ~ version+(1 + version|ID)+(1 + version|scenario),
data = GLMER.data.Exp1, family = binomial)
summary(glmer.ASScore.Exp1.full)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: option.answer.av ~ version + (1 + version | ID) + (1 + version |
## scenario)
## Data: GLMER.data.Exp1
##
## AIC BIC logLik deviance df.resid
## 2217.5 2261.6 -1100.8 2201.5 1810
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.4106 -0.6641 -0.4721 0.8574 2.3424
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.03756 0.1938
## version1 0.05629 0.2373 -0.42
## scenario (Intercept) 0.06634 0.2576
## version1 0.05241 0.2289 0.00
## Number of obs: 1818, groups: ID, 303; scenario, 6
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.5306 0.1207 -4.396 1.10e-05 ***
## version1 0.7515 0.1109 6.773 1.26e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## version1 -0.085# Final model for plots
glmer.ASScore.Exp1.final <- glmer.ASScore.Exp1.fullVersion has a significant, positive effect on searched-for option, indicating that subjects were more likely to search for Option A when presented with a pattern in Version a. Nonetheless, there is variability in the effect between subjects, patterns, and scenarios. In an attempt to explain this variability, we ran two mixed logistic regressions with additional predictors. The first predictor is which cue pattern was presented in a trial and was helmert-coded. The second predictor is the individual rank correlation of our assumed cue ordering and the ordering based on subjects’ subjective importance ratings for each content scenario.
# Individual rank correlations of importance ratings
rankCor_importance <- data.Exp1 %>%
filter(data == "importance.data") %>%
select(ID, scenario, cue, importance.rating) %>%
arrange(ID, scenario, desc(importance.rating))
# Add intended ranking of cues
rankCor_importance$actualRanking <- rep(c("a.capital", "b.international.airport", "c.university", "d.opera", "a.competency", "b.price", "c.proximity.home", "d.appointment", "a.proximity.beach", "b.price", "c.proximity.citycenter", "d.clean", "a.pay", "b.work.conditions", "c.colleagues", "d.proximity.home", "a.quality", "b.price", "c.on.time", "d.friendly", "a.GWS", "b.zdf.public.news", "c.bild.private.news", "d.horoscope"), length.out = nrow(rankCor_importance))
# Add subjects order of cues as a,b,c,d
rankCor_importance$orderCues <- recode(rankCor_importance$cue,
capital = "a", international.airport = "b", university = "c", opera = "d",
competency = "a", price = "b", proximity.home = "c", appointment = "d",
proximity.beach = "a", proximity.citycenter = "c", clean = "d",
pay = "a", work.conditions = "b", colleagues = "d",
quality = "a", on.time = "c", friendly = "d",
GWS = "a", zdf.public.news = "b", bild.private.news = "c", horoscope = "d")
# Final calculation of cue ordering correlations
rankCor_importanceFinal <- rankCor_importance %>%
mutate(orderCues = ifelse(as.character(orderCues) == "proximity.home" & as.character(scenario) == "job", "d",
as.character(orderCues))) %>%
unite(., "original.ranking", actualRanking, scenario, sep = ".", remove = FALSE) %>%
unite(., "participant.ranking", orderCues, cue, scenario, sep = ".", remove = FALSE) %>%
group_by(ID, scenario) %>%
# transform ranking into numerical variables
mutate(original.ranking.num = as.numeric(as.factor(original.ranking)),
participant.ranking.num = as.numeric(as.factor(participant.ranking))) %>%
# calculate rank correlation per scenario
summarise(cor.Ranking = cor(original.ranking.num, participant.ranking.num, method = "spearman")) %>%
mutate(c.corRanking = cor.Ranking - mean(cor.Ranking))
# Create dataframe for generalized linear mixed model analysis
GLMER.data.predictors.Exp1 <- GLMER.data.Exp1 %>%
mutate(ID = as.numeric(as.character(ID))) %>%
left_join(rankCor_importanceFinal, by = c("ID", "scenario")) %>%
mutate(pattern = as.factor(pattern),
ID = as.factor(ID))
# Assign helmert-coding contrast to pattern predictor
contrasts(GLMER.data.predictors.Exp1$version) <- contr.sum(2)
contrasts(GLMER.data.predictors.Exp1$pattern) <- contr.helmert(3)
contrasts(GLMER.data.predictors.Exp1$pattern)## [,1] [,2]
## 4 -1 -1
## 5 1 -1
## 7 0 2# Predict random slopes with difference in cue patterns
glmer.ASScore.Exp1.Pattern <- glmer(option.answer.av ~ version*pattern+(1 + version|ID)+(1+version|scenario),
data = GLMER.data.predictors.Exp1, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
summary(glmer.ASScore.Exp1.Pattern)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: option.answer.av ~ version * pattern + (1 + version | ID) + (1 +
## version | scenario)
## Data: GLMER.data.predictors.Exp1
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 2067.9 2134.0 -1022.0 2043.9 1806
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.8441 -0.6813 -0.3329 0.7156 3.8766
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.16004 0.4000
## version1 0.17578 0.4193 -0.35
## scenario (Intercept) 0.08184 0.2861
## version1 0.06844 0.2616 -0.02
## Number of obs: 1818, groups: ID, 303; scenario, 6
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.63648 0.13622 -4.673 2.97e-06 ***
## version1 0.87511 0.12796 6.839 7.98e-12 ***
## pattern1 -0.80441 0.07483 -10.750 < 2e-16 ***
## pattern2 0.02387 0.04127 0.578 0.563040
## version1:pattern1 0.16045 0.07484 2.144 0.032032 *
## version1:pattern2 0.15374 0.04127 3.725 0.000195 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) versn1 pttrn1 pttrn2 vrs1:1
## version1 -0.127
## pattern1 0.128 -0.153
## pattern2 0.024 -0.022 -0.114
## vrsn1:pttr1 -0.144 0.136 -0.246 0.093
## vrsn1:pttr2 -0.020 0.025 0.093 -0.232 -0.114# Predict random slopes with difference in importance rating
glmer.ASScore.Exp1.Importance <- glmer(option.answer.av ~ version*pattern*cor.Ranking+(1+version|ID)+(1+version|scenario),
data = GLMER.data.predictors.Exp1, family = binomial,
control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
summary(glmer.ASScore.Exp1.Importance)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## option.answer.av ~ version * pattern * cor.Ranking + (1 + version |
## ID) + (1 + version | scenario)
## Data: GLMER.data.predictors.Exp1
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 1959.6 2058.7 -961.8 1923.6 1800
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.6724 -0.5651 -0.3116 0.6577 4.3367
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.16119 0.4015
## version1 0.14669 0.3830 -0.23
## scenario (Intercept) 0.04197 0.2049
## version1 0.08137 0.2853 -0.10
## Number of obs: 1818, groups: ID, 303; scenario, 6
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.687208 0.131804 -5.214 1.85e-07 ***
## version1 0.772342 0.152986 5.048 4.45e-07 ***
## pattern1 -0.074936 0.102451 -0.731 0.46452
## pattern2 0.009387 0.057419 0.163 0.87014
## cor.Ranking 0.131818 0.143702 0.917 0.35898
## version1:pattern1 0.264560 0.102501 2.581 0.00985 **
## version1:pattern2 0.120033 0.057478 2.088 0.03677 *
## version1:cor.Ranking 0.263594 0.137731 1.914 0.05564 .
## pattern1:cor.Ranking -1.416393 0.145103 -9.761 < 2e-16 ***
## pattern2:cor.Ranking 0.021112 0.076740 0.275 0.78323
## version1:pattern1:cor.Ranking -0.203217 0.145258 -1.399 0.16181
## version1:pattern2:cor.Ranking 0.013611 0.076920 0.177 0.85954
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) versn1 pttrn1 pttrn2 cr.Rnk vrs1:1 vrs1:2 vr1:.R pt1:.R
## version1 -0.140
## pattern1 0.041 -0.024
## pattern2 -0.015 -0.034 -0.009
## cor.Ranking -0.538 0.029 0.040 0.050
## vrsn1:pttr1 -0.027 0.031 -0.108 0.003 -0.057
## vrsn1:pttr2 -0.037 -0.010 0.003 -0.174 0.021 -0.007
## vrsn1:cr.Rn 0.039 -0.441 -0.058 0.027 -0.146 0.051 0.047
## pttrn1:cr.R 0.054 -0.058 -0.628 -0.038 0.002 0.001 0.014 -0.068
## pttrn2:cr.R 0.019 0.033 -0.036 -0.674 -0.078 0.042 0.101 -0.033 -0.013
## vrsn1:p1:.R -0.066 0.049 0.001 0.013 -0.066 -0.629 -0.040 -0.003 -0.063
## vrsn1:p2:.R 0.035 0.013 0.042 0.100 -0.025 -0.038 -0.675 -0.077 0.063
## pt2:.R v1:1:.
## version1
## pattern1
## pattern2
## cor.Ranking
## vrsn1:pttr1
## vrsn1:pttr2
## vrsn1:cr.Rn
## pttrn1:cr.R
## pttrn2:cr.R
## vrsn1:p1:.R 0.063
## vrsn1:p2:.R -0.181 -0.010# Comparison of the two models
anova(glmer.ASScore.Exp1.Pattern, glmer.ASScore.Exp1.Importance)Both, cue pattern and the match between intended and rated cue ordering explain some of the variability between subjects and scenarios.
5 5. Analyses Experiment 2
5.1 Analysis of demographic data
As a first step, we will take a look at the demographic characteristics of the sample in Experiment 2.
# Age of subjects
demo.Exp2 %>%
summarise(mean.age = mean(age),
sd.age = sd(age),
min.age = min(age),
max.age = max(age))# Gender of subjects
demo.Exp2 %>%
group_by(sex) %>%
summarise(n.sex = n()) %>%
ungroup() %>%
mutate(percent.sex = n.sex/sum(n.sex))# Job of subjects
demo.Exp2 %>%
group_by(job) %>%
summarise(n.job = n()) %>%
ungroup() %>%
mutate(percent.job = n.job/sum(n.job))We pre-registered an exclusion criterion based on a recognition test, in which subjects had to recognize six of the semantic scenarios and identify six distractor scenarios. We pre-registered that all subjects that answered more than two questions in this recognition test incorrectly, will be excluded from further analyses.
# Create data frame for recognition test data
recognitionTest.Exp2 <- data.Exp2 %>%
# select only recognition test data
filter(data == "recognition.data") %>%
select(ID, list.position:correctness) %>%
group_by(ID, item.type, correctness) %>%
# summarise number of (in)correct answers per person and per tragets/distractors
summarise(n.answers = n()) Looking at the recognition test data, it is apparent that a programming mistake occured, such that sometimes seven targets and five distractors were displayed instead of six of each group.
# Identify subjects that 7 targets instead of 6
recognition7targets.Exp2 <- recognitionTest.Exp2 %>%
group_by(ID, item.type) %>%
# calculate number of items per targets and distractors
summarise(n.items = sum(n.answers)) %>%
ungroup() %>%
# identify subjects that saw too many targets
mutate(tooManyTargets = ifelse(n.items == 7 | n.items == 5, "yes", "no")) %>%
select(-item.type, -n.items) %>%
distinct(ID, tooManyTargets) %>%
# keep only subjects that saw too many targets
filter(tooManyTargets == "yes") %>%
droplevels() %>%
# create a vector of IDs of subjects that saw too many targets
.$ID
# Number of subjects with 7 targets
length(recognition7targets.Exp2)## [1] 138138 of 297 subjects saw too many targets. Next up, we test whether this influenced their performance in the recognition test.
# Performance of subjects that saw 7 vs. 6 targets
performanceRecognitionExp2 <- recognitionTest.Exp2 %>%
# create identifying variable
mutate(sevenTargets = ifelse(ID %in% recognition7targets.Exp2, "yes", "no")) %>%
group_by(sevenTargets, ID, correctness) %>%
# calculate number of correct and incorrect answers
summarise(n.correct = sum(n.answers)) %>%
filter(correctness == "correct") %>%
# calculate performance per participant in percent
mutate(percent.correct = n.correct/12)
# Performance difference between 7 vs. 6 targets?
t.test(percent.correct ~ sevenTargets, data = performanceRecognitionExp2)##
## Welch Two Sample t-test
##
## data: percent.correct by sevenTargets
## t = 0.73322, df = 284.41, p-value = 0.464
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.01535437 0.03358425
## sample estimates:
## mean in group no mean in group yes
## 0.9559748 0.9468599As there is no difference in performance, we will still exclude subjects based on their recognition test answers.
# Create vector of IDs that will be excluded based on the recognition test performance
excludedIDs.Exp2 <- data.Exp2 %>%
# filter recognition test data
filter(data == "recognition.data") %>%
select(ID, list.position:correctness) %>%
group_by(ID, correctness) %>%
# calculate number of correct/incorrect answers per ID
summarise(n.answers = n()) %>%
# filter subjects with more than 2 incorrect answers
filter(correctness == "incorrect" & n.answers > 2) %>%
# create vector of to be excluded IDs
.$ID
# Exclude IDs from demographic data
demo.final.Exp2 <- demo.Exp2 %>%
filter(ID %w/o% excludedIDs.Exp2) %>%
droplevels()
# Exclude IDs from task data
data.final.Exp2 <- data.Exp2 %>%
filter(ID %w/o% excludedIDs.Exp2) %>%
droplevels()Now, we will take a look at the demographic data without the excluded subjects.
# Age of subjects
demo.final.Exp2 %>%
summarise(mean.age = mean(age),
sd.age = sd(age),
min.age = min(age),
max.age = max(age))# Gender of subjects
demo.final.Exp2 %>%
group_by(sex) %>%
summarise(n.sex = n()) %>%
ungroup() %>%
mutate(percent.sex = n.sex/sum(n.sex))# Job of subjects
demo.final.Exp2 %>%
group_by(job) %>%
summarise(n.job = n()) %>%
ungroup() %>%
mutate(percent.job = n.job/sum(n.job))5.2 Pregistered Analysis
For testing our hypothesis, the first relevant analysis step is to calculate the Attraction Search Score. In general the Attraction Search Score is the difference of the probability of searching for one option, given that this option is attractive, minus the probability of searching for the same option, given that this option is not attractive. Thus, a key experimental manipulation is the attractiveness of the options.
The attractiveness of the options in this experiment was manipulated by the valence of the first opened cue: if it is positive, then this option is attractive, if it is negative, then this option is unattractive. Thus, the Attraction Search Score is calculated as the probability of switching the direction of information search to the other option than the option of the first search, given the first search yielded negative evidence, minus the probability of switching the direction of information search to the other option, given the first search yielded positive evidence, \(AS\ Score= p(Switching\ options\ |\ negative\ initial\ evidence) - p(Switching\ options\ |\ positive\ initial\ evidence)\). As a first step, we created a data frame which contains the Attraction Search Score.
# Calculating the AS-Score for every participant
ASScore.Exp2 <- data.final.Exp2 %>%
# filter only data from choice task
filter(data == "choice.data") %>%
select(ID, opened.cue.1, opened.cue.2, first.search.valence) %>%
# create vectors for calculating AS-Score
mutate(first.search.option = ifelse(grepl("A",opened.cue.1), "OptionA", "OptionB"),
second.search.option = ifelse(grepl("A",opened.cue.2), "OptionA", "OptionB"),
first.search.valence = recode(first.search.valence, `1`= "positive", `-1` = "negative")) %>%
# create variable that codes whether the searched for option was switched in the second search
mutate(switching = ifelse((first.search.option == "OptionA" & second.search.option == "OptionA") |
(first.search.option == "OptionB" & second.search.option == "OptionB"),
"no.switch", "switch")) %>%
group_by(ID, switching, first.search.valence) %>%
# calculate number of switches per participant and per positive/negative initial evidence
summarise(n.switches = n()) %>%
ungroup() %>%
# fill in 0 if searched option was not switched for negative/positive inital evidence
complete(ID, switching, first.search.valence, fill = list(n.switches = 0)) %>%
group_by(ID, first.search.valence) %>%
# calculate percentage of trials in which options were switched
mutate(percent.switches = n.switches/sum(n.switches)) %>%
# keep only probabilities for switching
filter(switching == "switch") %>%
select(ID, first.search.valence, percent.switches) %>%
spread(first.search.valence, percent.switches) %>%
# substract probability for switching given negative evidence from probability for switching given positive evidence
mutate(ASScore = negative - positive) To test the hypothesis, that subjects show behavior consistent with the Attraction Search Effect, we run a one-sided, one-sample t-test against zero with the Attraction Search Score as dependent variable, as a positive Attraction Search Score indicates behavior consistent with the Attraction Search Effect.
# One-sided, one-sample t test against zero
t.test(ASScore.Exp2$ASScore, mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.Exp2$ASScore
## t = 6.8231, df = 279, p-value = 2.766e-11
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.09070444 Inf
## sample estimates:
## mean of x
## 0.1196429# Cohen's d
ES.ASScore.Exp2 <- mean(ASScore.Exp2$ASScore)/sd(ASScore.Exp2$ASScore)
print(ES.ASScore.Exp2)## [1] 0.40776015.3 Exploratory Analyses
5.3.1 Attraction Search Score across content scenarios
As in Experiment 1, we want to test whether the Attraction Search Effect also exists in every content scenario. For this purpose, we calculate the Attraction Search Score across individuals and cue patterns for each decision context. As there are no repetitions of scenarios, this analysis results in only one Attraction Search Score per scenario and, thus, does not allow statistical significance tests. We will take a closer look at the between-decision context heterogeneity with a mixed logistic regression analysis with crossed-random effects for subjects and scenarios.
# Calculating the AS-Score for every participant
ASScore.Scenarios.Exp2 <- data.final.Exp2 %>%
# filter only data from choice task
filter(data == "choice.data") %>%
select(OptionA, opened.cue.1, opened.cue.2, first.search.valence) %>%
# create vectors for calculating AS-Score
mutate(first.search.option = ifelse(grepl("A",opened.cue.1), "OptionA", "OptionB"),
second.search.option = ifelse(grepl("A",opened.cue.2), "OptionA", "OptionB"),
first.search.valence = recode(first.search.valence, `1`= "positive", `-1` = "negative")) %>%
# create variable that codes whether the searched for option was switched in the second search
mutate(switching = ifelse((first.search.option == "OptionA" & second.search.option == "OptionA") |
(first.search.option == "OptionB" & second.search.option == "OptionB"),
"no.switch", "switch")) %>%
group_by(OptionA, switching, first.search.valence) %>%
# calculate number of switches per participant and per positive/negative initial evidence
summarise(n.switches = n()) %>%
ungroup() %>%
# fill in 0 if searched option was not switched for negative/positive inital evidence
complete(OptionA, switching, first.search.valence, fill = list(n.switches = 0)) %>%
group_by(OptionA, first.search.valence) %>%
# calculate percentage of trials in which options were switched
mutate(percent.switches = n.switches/sum(n.switches)) %>%
# keep only probabilities for switching
filter(switching == "switch") %>%
select(OptionA, first.search.valence, percent.switches) %>%
spread(first.search.valence, percent.switches) %>%
# substract probability for switching given negative evidence from probability for switching given positive evidence
mutate(ASScore = negative - positive)
# Create table of means and standard deviations of importance ratings
kable(ASScore.Scenarios.Exp2, format = "html", padding = 2) %>%
kable_styling(bootstrap_options = "striped", font_size = 10)| OptionA | negative | positive | ASScore |
|---|---|---|---|
| appartment_A | 0.8424242 | 0.7304348 | 0.1119895 |
| cellcontract_A | 0.8611111 | 0.8014706 | 0.0596405 |
| city_A | 0.8359375 | 0.7434211 | 0.0925164 |
| computer_A | 0.8484848 | 0.7837838 | 0.0647011 |
| granola_A | 0.8275862 | 0.7111111 | 0.1164751 |
| gym_A | 0.9347826 | 0.7183099 | 0.2164727 |
| hairsalon_A | 0.8992248 | 0.7350993 | 0.1641255 |
| hotel_A | 0.8671329 | 0.6861314 | 0.1810015 |
| insurance_A | 0.8698630 | 0.7537313 | 0.1161317 |
| job_A | 0.8617886 | 0.6751592 | 0.1866294 |
| pizza_A | 0.8630137 | 0.7985075 | 0.0645062 |
| weather_A | 0.8865248 | 0.8273381 | 0.0591867 |
5.3.2 Attraction Search Score of zero
Closer inspection of the individual Attraction Search Scores revealed that quite a large number of subjects have an Attraction Search Score of zero.
# Median of Attraction Search Score
median(ASScore.Exp2$ASScore)## [1] 0# Number of subjects with an Attraction Search Score of zero
length(which(ASScore.Exp2$ASScore==0))## [1] 124First of, we will take a look at differences between subjects with an Attraction Search Score of zero and subjects with a non-zero Attraction Search Score.
### Data frame for reaction time differences
reactionTime.Exp2 <- data.final.Exp2 %>%
# keep only choice data
filter(data == "choice.data") %>%
select(ID, first.search.time, second.search.time, time.in.trial) %>%
group_by(ID) %>%
# calculate means and SDs for second searchtime and time in trial
summarise(median.first.searchtime = median(first.search.time),
sd.first.searchtime = sd(first.search.time),
median.second.searchtime = median(second.search.time),
sd.second.searchtime = sd(second.search.time),
median.trialtime = median(time.in.trial),
sd.trialtime = sd(time.in.trial)) %>%
# combine with AS-Score data
left_join(., ASScore.Exp2, by="ID") %>%
# create variable that indicates AS-Scores of zero
mutate(ASScoreZero = ifelse(ASScore == 0, "zero", "non-zero"))
# Difference in first search time?
t.test(median.first.searchtime ~ ASScoreZero, data = reactionTime.Exp2)##
## Welch Two Sample t-test
##
## data: median.first.searchtime by ASScoreZero
## t = 5.2937, df = 274.49, p-value = 2.457e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 288.5735 630.2770
## sample estimates:
## mean in group non-zero mean in group zero
## 1485.712 1026.286# Difference in second search time?
t.test(median.second.searchtime ~ ASScoreZero, data = reactionTime.Exp2)##
## Welch Two Sample t-test
##
## data: median.second.searchtime by ASScoreZero
## t = -1.3312, df = 211.31, p-value = 0.1846
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -474.73636 92.01014
## sample estimates:
## mean in group non-zero mean in group zero
## 2567.782 2759.145# Difference in time in trial?
t.test(median.trialtime ~ ASScoreZero, data = reactionTime.Exp2)##
## Welch Two Sample t-test
##
## data: median.trialtime by ASScoreZero
## t = -0.68517, df = 245.65, p-value = 0.4939
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4323.068 2091.648
## sample estimates:
## mean in group non-zero mean in group zero
## 30641.80 31757.51## Correlation of Attraction Search Score with search times
# First search time
cor.test(reactionTime.Exp2$median.first.searchtime, reactionTime.Exp2$ASScore)##
## Pearson's product-moment correlation
##
## data: reactionTime.Exp2$median.first.searchtime and reactionTime.Exp2$ASScore
## t = 6.0432, df = 278, p-value = 4.844e-09
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2328317 0.4403839
## sample estimates:
## cor
## 0.340753# Second search time
cor.test(reactionTime.Exp2$median.second.searchtime, reactionTime.Exp2$ASScore)##
## Pearson's product-moment correlation
##
## data: reactionTime.Exp2$median.second.searchtime and reactionTime.Exp2$ASScore
## t = -0.38828, df = 278, p-value = 0.6981
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.14012044 0.09419712
## sample estimates:
## cor
## -0.02328139# Time in trial
cor.test(reactionTime.Exp2$median.trialtime, reactionTime.Exp2$ASScore)##
## Pearson's product-moment correlation
##
## data: reactionTime.Exp2$median.trialtime and reactionTime.Exp2$ASScore
## t = 1.0938, df = 278, p-value = 0.275
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.05215926 0.18129271
## sample estimates:
## cor
## 0.06546244### Data frame for difference in average search time
averageSearchTime.Exp2 <- data.final.Exp2 %>%
# select only choice data
filter(data == "choice.data") %>%
select(ID, first.search.time:seventh.search.time, pseudo.eigth.search.time) %>%
# create long data format for search time data
gather(number.search, search.time, -ID) %>%
arrange(ID) %>%
group_by(ID, number.search) %>%
# calculate mean and SD of all search times per participant
summarise(mean.searchtime = mean(search.time, na.rm = TRUE),
sd.searchtime = sd(search.time, na.rm = TRUE)) %>%
# combine with AS-Score data
left_join(., ASScore.Exp2, by="ID") %>%
# create variable that indicates AS-Scores of zero
mutate(ASScoreZero = ifelse(ASScore == 0, "zero", "non-zero"))
# Difference in overall average search time?
t.test(mean.searchtime ~ ASScoreZero, data = averageSearchTime.Exp2)##
## Welch Two Sample t-test
##
## data: mean.searchtime by ASScoreZero
## t = 0.15185, df = 1811.3, p-value = 0.8793
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -244.9218 286.0295
## sample estimates:
## mean in group non-zero mean in group zero
## 3828.125 3807.571cor.test(averageSearchTime.Exp2$mean.searchtime, averageSearchTime.Exp2$ASScore)##
## Pearson's product-moment correlation
##
## data: averageSearchTime.Exp2$mean.searchtime and averageSearchTime.Exp2$ASScore
## t = 0.14261, df = 1896, p-value = 0.8866
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.04172455 0.04826156
## sample estimates:
## cor
## 0.003275137### Data frame for difference in instruction check answers
instructionCheck.Exp2 <- data.final.Exp2 %>%
# select only instruction check data
filter(data == "instruction.check.data") %>%
group_by(ID) %>%
# select last repetition of instruction check for each participant
filter(row_number()==n()) %>%
# combine with AS-Score data
left_join(., ASScore.Exp2, by="ID") %>%
# create variable that indicates AS-Scores of zero
mutate(ASScoreZero = ifelse(ASScore == 0, "zero", "non-zero"))
# Difference in number of repetitions of instruction check?
t.test(attempt ~ ASScoreZero, data = instructionCheck.Exp2)##
## Welch Two Sample t-test
##
## data: attempt by ASScoreZero
## t = -0.83465, df = 201.31, p-value = 0.4049
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.17034706 0.06902365
## sample estimates:
## mean in group non-zero mean in group zero
## 1.102564 1.153226### Data frame for difference in recognition test performance
# combine recognition test data with AS-Score data
recognitionPerformance.Exp2<- left_join(performanceRecognitionExp2, ASScore.Exp2, by="ID") %>%
filter(!is.na(negative)) %>%
# create variable that indicates AS-Scores of zero
mutate(ASScoreZero = ifelse(ASScore == 0, "zero", "non-zero"))## Warning: Column `ID` joining factors with different levels, coercing to
## character vector# Difference in number of recognition test performance?
t.test(percent.correct ~ ASScoreZero, data = recognitionPerformance.Exp2)##
## Welch Two Sample t-test
##
## data: percent.correct by ASScoreZero
## t = -0.6056, df = 266.8, p-value = 0.5453
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.013552176 0.007176384
## sample estimates:
## mean in group non-zero mean in group zero
## 0.9732906 0.9764785### Data frame for number of searches
numberSearches.Exp2 <- data.final.Exp2 %>%
# select only choice data
filter(data == "choice.data") %>%
select(ID, opened.cue.1:cuesLeft2Search) %>%
# create trial variable
mutate(trial = rep(1:12, nrow(ASScore.Exp2))) %>%
# create long format for searched cue value data
gather(number.searched, searched.cv, -ID, -cuesLeft2Search, -trial) %>%
arrange(ID, trial) %>%
select(-number.searched)%>%
group_by(ID, trial) %>%
# calculate number of searches
summarise(cuesLeft2Search = mean(cuesLeft2Search),
n.searches = sum(!is.na(searched.cv)))
### Data frame for difference in average number of searches
avg.numberSearches.Exp2 <- numberSearches.Exp2%>%
group_by(ID) %>%
# calculate mean number of searches and sum of unsearched cues per participant
summarise(mean.n.searches = mean(n.searches),
cuesLeft = sum(cuesLeft2Search)) %>%
# combine with AS-Score data
left_join(., ASScore.Exp2, by="ID") %>%
# create variable that indicates AS-Scores of zero
mutate(ASScoreZero = ifelse(ASScore == 0, "zero", "non-zero"))
# Difference in number of searches?
t.test(mean.n.searches ~ ASScoreZero, data = avg.numberSearches.Exp2)##
## Welch Two Sample t-test
##
## data: mean.n.searches by ASScoreZero
## t = -2.6086, df = 277.09, p-value = 0.009586
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.26184359 -0.03661243
## sample estimates:
## mean in group non-zero mean in group zero
## 4.567842 4.717070# Calculate Hedge's g
cohen.d(mean.n.searches ~ ASScoreZero, data = avg.numberSearches.Exp2, hedges.correction=TRUE)##
## Hedges's g
##
## g estimate: -0.30307 (small)
## 95 percent confidence interval:
## lower upper
## -0.54124470 -0.06489539# How many subjects with an Attraction Search Score of zero searched for all possible information?
avg.numberSearches.Exp2 %>%
# create variable indicating whether all possible cue values have been searched
mutate(search.all = ifelse(cuesLeft==0, "yes", "no")) %>%
select(ID, search.all, ASScoreZero) %>%
group_by(ASScoreZero, search.all) %>%
# calculate number of subjects that searched all possible information for AS-Scores = 0/AS-Scores != 0
summarise(n = n()) %>%
group_by(ASScoreZero) %>%
# calculate percent of subjects that searched all information for AS-Scores = 0/AS-Scores != 0
mutate(percent = n/sum(n))One possible explanation for an Attraction Search Score of zero is that subjects used predetermined, fixed search strategies. We defined three possible search strategies: cue-wise, lenient cue-wise, and option-wise. As we do not know the subjective validity ordering for each participant, cue-wise search was defined as always searching for information on the same cue consecutively and always starting search for a new cue on the same option side. Lenient cue-wise search is defined similarily to cue-wise search but allows for starting search for a new cue on both options. Option-wise search is defined as searching first all information on one option and then all information on the other option.
### Classifying trials as cue-wise (cw), lenient cue-wise (lcw), and option-wise (ow) search
# Preparation of data frame for strategy classification
strategies.Exp2 <- data.final.Exp2 %>%
# select only choice data
filter(data == "choice.data") %>%
select(ID, opened.cue.1:opened.cue.7) %>%
# create varibles with number of searches and individual trials
mutate(n.searches = numberSearches.Exp2$n.searches,
trial = rep(1:12, nrow(ASScore.Exp2))) %>%
# tranform data in long format for searched for cue values
gather(num.search, searched.cv, -ID, -n.searches, -trial) %>%
arrange(ID, trial) %>%
filter(!is.na(searched.cv)) %>%
# create variables for searched option and searched for cue value
mutate(searched.option = ifelse(grepl("A",searched.cv),"OptionA", "OptionB"),
searched.cue = substring(searched.cv, 1, 4),
strategy = NA)
# Loop classifying trials into cue-wise/lenient cue-wise/option-wise/non-classified search strategies
for(n in unique(strategies.Exp2$ID)) { # loop over subjects
for(t in 1:12) { # loop over trials
# Preparation: extract relevant trial data
n.searches <- strategies.Exp2$n.searches[strategies.Exp2$ID == n & strategies.Exp2$trial == t][1]
searched.options <- strategies.Exp2$searched.option[strategies.Exp2$ID == n & strategies.Exp2$trial == t]
searched.cues <- strategies.Exp2$searched.cue[strategies.Exp2$ID == n & strategies.Exp2$trial == t]
searched.cuevalues <- strategies.Exp2$searched.cv[strategies.Exp2$ID == n & strategies.Exp2$trial == t]
current.strategy <- 0
# cue-wise classification
if(all(duplicated(searched.cues)[seq(2,n.searches,2)])){ # always two consecutives cues are equal?
# tests whether odd options/even options are always equal
if(n_distinct(searched.options[seq(1,n.searches,2)]) == 1 & n_distinct(searched.options[seq(2,n.searches,2)]) == 1){
current.strategy <- "cw"
} else {
current.strategy <- "lcw"
}
}
# option-wise classification
if(n.searches <= 4) {
if(n_distinct(searched.options) == 1){ # less than 4 searches and only for one option?
current.strategy <- "ow"
}
} else {
# tests whether first 4 searches are all for one option and remaining searches are all for other option
if(n_distinct(searched.options[1:4]) == 1 & n_distinct(searched.options[5:n.searches])) {
current.strategy <- "ow"
}
}
# Non classified subjects
if(current.strategy == 0){ # no strategy assigned yet?
current.strategy <- "not.classified"
}
# save results in strategies.Exp2 data frame
strategies.Exp2$strategy[strategies.Exp2$ID == n & strategies.Exp2$trial == t] <- rep(current.strategy, n.searches)
}
}To test whether pre-determined search strategies can explain the overall lower Attraction Search Scores, we correlate the individual number of trials belonging to one of the four strategies with the individual Attraction Search Scores.
# Create data frame with number of trials belonging to each strategy per person
n.strategies.Exp2 <- strategies.Exp2 %>%
# select one row per trial per participant
filter(num.search == "opened.cue.1") %>%
group_by(ID, strategy) %>%
# calculate number of trials belonging to each strategy per person
summarise(n.strategies = n()) %>%
ungroup() %>%
# fill in 0 if a strategy was not used by subjects
complete(ID, strategy, fill = list(n.strategies=0)) %>%
# calculate percent of trials following each strategy per participant
mutate(percent.strategies = n.strategies/12) %>%
# combine with AS-Score data
left_join(., ASScore.Exp2, by = "ID") %>%
# change labels of strategy vector
mutate(strategy = factor(strategy, levels=c("cw", "lcw", "ow", "not.classified"),
labels = c("cue-wise", "lenient cue-wise", "option-wise", "not classified")))
# Average number of strategies over all subjects
n.strategies.Exp2 %>%
group_by(strategy) %>%
summarise(mean.strategy = mean(percent.strategies),
sd.strategy = sd(percent.strategies))# Correlation of AS-Score with individual number of strictly cue-wise trials
cor.test(n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy=="cue-wise"], n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy=="cue-wise"])##
## Pearson's product-moment correlation
##
## data: n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy == and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "cue-wise"] "cue-wise"] and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "cue-wise"]
## t = -5.442, df = 278, p-value = 1.157e-07
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.4125010 -0.2003485
## sample estimates:
## cor
## -0.3102829# Correlation of AS-Score with individual number of lenient cue-wise trials
cor.test(n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy=="lenient cue-wise"], n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy=="lenient cue-wise"])##
## Pearson's product-moment correlation
##
## data: n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy == and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "lenient cue-wise"] "lenient cue-wise"] and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "lenient cue-wise"]
## t = -2.6881, df = 278, p-value = 0.007619
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.27132635 -0.04274332
## sample estimates:
## cor
## -0.1591673# Correlation of AS-Score with individual number of option-wise trials
cor.test(n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy=="option-wise"], n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy=="option-wise"])##
## Pearson's product-moment correlation
##
## data: n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy == and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "option-wise"] "option-wise"] and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "option-wise"]
## t = 4.8816, df = 278, p-value = 1.776e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.1693423 0.3855097
## sample estimates:
## cor
## 0.2809861# Correlation of AS-Score with individual number of non-classified trials
cor.test(n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy=="not classified"], n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy=="not classified"])##
## Pearson's product-moment correlation
##
## data: n.strategies.Exp2$n.strategies[n.strategies.Exp2$strategy == and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "not classified"] "not classified"] and n.strategies.Exp2$ASScore[n.strategies.Exp2$strategy == "not classified"]
## t = 4.925, df = 278, p-value = 1.45e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.1717619 0.3876294
## sample estimates:
## cor
## 0.28327985.3.3 Generalized linear mixed model
As in Experiment 1, we also ran a trial-level generalized linear mixed model, with switching options for the second search vs. not switching options for the second search as dependent variable, a random intercepts and slopes for subjects and scenarios, and the valence of the first uncovered cue value as predictor.
# Create dataframe for generalized linear mixed model analysis
GLMER.data.Exp2 <- data.final.Exp2 %>%
# select only choice data
filter(data == "choice.data") %>%
select(ID, opened.cue.1, opened.cue.2, first.search.valence, OptionA) %>%
# create relevant variables for determining switching
mutate(first.search.option = ifelse(grepl("A",opened.cue.1), "OptionA", "OptionB"),
second.search.option = ifelse(grepl("A",opened.cue.2), "OptionA", "OptionB"),
first.search.valence = recode(first.search.valence, `1`= "positive", `-1` = "negative")) %>%
# create variable for switching
mutate(switching = ifelse((first.search.option == "OptionA" & second.search.option == "OptionA") |
(first.search.option == "OptionB" & second.search.option == "OptionB"),
"no.switch", "switch")) %>%
select(ID, first.search.valence, switching, OptionA) %>%
# create "decisions" variable
mutate(decision.context = as.factor(paste(first.search.valence, OptionA, sep = "."))) %>%
# create variables for logistic multilevel regression
mutate(switching.av = ifelse(switching == "switch", 0, 1),
valence = factor(first.search.valence, levels=c("positive", "negative")),
trial = rep(1:12, n_distinct(ASScore.Exp2$ID)),
scenario = as.factor(OptionA))
# Assign effect-coded contrast to valence predictor
contrasts(GLMER.data.Exp2$valence) <- contr.sum(2)
contrasts(GLMER.data.Exp2$valence)## [,1]
## positive 1
## negative -1# Full model
glmer.ASScore.Exp2.full <- glmer(switching.av ~ valence+(1 + valence|ID) + (1 + valence|scenario),
data = GLMER.data.Exp2, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))## singular fitsummary(glmer.ASScore.Exp2.full)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: switching.av ~ valence + (1 + valence | ID) + (1 + valence |
## scenario)
## Data: GLMER.data.Exp2
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 2723.1 2772.1 -1353.6 2707.1 3352
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3021 -0.3806 -0.2024 -0.1639 3.3610
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 3.13935 1.7718
## valence1 0.60804 0.7798 0.41
## scenario (Intercept) 0.01607 0.1268
## valence1 0.01105 0.1051 1.00
## Number of obs: 3360, groups: ID, 280; scenario, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2909 0.1489 -15.381 < 2e-16 ***
## valence1 0.3704 0.1105 3.352 0.000802 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## valence1 0.107
## convergence code: 0
## singular fit# Modelfit is singular: reduce random effects structure
### 1st: remove correlations of random slopes and random intercepts
glmer.ASScore.Exp2.noCorrID <- glmer(switching.av ~ valence+(1 + valence||ID) + (1 + valence|scenario),
data = GLMER.data.Exp2, family = binomial)## singular fitsummary(glmer.ASScore.Exp2.noCorrID)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: switching.av ~ valence + (1 + valence || ID) + (1 + valence |
## scenario)
## Data: GLMER.data.Exp2
##
## AIC BIC logLik deviance df.resid
## 2725.1 2780.2 -1353.6 2707.1 3351
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3021 -0.3806 -0.2024 -0.1639 3.3610
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 1.10363 1.0505
## ID.1 valencepositive 3.76327 1.9399
## valencenegative 1.52425 1.2346 0.60
## scenario (Intercept) 0.01607 0.1268
## valence1 0.01105 0.1051 1.00
## Number of obs: 3360, groups: ID, 280; scenario, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2909 0.1489 -15.381 < 2e-16 ***
## valence1 0.3704 0.1105 3.352 0.000802 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## valence1 0.107
## convergence code: 0
## singular fit# singular fit
glmer.ASScore.Exp2.noCorrScenario <- glmer(switching.av ~ valence+(1 + valence|ID) + (1 + valence||scenario),
data = GLMER.data.Exp2, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))## singular fitsummary(glmer.ASScore.Exp2.noCorrScenario)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: switching.av ~ valence + (1 + valence | ID) + (1 + valence ||
## scenario)
## Data: GLMER.data.Exp2
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 2725.1 2780.2 -1353.6 2707.1 3351
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3021 -0.3806 -0.2024 -0.1639 3.3610
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 3.1393495 1.77182
## valence1 0.6080411 0.77977 0.41
## scenario (Intercept) 0.0000000 0.00000
## scenario.1 valencepositive 0.0537835 0.23191
## valencenegative 0.0004686 0.02165 1.00
## Number of obs: 3360, groups: ID, 280; scenario, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2909 0.1489 -15.381 < 2e-16 ***
## valence1 0.3704 0.1105 3.352 0.000802 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## valence1 0.107
## convergence code: 0
## singular fit# singular fit
glmer.ASScore.Exp2.noCorr <- glmer(switching.av ~ valence+(1 + valence||ID) + (1 + valence||scenario),
data = GLMER.data.Exp2, family = binomial)## singular fitsummary(glmer.ASScore.Exp2.noCorr)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: switching.av ~ valence + (1 + valence || ID) + (1 + valence ||
## scenario)
## Data: GLMER.data.Exp2
##
## AIC BIC logLik deviance df.resid
## 2727.1 2788.3 -1353.6 2707.1 3350
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3021 -0.3806 -0.2024 -0.1639 3.3610
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.8943618 0.94571
## ID.1 valencepositive 3.9725387 1.99312
## valencenegative 1.7335193 1.31663 0.62
## scenario (Intercept) 0.0000000 0.00000
## scenario.1 valencepositive 0.0537835 0.23191
## valencenegative 0.0004686 0.02165 1.00
## Number of obs: 3360, groups: ID, 280; scenario, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2909 0.1489 -15.381 < 2e-16 ***
## valence1 0.3704 0.1105 3.352 0.000802 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## valence1 0.107
## convergence code: 0
## singular fit# singular fit
### 2nd: remove highest order effects with least variance (random slope for decision context)
glmer.ASScore.Exp2.rSID <- glmer(switching.av ~ valence+(1 + valence|ID) + (1|scenario),
data = GLMER.data.Exp2, family = binomial)
summary(glmer.ASScore.Exp2.rSID)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: switching.av ~ valence + (1 + valence | ID) + (1 | scenario)
## Data: GLMER.data.Exp2
##
## AIC BIC logLik deviance df.resid
## 2720.7 2757.4 -1354.4 2708.7 3354
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.2860 -0.3876 -0.1991 -0.1622 3.5075
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 3.12372 1.7674
## valence1 0.59755 0.7730 0.40
## scenario (Intercept) 0.01484 0.1218
## Number of obs: 3360, groups: ID, 280; scenario, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2865 0.1483 -15.42 < 2e-16 ***
## valence1 0.3793 0.1059 3.58 0.000344 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## valence1 0.029# Final model for plots
glmer.ASScore.Exp2.final <- glmer.ASScore.Exp2.rSIDThe significant, positive effect of valence on switching options, indicates that subjects are more likely to not switch options when the first piece of information they uncover is positive compared to negative. Nonetheless, there is quite some variance due to subjects. We try to explain this variance by adding the centered number of trials belonging to any strategy as predictor to the model.
# Data frame with count of trials with strategies
count.strategies.Exp2 <- n.strategies.Exp2 %>%
mutate(used.strategy = ifelse(strategy == "not classified", "no", "yes")) %>%
group_by(ID, used.strategy) %>%
summarise(count.strategies = sum(n.strategies)) %>%
filter(used.strategy == "yes") %>%
select(-used.strategy) %>%
ungroup() %>%
mutate(c.count.strategies = count.strategies - mean(count.strategies))
# Combine data frames
GLMER.strategy.data.Exp2 <- left_join(GLMER.data.Exp2, count.strategies.Exp2, by = c("ID"))
# Assign effect-coded contrast to valence predictor
contrasts(GLMER.strategy.data.Exp2$valence) <- contr.sum(2)
contrasts(GLMER.strategy.data.Exp2$valence)## [,1]
## positive 1
## negative -1### Mixed model with count data of used strategies
glmer.ASScore.Exp2.strategy <- glmer(switching.av ~ valence*c.count.strategies+(1 + valence|ID) + (1|scenario),
data = GLMER.strategy.data.Exp2, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
summary(glmer.ASScore.Exp2.strategy)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: switching.av ~ valence * c.count.strategies + (1 + valence |
## ID) + (1 | scenario)
## Data: GLMER.strategy.data.Exp2
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 2615.0 2664.0 -1299.5 2599.0 3352
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.0509 -0.3775 -0.1954 -0.1239 4.0261
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 1.95542 1.3984
## valence1 0.58657 0.7659 0.26
## scenario (Intercept) 0.01374 0.1172
## Number of obs: 3360, groups: ID, 280; scenario, 12
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.32432 0.13266 -17.521 < 2e-16 ***
## valence1 0.38405 0.10573 3.632 0.000281 ***
## c.count.strategies -0.41312 0.04136 -9.989 < 2e-16 ***
## valence1:c.count.strategies -0.08565 0.03164 -2.707 0.006787 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) valnc1 c.cnt.
## valence1 -0.052
## c.cnt.strtg 0.327 -0.003
## vlnc1:c.cn. -0.010 0.483 0.122The results of this model show that there is an interaction of the number of trials classified as belonging to a strategy with the valence of the first piece of opened information such that the less trials follow a strategy the stronger is the effect of the initial valence.
6 6. Analyses Experiment 3
6.1 Analysis of demographic data
As a first step, we will take a look at the demographic characteristics of the sample in Experiment 3.
# Age of subjects
demo.Exp3 %>%
summarise(mean.age = mean(age),
sd.age = sd(age),
min.age = min(age),
max.age = max(age))# Gender of subjects
demo.Exp3 %>%
group_by(sex) %>%
summarise(n.sex = n()) %>%
ungroup() %>%
mutate(percent.sex = n.sex/sum(n.sex))We pre-registered an exclusion criterion based on the instruction check, in which subjects had to answer questions about the upcoming task correctly before continuing with the task. We pre-registered that all subjects, that had to repeat the instruction check 2 or more times, will be excluded from further analyses.
# Exclusion Criterion: 2 or more repetitions of instructions
excludedIDs.Exp3 <- data.Exp3 %>%
filter(!is.na(instrCheck.attempt)) %>%
# select subjects that hat to repeat instruction check 2 or more times
filter(instrCheck.attempt >= 2) %>%
# create vector with IDs
.$ID
# Exclude IDs from demographic data
demo.final.Exp3 <- demo.Exp3 %>%
filter(ID %w/o% excludedIDs.Exp3) %>%
droplevels()
# Exclude IDs from task data
data.final.Exp3 <- data.Exp3 %>%
filter(ID %w/o% excludedIDs.Exp3) %>%
droplevels()Now, we will take a look at the demographic data information without the excluded subjects.
# Age of subjects
demo.final.Exp3 %>%
summarise(mean.age = mean(age),
sd.age = sd(age),
min.age = min(age),
max.age = max(age))# Gender of subjects
demo.final.Exp3 %>%
group_by(sex) %>%
summarise(n.sex = n()) %>%
ungroup() %>%
mutate(percent.sex = n.sex/sum(n.sex))# Language of subjects
demo.final.Exp3 %>%
group_by(english.level) %>%
summarise(n.language = n()) %>%
ungroup() %>%
mutate(percent.language = n.language/sum(n.language))# Job of subjects
demo.final.Exp3 %>%
group_by(employment.status) %>%
summarise(n.job = n()) %>%
ungroup() %>%
mutate(percent.job = n.job/sum(n.job))6.2 Pregistered Analysis
In Experiment 3, the attractiveness of the options is again manipulated via the version of the patterns: in Version a Option A is attractive, in Version b Option B is attractive (and, thus, Option A is unattractive). Thus, the Attraction Search Score is calculated as the probability of searching for information on Option A in Version a minus the probability of searching for Option A in Version b, \(AS\ Score= p(Searching\ for\ Option\ A\ |\ Version\ a) - p(Searching\ for\ Option\ A\ |\ Version\ b)\). As a first step, we create a data frame which contains the Attraction Search Score.
# Calculating the AS-Score for every participant
ASScore.Exp3 <- data.final.Exp3 %>%
# select data from choice task
filter(data == "choice.data" & phase == "task") %>%
select(ID, version, opened.cue) %>%
mutate(searched.option = ifelse(grepl("A",opened.cue),"OptionA", "OptionB"))%>%
select(-opened.cue) %>%
group_by(ID, version, searched.option) %>%
# calculate number of searches per version and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(ID,version,searched.option,fill = list(n.searches=0)) %>%
group_by(ID, version) %>%
# calculate probability of search given version
mutate(percent.searches = n.searches/sum(n.searches)) %>%
# select only probabilities of searching for Option A
filter(searched.option == "OptionA") %>%
select(-searched.option, -n.searches) %>%
spread(version, percent.searches) %>%
select(ID, VersionA = a, VersionB = b) %>%
# Substract probabilities of searching for Option A depending on Version
mutate(ASScore = VersionA - VersionB) To test the hypothesis, that subjects show behavior consistent with the Attraction Search Effect, we run a one-sided, one-sample t-test against zero with the Attraction Search Score as dependent variable, as a positive Attraction Search Score indicates behavior consistent with the Attraction Search Effect.
# One-sided, one-sample t test against zero
t.test(ASScore.Exp3$ASScore, mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.Exp3$ASScore
## t = 7.9163, df = 88, p-value = 3.434e-12
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2376926 Inf
## sample estimates:
## mean of x
## 0.3008739# Cohen's d
ES.ASScore.Exp3 <- mean(ASScore.Exp3$ASScore)/sd(ASScore.Exp3$ASScore)
print(ES.ASScore.Exp3)## [1] 0.83912136.3 Exploratory Analyses
6.3.1 Attraction Search Score in each single pattern
The next analysis step is to test whether the Attraction Search Score is significant for the separate cue value patterns. In order to test this hypothesis, we need to calculate the Attraction Search Score on the level of patterns. It is important to note, that the three used cue patterns are described in the data by the number they had in the Jekel et al. (2018) paper - in the manuscript, we gave new numbers to the used cue value patterns. Pattern 5 in the Markdown is Pattern 1 in the manuscript, Pattern 6 is Pattern 2, and Pattern 7 is Pattern 3 in the Manuscript.
# Calculate Attraction Search Score per pattern
ASScore.pattern.Exp3 <- data.final.Exp3 %>%
# select choice task data
filter(data == "choice.data" & phase == "task") %>%
select(ID, pattern, version, opened.cue) %>%
mutate(searched.option = ifelse(grepl("A",opened.cue),"OptionA", "OptionB"))%>%
group_by(ID, pattern, version, searched.option) %>%
# calculate number of searches per pattern, version, and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(ID, pattern, version, searched.option, fill = list(n.searches=0)) %>%
group_by(ID, pattern, version) %>%
# calculate probability of search given version
mutate(percent.searches = n.searches/sum(n.searches)) %>%
# select only probabilities of searching for Option A
filter(searched.option == "OptionA") %>%
select(-searched.option, -n.searches) %>%
spread(version, percent.searches) %>%
select(ID, pattern, VersionA = a, VersionB = b) %>%
# Substract probabilities of searching for Option A depending on Version
mutate(ASScore = VersionA - VersionB) To test the hypothesis, that subjects show behavior consistent with the Attraction Search Effect in each cue value pattern, we run a one-sided, one-sample t-test against zero with the Attraction Search Score as dependent variable for each pattern, as a positive Attraction Search Score indicates behavior consistent with the Attraction Search Effect.
# One-sided, one-sample t test against zero for Pattern 5
t.test(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 5], mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 5]
## t = 5.4709, df = 88, p-value = 2.078e-07
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.12515 Inf
## sample estimates:
## mean of x
## 0.1797753# Cohen's d for Pattern 5
ES.ASScore.pattern5.Exp3 <- mean(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 5])/sd(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 5])
print(ES.ASScore.pattern5.Exp3)## [1] 0.5799158# One-sided, one-sample t test against zero for Pattern 6
t.test(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 6], mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 6]
## t = 6.8718, df = 88, p-value = 4.35e-10
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2952866 Inf
## sample estimates:
## mean of x
## 0.3895131# Cohen's d for Pattern 6
ES.ASScore.pattern6.Exp3 <- mean(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 6])/sd(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 6])
print(ES.ASScore.pattern6.Exp3)## [1] 0.7284127# One-sided, one-sample t test against zero for Pattern 7
t.test(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 7], mu = 0, alternative = "greater")##
## One Sample t-test
##
## data: ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 7]
## t = 6.2267, df = 88, p-value = 7.916e-09
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2443433 Inf
## sample estimates:
## mean of x
## 0.3333333# Cohen's d for Pattern 7
ES.ASScore.pattern7.Exp3 <- mean(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 7])/sd(ASScore.pattern.Exp3$ASScore[ASScore.pattern.Exp3$pattern == 7])
print(ES.ASScore.pattern7.Exp3)## [1] 0.6600336.3.2 Attraction Search Score in each shopping item
Lastly, we want to test whether the Attraction Search Effect also exists in every content scenario. For this purpose, we calculate the Attraction Search Score across individuals and cue patterns for each decision context. As there are no repetitions of scenarios, this analysis results in only one Attraction Search Score per scenario and, thus, does not allow statistical significance tests. We will take a closer look at the between-decision context heterogeneity with a mixed logistic regression analysis with crossed-random effects for subjects and scenarios.
# Calculating the AS-Score for every participant
ASScore.Scenarios.Exp3 <- data.final.Exp3 %>%
# select data from choice task
filter(data == "choice.data" & phase == "task") %>%
select(shop.item, version, opened.cue) %>%
mutate(searched.option = ifelse(grepl("A",opened.cue),"OptionA", "OptionB"))%>%
select(-opened.cue) %>%
group_by(shop.item, version, searched.option) %>%
# calculate number of searches per version and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(shop.item,version,searched.option,fill = list(n.searches=0)) %>%
group_by(shop.item, version) %>%
# calculate probability of search given version
mutate(percent.searches = n.searches/sum(n.searches)) %>%
# select only probabilities of searching for Option A
filter(searched.option == "OptionA") %>%
select(-searched.option, -n.searches) %>%
spread(version, percent.searches) %>%
select(shop.item, VersionA = a, VersionB = b) %>%
# Substract probabilities of searching for Option A depending on Version
mutate(ASScore = VersionA - VersionB)
# Create table of means and standard deviations of importance ratings
kable(ASScore.Scenarios.Exp3, format = "html", padding = 2) %>%
kable_styling(bootstrap_options = "striped", font_size = 10)| shop.item | VersionA | VersionB | ASScore |
|---|---|---|---|
| blazer_blue | 0.6111111 | 0.2285714 | 0.3825397 |
| dress_black | 0.5581395 | 0.2173913 | 0.3407482 |
| dress_floral | 0.4255319 | 0.2142857 | 0.2112462 |
| dress_grey | 0.4761905 | 0.1276596 | 0.3485309 |
| jacket_floral | 0.4468085 | 0.2142857 | 0.2325228 |
| jacket_fur | 0.4285714 | 0.1702128 | 0.2583587 |
| jacket_green | 0.5200000 | 0.2051282 | 0.3148718 |
| jacket_grey | 0.5348837 | 0.1521739 | 0.3827098 |
| jacket_jeans | 0.5853659 | 0.1875000 | 0.3978659 |
| pullover_blue | 0.5952381 | 0.4468085 | 0.1484296 |
| pullover_grey | 0.5348837 | 0.1956522 | 0.3392315 |
| pullover_white | 0.4893617 | 0.1190476 | 0.3703141 |
| shirt_red | 0.4090909 | 0.2000000 | 0.2090909 |
| shirt_stripes | 0.6250000 | 0.2244898 | 0.4005102 |
| shorts_jeans | 0.4042553 | 0.1428571 | 0.2613982 |
| shorts_pink | 0.5000000 | 0.2325581 | 0.2674419 |
| top_black | 0.4800000 | 0.1025641 | 0.3774359 |
| top_white | 0.4848485 | 0.2678571 | 0.2169913 |
6.3.3 Generalized linear mixed model analyses
As in Experiments 1 and 2, we also ran a trial-level generalized linear mixed model, with searching for Option A vs. searching for Option B as the dependent variable, a random intercepts and slopes for subjects and scenarios, and pattern version as a Level 1 predictor.
# Create dataframe for generalized linear mixed model analysis
GLMER.data.Exp3 <- data.final.Exp3 %>%
# select only search data
filter(data == "choice.data" & phase == "task") %>%
select(ID, version, pattern, opened.cue, shop.item) %>%
mutate(searched.option = ifelse(grepl("A",opened.cue),"OptionA", "OptionB")) %>%
mutate(version = as.factor(version),
# recode DV for logistic multilevel regression
searched.option.av = recode(searched.option, OptionA = 1, OptionB = 0),
shop.item = as.factor(shop.item),
ID = as.factor(ID))
# Assign effect-coding contrast to version predictor
contrasts(GLMER.data.Exp3$version) <- contr.sum(2)
contrasts(GLMER.data.Exp3$version)## [,1]
## a 1
## b -1# Run generalized linear mixes model
glmer.ASScore.Exp3.full <- glmer(searched.option.av ~ version+(1 + version|ID)+(1 + version|shop.item),
data = GLMER.data.Exp3, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))## singular fitsummary(glmer.ASScore.Exp3.full)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## searched.option.av ~ version + (1 + version | ID) + (1 + version |
## shop.item)
## Data: GLMER.data.Exp3
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 1850.8 1893.8 -917.4 1834.8 1594
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.0588 -0.6001 -0.4207 0.7222 3.2438
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.104978 0.32400
## version1 0.625835 0.79110 0.66
## shop.item (Intercept) 0.048945 0.22123
## version1 0.003691 0.06076 -1.00
## Number of obs: 1602, groups: ID, 89; shop.item, 18
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.72768 0.09007 -8.079 6.52e-16 ***
## version1 0.76790 0.10723 7.161 8.01e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## version1 0.006
## convergence code: 0
## singular fit# boundary (singular) fit
#
# due to singular fit, compare different random effect structures
### 1st: remove correlations
glmer.ASScore.Exp3.noCorrID <- glmer(searched.option.av ~ version+(1 + version||ID)+(1 + version|shop.item),
data = GLMER.data.Exp3, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))## singular fitsummary(glmer.ASScore.Exp3.noCorrID)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## searched.option.av ~ version + (1 + version || ID) + (1 + version |
## shop.item)
## Data: GLMER.data.Exp3
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 1852.8 1901.2 -917.4 1834.8 1593
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.0588 -0.6001 -0.4207 0.7222 3.2438
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.009460 0.09726
## ID.1 versiona 1.060749 1.02993
## versionb 0.381960 0.61803 -0.83
## shop.item (Intercept) 0.048945 0.22123
## version1 0.003691 0.06076 -1.00
## Number of obs: 1602, groups: ID, 89; shop.item, 18
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.72768 0.09007 -8.079 6.52e-16 ***
## version1 0.76790 0.10723 7.161 8.01e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## version1 0.006
## convergence code: 0
## singular fit# singular fit
glmer.ASScore.Exp3.noCorrShopitem <- glmer(searched.option.av ~ version+(1 + version|ID)+(1 + version||shop.item),
data = GLMER.data.Exp3, family = binomial)
summary(glmer.ASScore.Exp3.noCorrShopitem)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## searched.option.av ~ version + (1 + version | ID) + (1 + version ||
## shop.item)
## Data: GLMER.data.Exp3
##
## AIC BIC logLik deviance df.resid
## 1852.8 1901.2 -917.4 1834.8 1593
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.0588 -0.6001 -0.4207 0.7222 3.2438
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 1.050e-01 0.3239990
## version1 6.258e-01 0.7910679 0.66
## shop.item (Intercept) 5.537e-08 0.0002353
## shop.item.1 versiona 2.576e-02 0.1604932
## versionb 7.950e-02 0.2819601 1.00
## Number of obs: 1602, groups: ID, 89; shop.item, 18
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.72768 0.09007 -8.079 6.52e-16 ***
## version1 0.76788 0.10723 7.161 8.01e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## version1 0.006# fits, but due to perfect correlation between between random slope predictors for shop item compare with model without random slope for shop item
### 2nd: remove highest order effects with least variance (random slope for shop items)
glmer.ASScore.Exp3.rSID <- glmer(searched.option.av ~ version+(1 + version|ID)+(1|shop.item),
data = GLMER.data.Exp3, family = binomial)
summary(glmer.ASScore.Exp3.rSID)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## searched.option.av ~ version + (1 + version | ID) + (1 | shop.item)
## Data: GLMER.data.Exp3
##
## AIC BIC logLik deviance df.resid
## 1847.4 1879.7 -917.7 1835.4 1596
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.0908 -0.6002 -0.4222 0.7195 3.2277
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.10849 0.3294
## version1 0.62965 0.7935 0.67
## shop.item (Intercept) 0.04672 0.2162
## Number of obs: 1602, groups: ID, 89; shop.item, 18
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.72151 0.08917 -8.091 5.91e-16 ***
## version1 0.76289 0.10622 7.183 6.84e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## version1 0.099# Final model for plots
glmer.ASScore.Exp3.final <- glmer.ASScore.Exp3.rSIDThe significant, positive effect of the predictor pattern version shows that subjects were more likely to search for Option A when presented with Version a as compared to Version b. To explain some of the variability, we ran a mixed logistic regression with the cue patterns as predictors.
# Create dataframe for generalized linear mixed model analysis
GLMER.data.predictor.Exp3 <- GLMER.data.Exp3 %>%
mutate(pattern = as.factor(pattern))
# Assign helmert-coding contrast to pattern predictor
contrasts(GLMER.data.predictor.Exp3$version) <- contr.sum(2)
contrasts(GLMER.data.predictor.Exp3$pattern) <- contr.helmert(3)
contrasts(GLMER.data.predictor.Exp3$pattern)## [,1] [,2]
## 5 -1 -1
## 6 1 -1
## 7 0 2# Does pattern interact with version?
glmer.ASScore.Exp3.rSIDPattern <- glmer(searched.option.av ~ version*pattern+(1 + version|ID)+(1|shop.item),
data = GLMER.data.predictor.Exp3, family = binomial, control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
summary(glmer.ASScore.Exp3.rSIDPattern)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: searched.option.av ~ version * pattern + (1 + version | ID) +
## (1 | shop.item)
## Data: GLMER.data.predictor.Exp3
## Control:
## glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 2e+05))
##
## AIC BIC logLik deviance df.resid
## 1591.7 1645.4 -785.8 1571.7 1592
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6710 -0.5293 -0.2511 0.4963 7.5932
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## ID (Intercept) 0.31385 0.5602
## version1 1.10773 1.0525 0.71
## shop.item (Intercept) 0.07374 0.2715
## Number of obs: 1602, groups: ID, 89; shop.item, 18
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.87750 0.11885 -7.383 1.55e-13 ***
## version1 0.91071 0.13794 6.602 4.05e-11 ***
## pattern1 1.36108 0.10504 12.957 < 2e-16 ***
## pattern2 0.18479 0.04852 3.808 0.00014 ***
## version1:pattern1 0.17155 0.10444 1.643 0.10047
## version1:pattern2 -0.01055 0.04857 -0.217 0.82805
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) versn1 pttrn1 pttrn2 vrs1:1
## version1 0.159
## pattern1 -0.241 0.201
## pattern2 -0.146 0.088 0.289
## vrsn1:pttr1 0.227 -0.202 -0.151 -0.196
## vrsn1:pttr2 0.104 -0.125 -0.195 -0.134 0.291Cue patterns in Experiment 3 do not interact with the pattern version - however they do influence search behavior such that subjects are more likely to search for Option A in Pattern 2 than in Pattern 1 as well as in Pattern 3 compared to Patterns 1 and 2.
7 7. Plots
7.1 Attraction Search Scores
### Prepare data for plotting
# Individuals with significant Attraction Search Score:
# Experiment 1: 6 trials - how many trials searched for consistently with ASE for significance?
binom.test(6,6)##
## Exact binomial test
##
## data: 6 and 6
## number of successes = 6, number of trials = 6, p-value = 0.03125
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.5407419 1.0000000
## sample estimates:
## probability of success
## 1ASScore.ind.Exp1 <- data.Exp1 %>%
# keep only information search data in decision task
filter(data == "choice.data" & answer.type == "search") %>%
select(ID, version, option.answer) %>%
group_by(ID, version, option.answer) %>%
# calculate number of searches per version and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(ID,version,option.answer,fill = list(n.searches=0)) %>%
filter((version == "a" & option.answer == "OptionA")|(version == "b" & option.answer == "OptionB")) %>%
group_by(ID) %>%
summarise(consistent.searches = sum(n.searches)) %>%
ungroup() %>%
mutate(Significance = ifelse(consistent.searches == 6, "significant", "non significant")) %>%
select(-consistent.searches)
plot.ASScore.Exp1 <- left_join(ASScore.Exp1, ASScore.ind.Exp1, by = "ID")
# Experiment 2: 12 trials - how many trials searched for consistently with ASE for significance?
binom.test(10,12)##
## Exact binomial test
##
## data: 10 and 12
## number of successes = 10, number of trials = 12, p-value = 0.03857
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.5158623 0.9791375
## sample estimates:
## probability of success
## 0.8333333ASScore.ind.Exp2 <- data.final.Exp2 %>%
# filter only data from choice task
filter(data == "choice.data") %>%
select(ID, opened.cue.1, opened.cue.2, first.search.valence) %>%
# create vectors for calculating AS-Score
mutate(first.search.option = ifelse(grepl("A",opened.cue.1), "OptionA", "OptionB"),
second.search.option = ifelse(grepl("A",opened.cue.2), "OptionA", "OptionB"),
first.search.valence = recode(first.search.valence, `1`= "positive", `-1` = "negative")) %>%
# create variable that codes whether the searched for option was switched in the second search
mutate(switching = ifelse((first.search.option == "OptionA" & second.search.option == "OptionA") |
(first.search.option == "OptionB" & second.search.option == "OptionB"),
"no.switch", "switch")) %>%
group_by(ID, switching, first.search.valence) %>%
# calculate number of switches per participant and per positive/negative initial evidence
summarise(n.switches = n()) %>%
ungroup() %>%
# fill in 0 if searched option was not switched for negative/positive inital evidence
complete(ID, switching, first.search.valence, fill = list(n.switches = 0)) %>%
filter((switching == "no.switch" & first.search.valence == "positive")|(switching == "switch" & first.search.valence == "negative")) %>%
group_by(ID) %>%
summarise(consistent.searches = sum(n.switches)) %>%
ungroup() %>%
mutate(Significance = ifelse(consistent.searches >= 10, "significant", "non significant")) %>%
select(-consistent.searches)
plot.ASScore.Exp2 <- left_join(ASScore.Exp2, ASScore.ind.Exp2, by = "ID")
# Experiment 3: 18 trials - how many trials searched for consistently with ASE for significance?
binom.test(14,18)##
## Exact binomial test
##
## data: 14 and 18
## number of successes = 14, number of trials = 18, p-value = 0.03088
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.5236272 0.9359080
## sample estimates:
## probability of success
## 0.7777778ASScore.ind.Exp3 <- data.final.Exp3 %>%
# select data from choice task
filter(data == "choice.data" & phase == "task") %>%
select(ID, version, opened.cue) %>%
mutate(searched.option = ifelse(grepl("A",opened.cue),"OptionA", "OptionB"))%>%
select(-opened.cue) %>%
group_by(ID, version, searched.option) %>%
# calculate number of searches per version and option
summarise(n.searches = n()) %>%
ungroup()%>%
# fill in 0 if option A/B was not searched for in one of the versions
complete(ID,version,searched.option,fill = list(n.searches=0)) %>%
filter((version == "a" & searched.option == "OptionA")|(version == "b" & searched.option == "OptionB")) %>%
group_by(ID) %>%
summarise(consistent.searches = sum(n.searches)) %>%
ungroup() %>%
mutate(Significance = ifelse(consistent.searches >= 14, "significant", "non significant")) %>%
select(-consistent.searches)
plot.ASScore.Exp3 <- left_join(ASScore.Exp3, ASScore.ind.Exp3, by = "ID")
# Plotting data 1
ASScore.overall <- data.frame(ID = c(plot.ASScore.Exp1$ID, plot.ASScore.Exp2$ID, plot.ASScore.Exp3$ID),
Experiment = c(rep("Experiment 1", nrow(plot.ASScore.Exp1)),
rep("Experiment 2", nrow(plot.ASScore.Exp2)),
rep("Experiment 3", nrow(plot.ASScore.Exp3))),
ASScore = c(plot.ASScore.Exp1$ASScore, plot.ASScore.Exp2$ASScore, plot.ASScore.Exp3$ASScore),
Significance = c(plot.ASScore.Exp1$Significance, plot.ASScore.Exp2$Significance, plot.ASScore.Exp3$Significance))
# Plotting data 2
ASScore.overall.mean <- ASScore.overall %>%
group_by(Experiment) %>%
summarise(ASScore.mean = mean(ASScore),
ASScore.sd = sd(ASScore),
ASScore.n = n()) %>%
mutate(ASScore.se = ASScore.sd/sqrt(ASScore.n),
ASScore = ASScore.mean,
Significance = "Mean Score Mean")
# Plot
ASScore.plot <- ggplot(ASScore.overall,aes(x = Experiment, y = ASScore))+
geom_violin(alpha=0.5, adjust = 1.7)+
geom_jitter(aes(x = Experiment, y = ASScore, color = Significance),width = 0.1, height = 0.02, alpha=0.5, size = 2)+
theme_bw()+
geom_point(data=ASScore.overall.mean, aes(color=Significance), size = 3)+
geom_errorbar(data=ASScore.overall.mean, aes(ymax = ASScore + ASScore.se, ymin = ASScore - ASScore.se, color = Significance), width=0.09)+
geom_hline(yintercept = 0, linetype = "dotted")+
scale_color_viridis_d("Type of Score", labels = c("overall mean score", "individual, non-significant score", "individual, significant score"))+#,h = c(120, 200)
scale_y_continuous(breaks = seq(-1,1,0.2), minor_breaks = seq(-1,1,0.2))+
ylab("Attraction Search Score")+
theme(text = element_text(size = 12),
strip.text.x = element_text(size = 10),
strip.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 8),
legend.justification=c(1,0),
legend.position=c(1,0),
legend.background = element_rect(linetype = "solid", color = "black"),
legend.title.align=0.5,
legend.text = element_text(size=8),
legend.title = element_text(size=8))+
xlab("")
print(ASScore.plot)
ggsave("ASScores_Experiments.eps", plot = ASScore.plot, device=cairo_ps, width = 6, units = "in", height = 5, dpi = 900)
# ggsave("ASScores_Experiments.pdf", plot = ASScore.plot, device=cairo_pdf, width = 6, units = "in", height = 5, dpi = 900)7.2 Scenarios
# Combine dataframes with AS-Score results per Scenario
ASScore.Scenarios.overall <- data.frame(Scenario = c(as.character(ASScore.Scenarios.Exp1$scenario),
as.character(ASScore.Scenarios.Exp2$OptionA),
as.character(ASScore.Scenarios.Exp3$shop.item)),
Experiment = c(rep("Experiment 1", nrow(ASScore.Scenarios.Exp1)),
rep("Experiment 2", nrow(ASScore.Scenarios.Exp2)),
rep("Experiment 3", nrow(ASScore.Scenarios.Exp3))),
ASScore = c(ASScore.Scenarios.Exp1$ASScore, ASScore.Scenarios.Exp2$ASScore,
ASScore.Scenarios.Exp3$ASScore)) %>%
mutate(Scenario = recode(Scenario, city = "City", hair = "Hair Salon", hotel = "Hotel", job = "Job", pizza = "Pizza Service",
weather = "Weather Forecast", appartment_A = "Appartment", cellcontract_A = "Cell Contract",
city_A = "City", computer_A = "Computer", granola_A = "Granola", gym_A = "Gym",
hairsalon_A = "Hair Salon", hotel_A = "Hotel", insurance_A = "Insurance Policy", job_A = "Job",
pizza_A = "Pizza Service", weather_A = "Weather Forecast", blazer_blue = "Blue Blazer",
dress_black = "Black Dress", dress_floral = "Floral Dress", dress_grey = "Grey Dress",
jacket_floral = "Floral Jacket", jacket_fur = "Fur Jacket", jacket_green = "Green Jacket",
jacket_grey = "Grey Jacket", jacket_jeans = "Jeans Jacket", pullover_blue = "Blue Sweater",
pullover_grey = "Grey Sweater", pullover_white = "White Sweater", shirt_red = "Red Shirt",
shirt_stripes = "Striped Shirt", shorts_jeans = "Jeans Shorts", shorts_pink = "Pink Shorts",
top_black = "Black Top", top_white = "White Top")) %>%
mutate(Scenario = factor(Scenario, levels = c("City", "Hair Salon", "Hotel", "Job", "Pizza Service", "Weather Forecast",
"Appartment", "Cell Contract","Computer","Granola","Gym","Insurance Policy",
"Blue Blazer","Black Dress", "Floral Dress","Grey Dress","Floral Jacket",
"Fur Jacket","Green Jacket","Grey Jacket", "Jeans Jacket","Blue Sweater",
"Grey Sweater","White Sweater","Red Shirt","Striped Shirt", "Jeans Shorts",
"Pink Shorts","Black Top","White Top")))
# Plot
ASScore.Scenario.plot <- ggplot(ASScore.Scenarios.overall, aes(x = ASScore, y = Scenario, shape = Experiment, color = Experiment))+
geom_point(size=2)+
scale_y_discrete(limits=levels(ASScore.Scenarios.overall$Scenario)[30:1])+
theme_bw()+
scale_x_continuous(limits = c(-0.1,0.7), breaks = seq(-1,1,0.1), minor_breaks = seq(-1,1,0.1))+
geom_vline(data = ASScore.overall.mean, aes(xintercept = ASScore, color = Experiment))+
scale_color_viridis_d("Experiment")+#,h = c(50, 200)
ylab("Decision Context")+
xlab("Attraction Search Score")+
theme(text = element_text(size = 10),
strip.text.x = element_text(size = 8),
strip.text.y = element_text(size = 8),
axis.text.x = element_text(size = 8),
axis.text.y = element_text(size = 8),
legend.justification=c(1,0),
legend.position=c(1,0),
legend.background = element_rect(linetype = "solid", color = "black"),
legend.title.align=0.5,
legend.text = element_text(size=8),
legend.title = element_text(size=8))
print(ASScore.Scenario.plot)
ggsave("ASScores_Scenarios.eps", plot = ASScore.Scenario.plot, device=cairo_ps, width = 6, units = "in", height = 4, dpi = 900)
# ggsave("ASScores_Scenarios.pdf", plot = ASScore.Scenario.plot, device=cairo_pdf, width = 6, units = "in", height = 4, dpi = 900)7.3 Patterns + Comparisons to Jekel et al.
# Combine AS-Score results per pattern
ASScore.overall.pattern <- bind_rows(ASScore.pattern.Exp1, ASScore.pattern.Exp3, .id = "Experiment") %>%
group_by(Experiment, pattern) %>%
summarise(ASScore.mean = mean(ASScore),
ASScore.sd = sd(ASScore),
ASScore.n = n()) %>%
ungroup() %>%
mutate(Experiment = recode(Experiment, `1`= "Experiment 1", `2`= "Experiment 3"),
ASScore.se = ASScore.sd/sqrt(ASScore.n),
ASScore = ASScore.mean,
Significance = NA,
pattern = as.character(pattern)) %>%
select(-Significance)
# Update overall AS-Score results dataframe
ASScore.overall.mean <- ASScore.overall.mean %>%
select(-Significance) %>%
mutate(pattern = "overall")
# Create dataframe for AS-Score results based on Jekel et al. (2018)
ASScore.original <- data.frame(Experiment = rep(c("Jekel et al. (2018) - Experiment 1 (restricted search)",
"Jekel et al. (2018) - Experiment 2 (costly search)",
"Jekel et al. (2018) - Experiment 2 (free search)"), each = 5),
pattern = rep(c("4", "5", "6", "7", "overall"), 3),
ASScore = c(0.2689, 0.2652, 0.6515, 0.6326, 0.3021,
0.3638, 0.3170, 0.6317, 0.5848, 0.3231,
0.0500, 0.1523, 0.2705, 0.2614, 0.1193),
ASScore.mean = c(0.2689, 0.2652, 0.6515, 0.6326, 0.3021,
0.3638, 0.3170, 0.6317, 0.5848, 0.3231,
0.0500, 0.1523, 0.2705, 0.2614, 0.1193),
ASScore.sd = c(0.2560, 0.3198, 0.3168, 0.2379, 0.1403,
0.3165, 0.3429, 0.3941, 0.4184, 0.2155,
0.2277, 0.2508, 0.3558, 0.3239, 0.1387),
ASScore.n = rep(c(33, 56, 55), eqach = 5), stringsAsFactors = FALSE)
# Add standard errors
ASScore.original$ASScore.se <- ASScore.original$ASScore.sd/sqrt(ASScore.original$ASScore.n)
# Create final plotting dataframe
ASScore.comparisons <- bind_rows(ASScore.overall.pattern, ASScore.overall.mean, ASScore.original) %>%
mutate(Original = ifelse(grepl("Jekel", Experiment), "yes", "no"))## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector# Plot
ASScore.Comparison.plot <- ggplot(ASScore.comparisons, aes(y = ASScore, x = pattern, shape = Experiment, color = Experiment, group = Experiment))+
geom_point(position=position_dodge(width=0.2), size = 3)+
theme_bw()+
scale_shape_manual(name = "Experiment",
labels = c("Experiment 1", "Experiment 2", "Experiment 3",
"Jekel et al. (2018) - Experiment 1 (restricted search)",
"Jekel et al. (2018) - Experiment 2 (costly search)",
"Jekel et al. (2018) - Experiment 2 (free search)"),
values = c(19, 19, 19, 17, 17, 17))+
scale_y_continuous("Attraction Search Score", limits=c(-0.1, 1), breaks = seq(-1,1,0.1), minor_breaks = seq(-1,1,0.1)) +
scale_color_viridis_d(name="Experiment", labels=c("Experiment 1", "Experiment 2", "Experiment 3",
"Jekel et al. (2018) - Experiment 1 (restricted search)",
"Jekel et al. (2018) - Experiment 2 (costly search)",
"Jekel et al. (2018) - Experiment 2 (free search)"))+
guides(color=guide_legend(ncol=2), shape=guide_legend(ncol=2))+
theme(text = element_text(size = 12),
strip.text.x = element_text(size = 10),
strip.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 8),
legend.justification=c(0.0,1),
legend.position=c(0.0,1),
legend.background = element_rect(linetype = "solid", color = "black"),
legend.title.align=0.5)+
geom_errorbar(aes(ymax = ASScore + ASScore.se, ymin = ASScore - ASScore.se), width=0.3, position=position_dodge(width=0.2))+
geom_hline(yintercept = 0, linetype = "dotted")+
xlab("Cue Pattern")
print(ASScore.Comparison.plot)
ggsave("ASScores_Comparisons.eps", plot = ASScore.Comparison.plot, device=cairo_ps, width = 6, units = "in", height = 4.5,
dpi = 900)
# ggsave("ASScores_Comparisons.pdf", plot = ASScore.Comparison.plot, device=cairo_pdf, width = 6, units = "in", height = 4.5,
# dpi = 900)7.4 Generalized mixed models
# Dataframe for predicted probabilities for Experiment 1
coefficients.Exp1 <- coef(glmer.ASScore.Exp1.final)
coEff.Exp1.ID <- coefficients.Exp1$ID %>%
rownames_to_column("ID") %>%
mutate(oddsV_a = `(Intercept)`+ version1,
oddsV_b = `(Intercept)`- version1) %>%
mutate(probV_a = plogis(oddsV_a),
probV_b = plogis(oddsV_b)) %>%
mutate(probDiff = probV_a-probV_b) %>%
select(ID, probV_a, probV_b, probDiff) %>%
gather(Version, Probability, -ID, -probDiff) %>%
mutate(Version = recode(Version, probV_a = "a", probV_b = "b"),
ID = as.factor(ID))
coEff.Exp1.Scenario <- coefficients.Exp1$scenario %>%
rownames_to_column("Scenario") %>%
mutate(oddsV_a = `(Intercept)`+ version1,
oddsV_b = `(Intercept)`- version1) %>%
mutate(probV_a = plogis(oddsV_a),
probV_b = plogis(oddsV_b)) %>%
mutate(probDiff = probV_a-probV_b) %>%
select(Scenario, probV_a, probV_b, probDiff) %>%
gather(Version, Probability, -Scenario, -probDiff) %>%
mutate(Version = recode(Version, probV_a = "a", probV_b = "b"),
Scenario = as.factor(recode(Scenario,city = "City", hair = "Hair Salon", hotel = "Hotel", job = "Job",
pizza = "Pizza Service", weather = "Weather Forecast")))
### Dataframe for Predicted Probabilities for Experiment 2
coefficients.Exp2 <- coef(glmer.ASScore.Exp2.final)
coEff.Exp2.ID <- coefficients.Exp2$ID %>%
rownames_to_column("ID") %>%
mutate(oddsVal_pos = `(Intercept)`+ valence1,
oddsVal_neg = `(Intercept)`- valence1) %>%
mutate(probVal_pos = plogis(oddsVal_pos),
probVal_neg = plogis(oddsVal_neg)) %>%
mutate(probDiff = probVal_pos-probVal_neg) %>%
select(ID, probVal_pos, probVal_neg, probDiff) %>%
gather(Valence, Probability, -ID, -probDiff) %>%
mutate(Valence = recode(Valence, probVal_pos = "positive", probVal_neg = "negative"),
ID = as.factor(ID)) %>%
mutate(Valence = factor(Valence, levels = c("positive", "negative")))
### Dataframe for Predicted Probabilities for Experiment 3
coefficients.Exp3 <- coef(glmer.ASScore.Exp3.final)
coEff.Exp3.ID <- coefficients.Exp3$ID %>%
rownames_to_column("ID") %>%
mutate(oddsV_a = `(Intercept)`+ version1,
oddsV_b = `(Intercept)`- version1) %>%
mutate(probV_a = plogis(oddsV_a),
probV_b = plogis(oddsV_b)) %>%
mutate(probDiff = probV_a-probV_b) %>%
select(ID, probV_a, probV_b, probDiff) %>%
gather(Version, Probability, -ID, -probDiff) %>%
mutate(Version = recode(Version, probV_a = "a", probV_b = "b"),
ID = as.factor(ID))
### Plot predicted probabilities
Plot.Scenario.Exp1 <- ggplot(coEff.Exp1.Scenario, aes(x = Version, y = Probability, group = Scenario, shape = Scenario))+
geom_point(alpha = 0.6, size = 3)+
geom_line(alpha = 0.2)+
theme_bw()+
scale_y_continuous(limits = c(0,1), breaks = seq(0,1,0.1), minor_breaks = seq(0,1,0.1))+
theme(text = element_text(size = 8),
strip.text.x = element_text(size = 8),
strip.text.y = element_text(size = 8),
axis.text.x = element_text(size = 8),
axis.text.y = element_text(size = 8),
# legend.justification=c(1,1),
# legend.position=c(1,1),
# legend.background = element_rect(linetype = "solid", color = "black"),
# legend.title.align=0.5,
title = element_text(size = 8),
# legend.text = element_text(size=6),
# legend.title = element_text(size=8),
# legend.key.size=unit(0.1,'mm'),
plot.margin = unit(c(2, 2, 2, 2), "mm"))+
scale_x_discrete(expand = c(0, .2))+
labs(title = "Experiment 1", tag = "A", y = "Predicted Probability")
Plot.ID.Exp1 <- ggplot(coEff.Exp1.ID, aes(x = Version, y = Probability, group = ID))+
geom_point(size=2, alpha = 0.2)+
geom_line(alpha = 0.2)+
theme_bw()+
scale_y_continuous(limits = c(0,1), breaks = seq(0,1,0.1), minor_breaks = seq(0,1,0.1))+
scale_x_discrete(expand = c(0, .2))+
labs(title = "Experiment 1", tag = "B", y = "Predicted Probability")+
theme(text = element_text(size = 8),
strip.text.x = element_text(size = 8),
title = element_text(size = 8),
strip.text.y = element_text(size = 8),
axis.text.x = element_text(size = 8),
axis.text.y = element_text(size = 8),
plot.margin = unit(c(1, 1, 1, 1), "mm"))
Plot.ID.Exp2 <- ggplot(coEff.Exp2.ID, aes(x = Valence, y = Probability, group = ID))+
geom_point(size=2, alpha = 0.2)+
geom_line(alpha = 0.2)+
theme_bw()+
scale_y_continuous(limits = c(0,1), breaks = seq(0,1,0.1), minor_breaks = seq(0,1,0.1))+
scale_x_discrete(expand = c(0, .2))+
labs(title = "Experiment 2", tag = "", y = "")+
theme(text = element_text(size = 8),
title = element_text(size = 8),
strip.text.x = element_text(size = 8),
axis.text.x = element_text(size = 8),
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
plot.margin = unit(c(1, 1, 1, 1), "mm"))
Plot.ID.Exp3 <- ggplot(coEff.Exp3.ID, aes(x = Version, y = Probability, group = ID))+
geom_point(size=2, alpha = 0.2)+
geom_line(alpha = 0.2)+
theme_bw()+
scale_y_continuous(limits = c(0,1), breaks = seq(0,1,0.1), minor_breaks = seq(0,1,0.1))+
scale_x_discrete(expand = c(0, .2))+
labs(title = "Experiment 3", tag = "", y = "")+
theme(text = element_text(size = 8),
title = element_text(size = 8),
strip.text.x = element_text(size = 8),
axis.text.x = element_text(size = 8),
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
plot.margin = unit(c(1, 1, 1, 1), "mm"))
Plot.IDs <- plot_grid(Plot.ID.Exp1, Plot.ID.Exp2, Plot.ID.Exp3, align = "v", ncol = 3)
Plot.Slopes<- grid.arrange(grobs = list(Plot.Scenario.Exp1, Plot.IDs),
layout_matrix = rbind(c(1,1,1,NA,NA),
c(2,2,2,2,2)))
ggsave("RandomSlopes.eps", plot = Plot.Slopes, device=cairo_ps, width = 6, units = "in", height = 6, dpi = 900)
# ggsave("RandomSlopes.pdf", plot = Plot.Slopes, device=cairo_pdf, width = 6, units = "in", height = 6, dpi = 900)