require(tidyverse) # Load data dat_child=read_csv("data/pink_initial/pink_child_final.csv") dat_adult_p=read_csv("data/syndata/pink_adult_final.csv") theme_apa <- function(base_size = 12, base_family = "Arial Unicode MS", box = TRUE, rotate_x = TRUE,...) { adapted_theme <- ggplot2::theme_bw(base_size, base_family) + ggplot2::theme( plot.title = ggplot2::element_text(size = ggplot2::rel(1.1), margin = ggplot2::margin(0, 0, ggplot2::rel(14), 0)) # , axis.title = ggplot2::element_text(size = ggplot2::rel(1.1)) , axis.title.x = ggplot2::element_text(size = ggplot2::rel(1), lineheight = ggplot2::rel(1.1), margin = ggplot2::margin(ggplot2::rel(6), 0, 0, 0)) , axis.title.y = ggplot2::element_text(size = ggplot2::rel(1), lineheight = ggplot2::rel(1.1), margin = ggplot2::margin(0, ggplot2::rel(6), 0, 0)) , axis.ticks.length = ggplot2::unit(ggplot2::rel(6), "points") , axis.text = ggplot2::element_text(size = ggplot2::rel(0.9)) , axis.text.x = ggplot2::element_text(size = ggplot2::rel(1), margin = ggplot2::margin(ggplot2::rel(6), 0, 0, 0)) , axis.text.y = ggplot2::element_text(size = ggplot2::rel(1), margin = ggplot2::margin(0, ggplot2::rel(6), 0, 0)) , axis.line.x = ggplot2::element_line() , axis.line.y = ggplot2::element_line() , legend.title = ggplot2::element_text() , legend.key = ggplot2::element_rect(fill = NA, color = NA) , legend.key.width = ggplot2::unit(ggplot2::rel(15), "points") , legend.key.height = ggplot2::unit(ggplot2::rel(15), "points") , legend.margin = ggplot2::margin( t = ggplot2::rel(16) , r = ggplot2::rel(16) , b = ggplot2::rel(16) , l = ggplot2::rel(16) , unit = "points" ) , panel.spacing = ggplot2::unit(ggplot2::rel(8), "points") , panel.grid.major.x = ggplot2::element_line(size = NA) , panel.grid.minor.x = ggplot2::element_line(size = NA) , panel.grid.major.y = ggplot2::element_line(size = NA) , panel.grid.minor.y = ggplot2::element_line(size = NA) , strip.background = ggplot2::element_rect(fill = NA, color = NA) , strip.text.x = ggplot2::element_text(margin = ggplot2::margin(0, 0, ggplot2::rel(6), 0)) # size = ggplot2::rel(1.1), , strip.text.y = ggplot2::element_text(margin = ggplot2::margin(0, 0, 0, ggplot2::rel(6))) # size = ggplot2::rel(1.1), , ... ) if(box) { adapted_theme <- adapted_theme + ggplot2::theme(panel.border = ggplot2::element_rect(color = "black")) } else { adapted_theme <- adapted_theme + ggplot2::theme(panel.border = ggplot2::element_blank()) } if(rotate_x) { adapted_theme <- adapted_theme + ggplot2::theme(axis.text.x=element_text(angle=90,vjust=0.25,hjust=1)) } adapted_theme } # Experiment 1 # Calculate power for child data set.seed(42) dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% filter(subject_language=="English",is_synesthete==TRUE) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% xtabs(n~is_first+is_pink,data=.) %>% epitools::riskratio(rev="b",verbose=T) %>% with(.,statmod::power.fisher.test(p.outcome[1,2],p.outcome[2,2],17*5,17,nsim=100000)) # Generate Figure 1 dat_child %>% ungroup() %>% group_by(inducer_is_1i,color_simner) %>% count() %>% group_by(inducer_is_1i) %>% mutate(p=n/sum(n)) %>% mutate(color_simner=factor(color_simner, levels=c("White","Grey","Cyan","LightGreen","DarkGreen","Yellow","Red","DarkBlue","Brown","Purple","Orange","Pink"), labels=c("White","Grey","Cyan","LightGreen","DarkGreen","Yellow","Red","DarkBlue","Sienna","Purple","Orange","Pink"))) %>% ungroup() %>% complete(color_simner,inducer_is_1i,fill=list(n=0,p=0)) %>% mutate(inducer_is_1i=factor(inducer_is_1i,levels=c(F,T),labels=c("Other\nLetters","First\nInitial"))) %>% # Jitter orange - NOT IN ANALYSIS, JUST IN VIS mutate(pl=ifelse(color_simner %in% c("Sienna"),p-0.0015, ifelse(color_simner %in% c("Orange"),p+0.0015,p))) %>% ggplot()+ annotate('segment',x=1,xend=2,y=0.025,yend=0,color="black",size=1.5)+ geom_line(aes(x=inducer_is_1i,y=pl,group=color_simner,color=color_simner),size=1)+ geom_point(aes(x=inducer_is_1i,y=p,fill=color_simner),color="black",size=2,shape=21)+ #scale_color_manual(values=BerlinKay_Hex,guide=FALSE)+ #scale_fill_manual(values=BerlinKay_Hex,guide=FALSE)+ scale_color_identity()+ scale_fill_identity()+ scale_x_discrete(expand=c(0,0.1))+ theme_apa(box=F,rotate_x=F,base_family="Arial Unicode MS",base_size=12)+ theme(axis.line=element_blank())+ labs(x="",y="Proportion of Associations")+ annotate("segment", x=-Inf, xend=Inf, y=-Inf, yend=-Inf)+ annotate("segment", x=-Inf, xend=-Inf, y=-Inf, yend=Inf) #ggsave("analysis/pink_initial/RootFig1.png",width=4,height=4,units="in",dpi=300) # Calculate statistic and effect size set.seed(42) dat_child %>% mutate(color_bk=as.factor(color_bk)) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% xtabs(n~is_first+is_pink,data=.) %>% epitools::riskratio(rev="b",method="boot",replicates=100000) # We might worry that trends (B=blue/brown, etc.) observed in adults are inflating effect size of pink # For that to happen, the trends must exist in the child data # Is B blue/brown? No dat_child %>% mutate(is_b=inducer=="B", is_expected=color_simner %in% c("DarkBlue","Cyan","Brown")) %>% group_by(is_b,is_expected) %>% count() %>% xtabs(n~is_b+is_expected,data=.) %>% epitools::riskratio(verbose=T) # Is "R" red? No dat_child %>% mutate(is_r=inducer=="R", is_expected=color_simner %in% c("Red")) %>% group_by(is_r,is_expected) %>% count() %>% xtabs(n~is_r+is_expected,data=.) %>% epitools::riskratio(verbose=T) # Is "Y" yellow? No dat_child %>% mutate(is_y=inducer=="Y", is_expected=color_simner %in% c("Yellow")) %>% group_by(is_y,is_expected) %>% count() %>% xtabs(n~is_y+is_expected,data=.) %>% epitools::riskratio(verbose=T) # Experiment 2 # Power analyses # Dutch Syns set.seed(42) dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% filter(subject_language=="English",is_synesthete==TRUE) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% xtabs(n~is_first+is_pink,data=.) %>% epitools::riskratio(rev="b",verbose=T) %>% { statmod::power.fisher.test(p1=.$p.outcome[1,2],p2=.$p.outcome[2,2], n1=as.numeric(count(ungroup(filter(dat_adult_p,subject_language=="Dutch",is_synesthete==TRUE,inducer_is_1i==FALSE)))), n2=as.numeric(count(ungroup(filter(dat_adult_p,subject_language=="Dutch",is_synesthete==TRUE,inducer_is_1i==TRUE)))), nsim=100000) } # Dutch Non-Syns set.seed(42) dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% filter(subject_language=="English",is_synesthete==TRUE) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% xtabs(n~is_first+is_pink,data=.) %>% epitools::riskratio(rev="b",verbose=T) %>% { statmod::power.fisher.test(p1=.$p.outcome[1,2],p2=.$p.outcome[2,2], n1=as.numeric(count(ungroup(filter(dat_adult_p,subject_language=="Dutch",is_synesthete==FALSE,inducer_is_1i==FALSE)))), n2=as.numeric(count(ungroup(filter(dat_adult_p,subject_language=="Dutch",is_synesthete==FALSE,inducer_is_1i==TRUE)))), nsim=100000) } # English Non-Syns set.seed(42) dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% filter(subject_language=="English",is_synesthete==TRUE) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% xtabs(n~is_first+is_pink,data=.) %>% epitools::riskratio(rev="b",verbose=T) %>% { statmod::power.fisher.test(p1=.$p.outcome[1,2],p2=.$p.outcome[2,2], n1=as.numeric(count(ungroup(filter(dat_adult_p,subject_language=="English",is_synesthete==FALSE,inducer_is_1i==FALSE)))), n2=as.numeric(count(ungroup(filter(dat_adult_p,subject_language=="English",is_synesthete==FALSE,inducer_is_1i==TRUE)))), nsim=100000) } # Language X Synesthesia stats dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% # Count observations group_by(subject_language, is_synesthete, is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% group_by(is_synesthete,subject_language) %>% nest() %>% mutate(epi=map(data,~xtabs(n~is_first+is_pink,data=.x) %>% epitools::riskratio(rev="b",method="boot",replicates=1000000))) %>% mutate(chisq=map_dbl(data,~xtabs(n~is_first+is_pink,data=.x) %>% chisq.test() %>% .$statistic)) %>% mutate(test=map(epi,~as.data.frame(.x$p.value)[2,])) %>% mutate(es=map(epi,~as.data.frame(.x$measure)[2,])) %>% select(-data,-epi) %>% unnest() # Stats (Languages merged) dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% # Count observations group_by(is_synesthete, is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% count() %>% group_by(is_synesthete) %>% nest() %>% mutate(epi=map(data,~xtabs(n~is_first+is_pink,data=.x) %>% epitools::riskratio(rev="b",method="boot",replicates=1000000))) %>% mutate(chisq=map_dbl(data,~xtabs(n~is_first+is_pink,data=.x) %>% chisq.test() %>% .$statistic)) %>% mutate(test=map(epi,~as.data.frame(.x$p.value)[2,])) %>% mutate(es=map(epi,~as.data.frame(.x$measure)[2,])) %>% select(-data,-epi) %>% unnest() # Non-syn is trending in English/Combined. Make sure that syn is actually stronger effect. # This means test for syn/non-syn interaction dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% mutate(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(T,F),labels=c("First Initial","Not First Initial"))) %>% mutate(battery_id=as.factor(battery_id)) %>% lme4::glmer(is_pink~is_first*is_synesthete+(1|battery_id),data=.,family="binomial") %>% summary() # Generate Figure 2 dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(F,T),labels=c("Not Pink","Pink")), is_first=factor(inducer_is_1i==TRUE,levels=c(F,T),labels=c("Not First\nInitial","First\nInitial")), is_synesthete=factor(is_synesthete,levels=c(T,F), labels=c("Synesthetic Adults (Exp. 2)","Non-Synesthetic Adults (Exp. 2)")), subject_language=factor(subject_language,levels=c("English","Dutch"))) %>% count() %>% group_by(is_first,is_synesthete,subject_language) %>% mutate(p=n/sum(n)) %>% ungroup() %>% filter(is_pink=="Pink") %>% select(-is_pink) %>% bind_rows(dat_child %>% mutate(color_bk=as.factor(color_bk)) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(T,F),labels=c("Pink","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(F,T),labels=c("Not First\nInitial","First\nInitial"))) %>% count() %>% group_by(is_first) %>% mutate(p=n/sum(n)) %>% ungroup() %>% mutate(subject_language="English",is_synesthete="Non-Synesthetic\nChildren (Exp. 1)") %>% filter(is_pink=="Pink")) %>% bind_rows(dat_adult_p %>% # Count observations filter(!is.na(subject_favcolor),is_synesthete==F) %>% ungroup() %>% group_by(is_fav=factor(subject_favcolor==color_bk,levels=c(T,F),labels=c("Favorite","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(F,T), labels=c("Not First\nInitial","First\nInitial"))) %>% count()%>% group_by(is_first) %>% mutate(p=n/sum(n)) %>% ungroup() %>% mutate(subject_language="English", is_synesthete="Non-Synesthetic Adults\n(Exp. 3 - y axis is favorite)") %>% filter(is_fav=="Favorite")) %>% ungroup() %>% mutate(is_synesthete=as.factor(is_synesthete)) %>% mutate(is_synesthete=factor(is_synesthete, levels=rev(levels(is_synesthete)))) %>% ungroup() %>% mutate(subject_language=factor(subject_language,levels=c("English","Dutch"))) %>% #filter(subject_language=="English") %>% mutate(is_synesthete=factor(is_synesthete, levels=c("Synesthetic Adults (Exp. 2)", "Non-Synesthetic Adults (Exp. 2)", "Non-Synesthetic\nChildren (Exp. 1)", "Non-Synesthetic Adults\n(Exp. 3 - y axis is favorite)"))) %>% filter(!is_synesthete=="Non-Synesthetic Adults\n(Exp. 3 - y axis is favorite)") %>% ggplot(aes(x=is_first,y=p))+ facet_wrap(~subject_language)+ geom_line(aes(color=is_synesthete,group=is_synesthete,linetype=is_synesthete),size=1)+ geom_point(size=2,aes(fill=is_synesthete,shape=is_synesthete),color="black")+ geom_hline(yintercept=0,alpha=0)+ labs(x="",y="P (Letter is Pink)",color="",linetype="")+ theme_apa(box=F,rotate_x=F,base_family="Arial Unicode MS",base_size=12)+ theme(axis.line=element_blank(),legend.key.width = unit(2, "line"))+ scale_shape_manual("",values=c("Non-Synesthetic\nChildren (Exp. 1)"=24, "Non-Synesthetic Adults (Exp. 2)"=22, "Synesthetic Adults (Exp. 2)"=21))+ scale_color_manual("",values=c("Non-Synesthetic\nChildren (Exp. 1)"="gray60", "Non-Synesthetic Adults (Exp. 2)"="gray60", "Synesthetic Adults (Exp. 2)"="black"))+ scale_fill_manual("",values=c("Non-Synesthetic\nChildren (Exp. 1)"="gray60", "Non-Synesthetic Adults (Exp. 2)"="gray60", "Synesthetic Adults (Exp. 2)"="black"))+ scale_linetype_manual("",values=c("Non-Synesthetic\nChildren (Exp. 1)"=2, "Non-Synesthetic Adults (Exp. 2)"=1, "Synesthetic Adults (Exp. 2)"=1))+ labs(x="",y="P(Letter is Pink)")+ annotate("segment", x=-Inf, xend=Inf, y=-Inf, yend=-Inf)+ annotate("segment", x=-Inf, xend=-Inf, y=-Inf, yend=Inf) ggsave("analysis/pink_initial/RootFig2.png",width=6,height=4,units="in",dpi=300) # Non-syn "A" is red dat_adult_p %>% filter(is_synesthete==F) %>% # Count observations group_by(subject_language, is_red=factor(color_bk=="Red",levels=c(T,F),labels=c("Red","OtherColor")), is_a=factor(inducer_is_A,levels=c(T,F),labels=c("A","OtherGrapheme"))) %>% count() %>% group_by(subject_language) %>% nest() %>% mutate(data=map(data,~xtabs(n~is_a+is_red,data=.x))) %>% mutate(stat=map(data,~broom::tidy(fisher.test(.x)))) %>% unnest(stat) # Experiment 3 # Favorite color is no longer pink dat_adult_p %>% # Count observations filter(!is.na(subject_favcolor),is_synesthete==F,inducer_is_1i) %>% ungroup() %>% summarize(n=n(),n_1i=sum(subject_favcolor=="Pink")) %>% {with(.,binom.test(n_1i,n,p=1/11,alternative="greater"))} # Non-syn favorite color is first initial dat_adult_p %>% # Count observations filter(!is.na(subject_favcolor),is_synesthete==F) %>% ungroup() %>% group_by(inducer_is_1i,is_fav=subject_favcolor==color_bk) %>% count() %>% xtabs(n~is_fav+inducer_is_1i,data=.) %>% fisher.test() # Generate Figure 3 dat_adult_p %>% mutate(color_bk=as.factor(color_bk)) %>% # Count observations group_by(is_pink=factor(color_bk=="Pink",levels=c(F,T),labels=c("Not Pink","Pink")), is_first=factor(inducer_is_1i==TRUE,levels=c(F,T),labels=c("Not First\nInitial","First\nInitial")), is_synesthete=factor(is_synesthete,levels=c(T,F), labels=c("S2","NS2")), subject_language=factor(subject_language,levels=c("English","Dutch"))) %>% count() %>% group_by(is_first,is_synesthete,subject_language) %>% mutate(p=n/sum(n)) %>% filter(is_pink=="Pink") %>% ungroup() %>% bind_rows(dat_adult_p %>% # Count observations filter(!is.na(subject_favcolor),is_synesthete==F) %>% ungroup() %>% group_by(is_fav=factor(subject_favcolor==color_bk,levels=c(T,F),labels=c("Favorite","Other")), is_first=factor(inducer_is_1i==TRUE,levels=c(F,T), labels=c("Not First\nInitial","First\nInitial"))) %>% count()%>% group_by(is_first) %>% mutate(p=n/sum(n)) %>% ungroup() %>% mutate(subject_language="English", is_synesthete="NS3") %>% filter(is_fav=="Favorite")) %>% ungroup() %>% mutate(is_synesthete=as.factor(is_synesthete)) %>% mutate(is_synesthete=factor(is_synesthete, levels=rev(levels(is_synesthete)))) %>% ungroup() %>% mutate(subject_language=factor(subject_language,levels=c("English","Dutch"))) %>% filter(subject_language=="English",!is_synesthete=="NS1") %>% mutate(is_synesthete=factor(is_synesthete, levels=c("NS3","NS2","S2"), labels=c("Non-Synesthetic Adults\n(Exp. 3 - Favorite Color)", "Non-Synesthetic Adults\n(Exp. 2 - Pink)", "Synesthetic Adults\n(Exp. 2 - Pink)"))) %>% ggplot(aes(x=is_first,y=p))+ geom_line(aes(color=is_synesthete,group=is_synesthete,linetype=is_synesthete),size=1)+ geom_point(size=2,aes(fill=is_synesthete,shape=is_synesthete),color="black")+ geom_hline(yintercept=0,alpha=0)+ labs(x="",y="P (Letter is Pink)",color="",linetype="")+ theme_apa(box=F,rotate_x=F,base_family="Arial Unicode MS",base_size=12)+ theme(axis.line=element_blank(),legend.key.width = unit(2, "line"))+ scale_color_manual("",values=c("Synesthetic Adults\n(Exp. 2 - Pink)"="pink", "Non-Synesthetic Adults\n(Exp. 2 - Pink)"="pink", "Non-Synesthetic Adults\n(Exp. 3 - Favorite Color)"="black"))+ scale_fill_manual("",values=c("Synesthetic Adults\n(Exp. 2 - Pink)"="pink", "Non-Synesthetic Adults\n(Exp. 2 - Pink)"="pink", "Non-Synesthetic Adults\n(Exp. 3 - Favorite Color)"="black"))+ scale_linetype_manual("",values=c("Non-Synesthetic Adults\n(Exp. 2 - Pink)"=1, "Synesthetic Adults\n(Exp. 2 - Pink)"=2, "Non-Synesthetic Adults\n(Exp. 3 - Favorite Color)"=1))+ scale_shape_manual("",values=c("Non-Synesthetic Adults\n(Exp. 2 - Pink)"=22, "Synesthetic Adults\n(Exp. 2 - Pink)"=21, "Non-Synesthetic Adults\n(Exp. 3 - Favorite Color)"=24))+ labs(x="",y="Proportion of Associations")+ annotate("segment", x=-Inf, xend=Inf, y=-Inf, yend=-Inf)+ annotate("segment", x=-Inf, xend=-Inf, y=-Inf, yend=Inf) #ggsave("analysis/pink_initial/RootFig3.png",width=5,height=4,units="in",dpi=300)