Analysis of Deviant Detection Experiment
Sarah Placi and Simon Stephan
9 10 2020
1 Packages
2 Read in and prepare data
# read data
tdata <- read.delim("tdata_deviant.txt", header=TRUE, sep="\t", na.strings="NA", dec=".", strip.white=TRUE)
tdata<-tdata %>%
rename(
YSymmetry_Angle = Y_Symmetry_Angle,
YSymmetry_Size = Y_Symmetry_Size,
YSymmetry_Rotation = Y_Symmetry_Rotation,
YSymmetry_none = Y_Symmetry_none,
YSymmetry_Size = Y_Symmetry_Size,
XSymmetry_none = X_Symmetry_none,
XTranslation_none = X_Translation_none,
YTranslation_none = Y_Translation_none
)# sID as factor
tdata$sID <- factor(tdata$sID)# wide to long format
tdata_wide <- tdata
tdata_long <- gather(tdata_wide, Transformation, Correct, Angle_none:YTranslation_none, factor_key = TRUE)# create a summary dataset that also contains the percentages
plotdata <- tdata_long[-c(2:7)]
plotdata<- plotdata %>%
group_by(Transformation) %>%
summarize(Performance = mean(Correct))
plotdata<-separate(plotdata, col = Transformation, into = c("Transformation", "Interference"), sep = "_")
plotdata$n <- 29 # sample size of study
Trial <- ifelse(plotdata$Interference == "none", "None", "Interference")
Correct <- plotdata$Performance*plotdata$n
plotdata <- cbind(plotdata, Trial, Correct)# perform binomial tests to get the confidence intervals for the proportion estimates
b1<-binom.test(plotdata$Correct[1], plotdata$n[1], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b2<-binom.test(plotdata$Correct[2], plotdata$n[2], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b3<-binom.test(plotdata$Correct[3], plotdata$n[3], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b4<-binom.test(plotdata$Correct[4], plotdata$n[4], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b5<-binom.test(plotdata$Correct[5], plotdata$n[5], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b6<-binom.test(plotdata$Correct[6], plotdata$n[6], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b7<-binom.test(plotdata$Correct[7], plotdata$n[7], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b8<-binom.test(plotdata$Correct[8], plotdata$n[8], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b9<-binom.test(plotdata$Correct[9], plotdata$n[9], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b10<-binom.test(plotdata$Correct[10], plotdata$n[10], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b11<-binom.test(plotdata$Correct[11], plotdata$n[11], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b12<-binom.test(plotdata$Correct[12], plotdata$n[12], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b13<-binom.test(plotdata$Correct[13], plotdata$n[13], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b14<-binom.test(plotdata$Correct[14], plotdata$n[14], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b15<-binom.test(plotdata$Correct[15], plotdata$n[15], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b16<-binom.test(plotdata$Correct[16], plotdata$n[16], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b17<-binom.test(plotdata$Correct[17], plotdata$n[17], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b18<-binom.test(plotdata$Correct[18], plotdata$n[18], p = 1/6, alternative = "two.sided", conf.level = 0.95)
b19<-binom.test(plotdata$Correct[19], plotdata$n[19], p = 1/6, alternative = "two.sided", conf.level = 0.95)
# Lower bounds of CI
CI_lower <- c(b1$conf.int[1],b2$conf.int[1],b3$conf.int[1],b4$conf.int[1],b5$conf.int[1],b6$conf.int[1],b7$conf.int[1],b8$conf.int[1],b9$conf.int[1],b10$conf.int[1],b11$conf.int[1],b12$conf.int[1],b13$conf.int[1],b14$conf.int[1],b15$conf.int[1],b16$conf.int[1],b17$conf.int[1],b18$conf.int[1],b19$conf.int[1] )
# Upper bounds of CI
CI_upper <- c(b1$conf.int[2],b2$conf.int[2],b3$conf.int[2],b4$conf.int[2],b5$conf.int[2],b6$conf.int[2],b7$conf.int[2],b8$conf.int[2],b9$conf.int[2],b10$conf.int[2],b11$conf.int[2],b12$conf.int[2],b13$conf.int[2],b14$conf.int[2],b15$conf.int[2],b16$conf.int[2],b17$conf.int[2],b18$conf.int[2],b19$conf.int[2] )
# Append to data
plotdata <- cbind(plotdata, CI_lower, CI_upper)
# Factorize
plotdata$Interference <- factor(plotdata$Interference, levels = c("none", "Angle", "Rotation", "Size", "Symmetry"),
labels = c("None", "Shape", "Orientation","Size", "Sense"))
plotdata$Transformation <- factor(plotdata$Transformation, levels = c("Angle", "Rotation", "Size", "XSymmetry", "XTranslation",
"YSymmetry", "YTranslation"),
labels = c("Shape", "Orientation","Size", "X-Sym.", "X-Tran.", "Sense", "Y-Tran."))# Split data frames into pure and interference trials (needed to make separate plots)
plotdata_pure <- subset(plotdata, Trial == "None")
plotdata_int <- subset(plotdata, Trial != "None")3 Plots
3.1 Pure Trials
# A theme with plot specifics
myTheme <- theme(plot.title = element_text(face="bold", size = 16),
axis.title.x = element_text(face = "bold", size = 20),
axis.title.y = element_text(face = "bold", size = 20),
axis.text.x = element_text(size = 20, angle = 45, hjust = 1),
axis.text.y = element_text(size = 18, angle = 0),
legend.text = element_text(size = 18),
legend.title = element_text(face = "bold", size = 18),
strip.text.x = element_text(size = 18),
#panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line.x = element_line(colour = "black"),
axis.line.y = element_line(colour = "black"),
axis.text = element_text(colour ="black"),
axis.ticks = element_line(colour ="black"))
library(scales)
theme_set(theme_light(base_size = 12, base_family = "Poppins"))
# The plot
g<- ggplot(plotdata_pure,
aes(x = Interference,
y = Performance, fill= Transformation)) +
#facet_grid(~ Trial)+
coord_cartesian(xlim =c(1,1), ylim = c(0, 1.1))+
geom_bar(stat="identity", color="black", position=position_dodge()) +
#scale_x_discrete(limits=c("none", "Angle", "Rotation", "Size", "Symmetry")) +
annotate(geom = "hline",yintercept = 1/6, y = 1/6, color = "black", size = 1, linetype='dotted')+
scale_fill_brewer(name = "Transformation: ", palette="Pastel2")+
#scale_y_continuous(breaks = seq(0, 1, by = 0.1))+
scale_y_continuous(limits = seq(0, 2),
breaks = seq(0, 1, .25),
expand = c(0,0),
label = percent) +
geom_errorbar(aes(ymin=CI_lower, ymax=CI_upper), width=.2,
position=position_dodge(.9))+
theme(legend.position = "top", axis.title = element_text(size = 15), axis.text = element_text(size = 13, color = "black"),
legend.text = element_text(size = 13),legend.title = element_text(size = 13), axis.text.x = element_blank())+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
xlab("Pure trials") ## Warning: Ignoring unknown aesthetics: yg
# Save plot
#ggsave("selections_no_interf.svg",width=7,height=3)
#ggsave("selections_no_interf.pdf",width=7,height=3)3.2 Interference Trials
library(scales)
theme_set(theme_light(base_size = 12, base_family = "Poppins"))
g<- ggplot(plotdata_int,
aes(x = Interference,
y = Performance, fill= Transformation)) +
#facet_grid(~ Trial)+
coord_cartesian(xlim =c(1, 4), ylim = c(0, 1.1))+
geom_bar(stat="identity", color="black", position=position_dodge()) +
#scale_x_discrete(limits=c("none", "Angle", "Rotation", "Size", "Symmetry")) +
annotate(geom = "hline",yintercept = 1/6, y = 1/6, color = "black", size = 1, linetype='dotted')+
scale_fill_brewer(name ="Transformation: ", palette="Pastel2")+
#scale_y_continuous(breaks = seq(0, 1, by = 0.1),labels = scales::percent)+
scale_y_continuous(limits = seq(0, 2),
breaks = seq(0, 1, .25),
expand = c(0,0),
label = percent) +
geom_errorbar(aes(ymin=CI_lower, ymax=CI_upper), width=.2,
position=position_dodge(.9))+
theme(legend.position = "top", axis.title = element_text(size = 15), axis.text = element_text(size = 13, color = "black"),
legend.text = element_text(size = 13),legend.title = element_text(size = 13))+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())## Warning: Ignoring unknown aesthetics: yg
ggsave("selections_interf.svg",width=7,height=3)
ggsave("selections_interf.pdf",width=7,height=3)4 Statistical Tests
plotdata_int## Transformation Interference Performance n Trial Correct CI_lower
## 2 Shape Orientation 0.9310345 29 Interference 27 0.7723381
## 3 Shape Size 0.8275862 29 Interference 24 0.6422524
## 4 Shape Sense 0.9655172 29 Interference 28 0.8223557
## 5 Orientation Shape 0.7241379 29 Interference 21 0.5276155
## 7 Orientation Size 0.8620690 29 Interference 25 0.6833594
## 8 Orientation Sense 0.9310345 29 Interference 27 0.7723381
## 9 Size Shape 0.6896552 29 Interference 20 0.4916766
## 11 Size Orientation 0.9310345 29 Interference 27 0.7723381
## 12 Size Sense 0.9655172 29 Interference 28 0.8223557
## 15 Sense Shape 0.6551724 29 Interference 19 0.4566943
## 17 Sense Orientation 0.3793103 29 Interference 11 0.2068687
## 18 Sense Size 0.7241379 29 Interference 21 0.5276155
## CI_upper
## 2 0.9915360
## 3 0.9415439
## 4 0.9991274
## 5 0.8726599
## 7 0.9611052
## 8 0.9915360
## 9 0.8471541
## 11 0.9915360
## 12 0.9991274
## 15 0.8206164
## 17 0.5773954
## 18 0.8726599# We wanne test: is there one transformation that is harder to find given the different classes of interference?
# We compare the proportions in each interference class
#1) Shape Interference
(orient_vs_size <- prop.test(x = c(plotdata$Correct[5], plotdata$Correct[9]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[5], plotdata$Correct[9]) out of c(29, 29)
## X-squared = 1.2411e-31, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.2341212 0.3030867
## sample estimates:
## prop 1 prop 2
## 0.7241379 0.6896552(orient_vs_sense <- prop.test(x = c(plotdata$Correct[5], plotdata$Correct[15]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[5], plotdata$Correct[15]) out of c(29, 29)
## X-squared = 0.080556, df = 1, p-value = 0.7765
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.2029784 0.3409094
## sample estimates:
## prop 1 prop 2
## 0.7241379 0.6551724(size_vs_sense <- prop.test(x = c(plotdata$Correct[9], plotdata$Correct[15]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[9], plotdata$Correct[15]) out of c(29, 29)
## X-squared = 0, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.2414082 0.3103737
## sample estimates:
## prop 1 prop 2
## 0.6896552 0.6551724#2) Orientation Interference (That's where we predicted a difference)
(shape_vs_size <- prop.test(x = c(plotdata$Correct[2], plotdata$Correct[11]), n = c(29, 29)))## Warning in prop.test(x = c(plotdata$Correct[2], plotdata$Correct[11]), n =
## c(29, : Chi-squared approximation may be incorrect##
## 2-sample test for equality of proportions without continuity
## correction
##
## data: c(plotdata$Correct[2], plotdata$Correct[11]) out of c(29, 29)
## X-squared = 7.8886e-31, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.1304256 0.1304256
## sample estimates:
## prop 1 prop 2
## 0.9310345 0.9310345(shape_vs_sense <- prop.test(x = c(plotdata$Correct[2], plotdata$Correct[17]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[2], plotdata$Correct[17]) out of c(29, 29)
## X-squared = 17.171, df = 1, p-value = 3.416e-05
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## 0.3180129 0.7854354
## sample estimates:
## prop 1 prop 2
## 0.9310345 0.3793103(size_vs_sense <- prop.test(x = c(plotdata$Correct[11], plotdata$Correct[17]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[11], plotdata$Correct[17]) out of c(29, 29)
## X-squared = 17.171, df = 1, p-value = 3.416e-05
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## 0.3180129 0.7854354
## sample estimates:
## prop 1 prop 2
## 0.9310345 0.3793103#3) Size Interference
(shape_vs_orient <- prop.test(x = c(plotdata$Correct[3], plotdata$Correct[7]), n = c(29, 29)))## Warning in prop.test(x = c(plotdata$Correct[3], plotdata$Correct[7]), n =
## c(29, : Chi-squared approximation may be incorrect##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[3], plotdata$Correct[7]) out of c(29, 29)
## X-squared = 5.4676e-31, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.2551153 0.1861497
## sample estimates:
## prop 1 prop 2
## 0.8275862 0.8620690(shape_vs_sense <- prop.test(x = c(plotdata$Correct[3], plotdata$Correct[18]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[3], plotdata$Correct[18]) out of c(29, 29)
## X-squared = 0.39658, df = 1, p-value = 0.5289
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.1440187 0.3509152
## sample estimates:
## prop 1 prop 2
## 0.8275862 0.7241379(orient_vs_sense <- prop.test(x = c(plotdata$Correct[7], plotdata$Correct[18]), n = c(29, 29)))##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[7], plotdata$Correct[18]) out of c(29, 29)
## X-squared = 0.94565, df = 1, p-value = 0.3308
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.1020076 0.3778696
## sample estimates:
## prop 1 prop 2
## 0.8620690 0.7241379#4) Sense Interference
(shape_vs_orient <- prop.test(x = c(plotdata$Correct[4], plotdata$Correct[8]), n = c(29, 29)))## Warning in prop.test(x = c(plotdata$Correct[4], plotdata$Correct[8]), n =
## c(29, : Chi-squared approximation may be incorrect##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[4], plotdata$Correct[8]) out of c(29, 29)
## X-squared = 6.5738e-32, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.1136470 0.1826125
## sample estimates:
## prop 1 prop 2
## 0.9655172 0.9310345(shape_vs_size <- prop.test(x = c(plotdata$Correct[4], plotdata$Correct[12]), n = c(29, 29)))## Warning in prop.test(x = c(plotdata$Correct[4], plotdata$Correct[12]), n =
## c(29, : Chi-squared approximation may be incorrect##
## 2-sample test for equality of proportions without continuity
## correction
##
## data: c(plotdata$Correct[4], plotdata$Correct[12]) out of c(29, 29)
## X-squared = 2.9829e-30, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.09391719 0.09391719
## sample estimates:
## prop 1 prop 2
## 0.9655172 0.9655172(orient_vs_size <- prop.test(x = c(plotdata$Correct[8], plotdata$Correct[12]), n = c(29, 29)))## Warning in prop.test(x = c(plotdata$Correct[8], plotdata$Correct[12]), n =
## c(29, : Chi-squared approximation may be incorrect##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(plotdata$Correct[8], plotdata$Correct[12]) out of c(29, 29)
## X-squared = 6.5738e-32, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.1826125 0.1136470
## sample estimates:
## prop 1 prop 2
## 0.9310345 0.9655172Result: the only case in which peformance drops within an interference category is the one we predicted to be hard.