Load data

#read looking data
VIDEOS <- c("reflook", "kitchen")
GROUP <- "long"

read_train_data <- function(video) {
  data <- fread(paste0("processed_data/csvs/",video,"/",GROUP,"/train_data.csv")) %>%
    mutate(video = video)
}

read_test_data <- function(video) {
  data <- fread(paste0("processed_data/csvs/",video,"/",GROUP,"/test_data.csv")) %>%
    mutate(video = video)
}

raw_train_data <- bind_rows(sapply(VIDEOS, read_train_data, simplify=FALSE)) %>%
  mutate(video = factor(video, levels = c("reflook", "kitchen")))

raw_test_data <- bind_rows(sapply(VIDEOS, read_test_data, simplify=FALSE)) %>%
  mutate(video = factor(video, levels = c("reflook", "kitchen")))

Exclusions

na_out_missing <- function(data, prop = .5) {
  
  na_props <- data %>%
    group_by(video, subj, trial) %>%
    summarise(na_prop = sum(is.na(aoi)) / length(aoi))
  
  complete_data <- na_props %>%
    filter(na_prop <= prop) %>%
    select(-na_prop) %>%
    left_join(data)
  
  missing_data <- na_props %>%
    filter(na_prop > prop) %>%
    select(-na_prop) %>%
    left_join(mutate(data, aoi = NA))
  
  bind_rows(complete_data,missing_data) %>%
    arrange(video, subj, trial,Time)
}

test_data <- na_out_missing(raw_test_data)
train_data <- na_out_missing(raw_train_data) %>%
  mutate(window_type = factor(window_type, 
                              levels = c("baseline","name_look","look_name2",
                                         "name2_reach","reach_contact",
                                         "contact_end")))

Munging

TEST_START <- 1
TEST_END <- 4
TRAIN_START <- 0
TRAIN_END <- 15

#summarize across individual trials
test_data_subj <- test_data %>% 
  filter(Time >=TEST_START, 
         Time <= TEST_END) %>%
  group_by(video, type, subj, trial) %>%
  summarise(
    prop = sum(aoi == "Target", na.rm = TRUE) / 
      (sum(aoi == "Target", na.rm = TRUE)+
         sum(aoi == "Competitor", na.rm = TRUE))) %>%
  summarise(prop = mean(prop, na.rm = TRUE))

#summarize across individual trials
test_data_time <- test_data %>% 
  group_by(video, type, Time, subj) %>%
  filter(Time >= -1, Time <= TEST_END) %>%
  summarise(correct = sum(aoi == "Target", na.rm = TRUE) / 
      (sum(aoi == "Target", na.rm = TRUE)+
         sum(aoi == "Competitor", na.rm = TRUE)))


test_data_trial <- multi_boot_standard(test_data_time, "correct", na.rm = TRUE)
test_data_trial <- multi_boot_standard(test_data_time, "correct", na.rm = TRUE)


train_data_subj <- train_data %>%
  group_by(video, window_type, subj, trial) %>%
  summarise(
    Target = mean(aoi == "Target", na.rm = T),
    Face = mean(aoi == "Face", na.rm = T),
    Competitor = mean(aoi == "Competitor", na.rm = T),
    TD = sum(aoi == "Target", na.rm = T)/
      (sum(aoi == "Target", na.rm = T) + 
         sum(aoi == "Competitor", na.rm = T))) %>%
  summarise_each(funs(mean(., na.rm = T)), Target, Face, Competitor, TD) %>%
  gather(aoi, prop, Target:TD) %>%
  group_by(video, window_type, aoi) 

test_data_video <- multi_boot_standard(test_data_subj, column = "prop", na.rm = T)

Demographics

demo_data <- test_data %>%
  distinct(video,subj) %>%
  group_by(video) %>%
  summarise(n = n(),
            num_girls = sum(gender=="Female"),
            mean_age = mean(age))

kable(demo_data)
video n num_girls mean_age
reflook 25 14 2.722849
kitchen 11 7 3.078954

Test timecourses

ggplot(test_data_trial, 
       aes(x= Time, y= mean, colour = type, fill = type, label = type))+
  facet_grid(type ~ video) +
  geom_ribbon(aes(ymin = ci_lower,
                      ymax = ci_upper),
                  size=0, alpha = .5)+
  geom_line()+
  geom_hline(aes(yintercept = .5), lty= "dashed")  +
  scale_x_continuous(name = "Time")+ 
  geom_vline(aes(yintercept = 0), lty = "dotted") +
  scale_y_continuous(limits = c(0,1), breaks=seq(0,1,.1),
                     name = "Prop. correct looks") +
  theme_bw(base_size = 16) + 
  theme(panel.grid = element_blank(), legend.position = "none",
        axis.title.x=element_text(vjust=-.5), axis.title.y=element_text(vjust=1)) +
  scale_color_brewer(palette = "Set1") +
  scale_fill_brewer(palette = "Set1")

Looking at Test

