knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)

library(tidyverse)
library(here)
library(knitr)
library(ggimage)
library(gghalves)
library(cowplot)

Read in data

d <- read_csv(here("data","nameability_exercise_2.csv"))

Summarize the data by block and plot

By Subject

subj_2A_block <- filter(d,experiment=="2A") |> 
  group_by(subject,condition,block_num) |> 
  summarize(
    accuracy=mean(is_right))

Across Subjects

overall_2A_block <- subj_2A_block |> 
  group_by(condition,block_num) |> 
  summarize(mean_accuracy = mean(accuracy),
            sd_accuracy = sd(accuracy),
            n_obs = n(),
            sem = sd_accuracy / sqrt(n_obs))
overall_2A_block |> 
  kable()
condition block_num mean_accuracy sd_accuracy n_obs sem
high 1 0.5064103 0.2363871 39 0.0378522
high 2 0.6794872 0.2429853 39 0.0389088
high 3 0.7724359 0.1942254 39 0.0311010
high 4 0.8397436 0.1857345 39 0.0297413
high 5 0.8621795 0.1897776 39 0.0303887
high 6 0.8814103 0.1835073 39 0.0293847
low 1 0.4455128 0.1982549 39 0.0317462
low 2 0.5192308 0.1803197 39 0.0288743
low 3 0.6314103 0.2580110 39 0.0413148
low 4 0.6602564 0.2432455 39 0.0389504
low 5 0.7051282 0.2373219 39 0.0380019
low 6 0.7339744 0.2535593 39 0.0406020

Plot it

p <- ggplot(overall_2A_block, aes(block_num,mean_accuracy))+
  geom_line( aes(linetype=condition,color=condition,group=condition),linewidth=2,position=position_dodge(.05))+
  geom_errorbar(aes(ymin=mean_accuracy-sem,ymax=mean_accuracy+sem,color=condition,group=condition),width=0,size=0.75,position=position_dodge(.05))+
  geom_point(aes(fill=condition, shape=condition,color=condition,group=condition),size=4,position=position_dodge(.05))+
  theme_classic(base_size=18)+
  scale_color_brewer(palette="Set1",name="Nameability")+
  scale_fill_brewer(palette="Set1",name="Nameability")+
  scale_linetype_discrete(name="Nameability")+
  scale_shape_discrete(name="Nameability")+
  xlab("Block")+
  ylab("Training Accuracy")+
  scale_y_continuous(breaks=seq(0.4,1,0.1), limits=c(0.38,1))+
  scale_x_continuous(breaks=seq(1,6,1))+
  theme(legend.position=c(.8, .2),legend.text=element_text(size=14),legend.title=element_text(size=14,face="bold"))
p

Advanced: add an image

There are now some really nice packages for adding images to plots, like ggimage.

The general strategy here is to create a data frame (or tibble) that contains the image path and the plot coordinates for where you want those images to go.

#image dataframe
image_d <- tibble(
  #control positions of x and y axis
  block_num = c(3,3),
  mean_accuracy = c(0.9,0.45),
  #specify image paths
  image_path = c(
    here("images","high_A_000_1.png"),
    here("images","low_B_111_2.png")
  )
)

#add plot
p +
  geom_image(data=image_d,aes(image=image_path),size=0.15)

Summarize overall within-subjects effects

The plot above is great for visualizing the general condition effect, but it contains no information about the nature of the within-subject effect. Below, we explore one way to visualize both the overall effect of condition, and the within-subject effects (slopes for each participant).

By Subject

subj_2A <- filter(d,experiment=="2A") |> 
  group_by(subject,condition) |> 
  summarize(
    accuracy=mean(is_right)) |> 
  arrange(subject,condition)

Across Subjects

overall_2A <- subj_2A |> 
  group_by(condition) |> 
  summarize(mean_accuracy = mean(accuracy),
            sd_accuracy = sd(accuracy),
            n_obs = n(),
            sem = sd_accuracy / sqrt(n_obs),
            ci = sem *1.96) |> 
  arrange(condition)
overall_2A |> 
  kable()
condition mean_accuracy sd_accuracy n_obs sem ci
high 0.7569444 0.1531926 39 0.0245304 0.0480797
low 0.6159188 0.1517288 39 0.0242961 0.0476203

Visualize overall within-subject effects

p_within <- subj_2A %>%
  ggplot(aes(condition,accuracy,fill=condition,color=condition))+
  theme_cowplot()+
  #add half violins on either side of the data
  geom_half_violin(data= filter(subj_2A, condition=="high"),position = position_nudge(x = -.1, y = 0), width=0.8,adjust=1.5,trim = FALSE, alpha = .8,color=NA,side="l")+
  geom_half_violin(data=filter(subj_2A, condition=="low"),position = position_nudge(x = .1, y = 0), width=0.8,adjust=1.5,trim = FALSE, alpha = .8,color=NA,side="r")+
  #create lines connecting participants (group=subject)
  #note the use of seed in position jitter
  geom_line(aes(group=subject),position = position_jitter(width = 0.04,height=0, seed = 123),alpha=0.2,color="black") +
  geom_point(position = position_jitter(width = 0.04,height=0, seed = 123),alpha=0.8)+
  geom_errorbar(data=overall_2A,aes(y=mean_accuracy,ymin=mean_accuracy-ci,ymax=mean_accuracy+ci),width=0,size=1.2,color="black")+
  geom_point(data=overall_2A,aes(y=mean_accuracy),size=5,color="black")+
  geom_line(data=overall_2A,aes(y=mean_accuracy,group=1),size=2,color="black")+
  scale_color_brewer(palette="Set1")+
  scale_fill_brewer(palette="Set1")+
  theme(axis.title.x = element_text(face="bold", size=20),
        axis.text.x  = element_text(size=16),
        axis.title.y = element_text(face="bold", size=20),
        axis.text.y  = element_text(size=16),
        strip.text.x = element_text(size = 16,face="bold"))+
  theme(legend.position="none")+
  xlab("Nameability Condition")+
  ylab("Training Accuracy")+
  ylim(0,1)
p_within