ggplot(test_data_video, 
       aes(x= video, y= mean, colour = type, label = type))+
  geom_pointrange(aes(ymin = ci_lower,
                      ymax = ci_upper),
                  size=.8)+
  geom_hline(aes(yintercept = .5), lty= "dashed")  +
  geom_line(aes(group = type)) +
  scale_x_discrete(name = "Video")+ 
  scale_y_continuous(limits = c(.3,.8), breaks=seq(.3,.8,.1),
                     name = "Prop. correct looks") +
  theme_bw(base_size = 16) + 
  theme(panel.grid = element_blank(), legend.position = "none",
        axis.title.x=element_text(vjust=-.5), axis.title.y=element_text(vjust=1)) +
  scale_color_brewer(palette = "Set1") +
  geom_dl(method = list(dl.trans(x=x +.2), "last.qp", cex=1))

plotting_data <- train_data_video %>%
  rowwise() %>%
  mutate(window_num = which(levels(window_type) == window_type)) %>%
  filter(aoi == "Target")

ggplot(plotting_data, 
       aes(x = window_num, y = mean, colour = video, group = video,
           label = video))+
  geom_pointrange(aes(ymin = ci_upper,
                      ymax = ci_lower),
                  size=1)+
  geom_hline(aes(yintercept=.5),lty=2)  +
  geom_line() +
  scale_x_continuous(name = "",breaks=seq(.5,6.5),limits=c(.5,6.5),
                     labels=c("Baseline", "Name", "Look", "Name 2", 
                              "Reach", "Contact", "End"))+
  scale_y_continuous(limits = c(.0,1), breaks=seq(.0,1,.1),
                     name = "Looks to Target") +
  theme_bw(base_size=16) + 
  theme(legend.position="none", panel.grid=element_blank(),
        axis.title.x=element_text(vjust=-.5),
        axis.title.y=element_text(vjust=1)) +
  scale_color_brewer(palette = "Set1") +
  geom_dl(method = list(dl.trans(x=x +.2), "last.qp", cex=1))

plotting_data <- train_data_video %>%
  rowwise() %>%
  mutate(window_num = which(levels(window_type) == window_type)) %>%
  filter(aoi == "TD")

ggplot(plotting_data, 
       aes(x = window_num, y = mean, colour = video, group = video,
           label = video))+
  geom_pointrange(aes(ymin = ci_upper,
                      ymax = ci_lower),
                  size=1)+
  geom_hline(aes(yintercept=.5),lty=2)  +
  geom_line() +
  scale_x_continuous(name = "",breaks=seq(.5,6.5),limits=c(.5,6.5),
                     labels=c("Baseline", "Name", "Look", "Name 2", 
                              "Reach", "Contact", "End"))+
  scale_y_continuous(limits = c(.0,1), breaks=seq(.0,1,.1),
                     name = "Looks to Target vs. Competitor") +
  theme_bw(base_size=16) + 
  theme(legend.position="none", panel.grid=element_blank(),
        axis.title.x=element_text(vjust=-.5),
        axis.title.y=element_text(vjust=1)) +
  scale_color_brewer(palette = "Set1") +
  geom_dl(method = list(dl.trans(x=x +.2), "last.qp", cex=1))

Test correlations

test_corr_data <- test_data_subj %>%
  spread(video, prop) %>%
  filter(!is.na(reflook) & !is.na(kitchen))

ggplot(test_corr_data, 
       aes(x = reflook, y = kitchen, colour = type, label = type))+
  facet_grid(. ~ type) +
  geom_smooth(method = "lm", size = 1.5) +
  geom_point(size=2)+
  scale_x_continuous(name = "Reflook",limits = c(0, 1)) +
  scale_y_continuous(name = "Kitchen",limits = c(0, 1)) +
  theme_bw(base_size=16) + 
  theme(legend.position="none", legend.title=element_blank(),
        panel.grid=element_blank(), axis.title.x=element_text(vjust=-.5),
        axis.title.y=element_text(vjust=1)) +
  scale_color_brewer(palette = "Set1")

Train correlations

target_corr_data <- train_data_subj %>%
  filter(aoi == "TD", window_type == "look_name2") %>%
  spread(video, prop) %>%
  filter(!is.na(reflook) & !is.na(kitchen))

td_corr_data <- train_data_subj %>%
  filter(aoi == "Target", window_type == "look_name2") %>%
  spread(video, prop) %>%
  filter(!is.na(reflook) & !is.na(kitchen))

train_corr_data <- bind_rows(target_corr_data, td_corr_data)

ggplot(train_corr_data, 
       aes(x = reflook, y = kitchen, colour = aoi))+
  facet_grid(. ~ aoi, scales = "free") +
  geom_smooth(method = "lm", size = 1.5) +
  geom_point(size = 2)+
  scale_x_continuous(name = "Reflook",limits = c(0, 1.2)) +
  scale_y_continuous(name = "Kitchen",limits = c(0, 1.2)) +
  theme_bw(base_size=16) + 
  theme(legend.position="none", legend.title=element_blank(),
        panel.grid=element_blank(), axis.title.x=element_text(vjust=-.5),
        axis.title.y=element_text(vjust=1)) +
  scale_color_brewer(palette = "Set1")