Set constants

#CONSTANTS
TEST_START <- .5
TEST_END <- 4
LEARN_START <- 0
LEARN_END <- 15

Load data

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

read_learn_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_learn_data <- bind_rows(sapply(VIDEOS, read_learn_data, simplify=FALSE)) %>%
  mutate(video = factor(video, levels = c("reflook", "kitchen", "birthday"))) %>%
  filter(str_detect(subj, "PRPT"))

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

treatment_groups <- read_csv("raw_data/demo_data/asd_treatment.csv")

Exclude trials with >50% missing data, exclude participants with > 50% missing trials

na_out_missing <- function(data, prop = .75) {
  
  max_trials <- length(unique(data$trial))
  
  na_props <- data %>%
    group_by(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))
  
  missing_trials <- missing_data %>%
    group_by(subj) %>%
    summarise(num_trials = length(unique(trial))) %>%
    filter(num_trials > (max_trials * prop))
  
  together_data <- bind_rows(complete_data,missing_data)
  
  drop_subjs <- together_data %>%
    filter(subj %in% missing_trials$subj) %>%
    mutate(aoi = NA)
  
  bind_rows(filter(together_data, !subj %in% missing_trials$subj),
            drop_subjs) %>%
    arrange(subj, trial,Time) 
}

test_data <- na_out_missing(raw_test_data) %>%
  left_join(treatment_groups)

learn_data <- na_out_missing(raw_learn_data) %>%
  left_join(treatment_groups) %>%
  mutate(window_type = factor(window_type, 
                              levels = c("baseline","name_look","look_name2",
                                         "name2_reach","reach_contact",
                                         "contact_end")))

na_exclusions <- function(data) {
  
  na_data <- data %>%
    group_by(video, subj, trial) %>%
    summarise(na_trial = (sum(is.na(aoi)/length(aoi))) == 1) %>%
    group_by(video, subj) %>%
    summarise(na_trial = mean(na_trial)) %>%
    mutate(na_subj = na_trial == 1)

  left_join(summarise(na_data, na_subj = mean(na_subj)),
            summarise(filter(na_data, !na_subj), na_trial = mean(na_trial)))
}

na_test_exclusions <- na_exclusions(test_data)
na_learn_exclusions <- na_exclusions(learn_data)

kable(na_test_exclusions)
video na_subj na_trial
reflook 0.0454545 0.1875000
kitchen 0.0000000 0.2039474
birthday 0.0000000 0.1180556 
kable(na_learn_exclusions)
video na_subj na_trial
reflook 0.0000000 0.1306818
kitchen 0.0526316 0.1041667
birthday 0.0000000 0.0486111 
demos <- test_data %>%
  group_by(video, group, subj) %>%
  distinct() %>%
  select(video, group, subj) %>%
  mutate(value = 1) %>%
  spread(video, value, fill = 0) %>%
  gather_("video", "value", VIDEOS) %>%
  mutate(video = factor(video, levels = VIDEOS)) 

graph_demos <- demos %>%
  arrange(group, subj) %>%
  rowwise() %>%
  mutate(value = if(value == 0 ) 0
         else if(group == "control") 1
         else 2) %>%
  mutate(value = factor(value, levels = c(0, 1, 2))) %>%
  mutate(graph_subj = paste(group, subj, sep = "-"))

#quartz(width = 6, height = 6)
ggplot(data = graph_demos,
       aes(x = video, y = rev(graph_subj), fill = value)) +
  geom_tile(color = "white") + 
  scale_fill_manual(values = c("white", "blue", "green")) +
  scale_y_discrete(name = "Participant", labels = rev(graph_demos$subj)) +
  theme_bw() +
  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))

ps <- demos %>%
  group_by(group, video) %>%
  summarise(n = sum(value))

kable(ps)
group video n
control reflook 13
control kitchen 11
control birthday 11
treatment reflook 9
treatment kitchen 8
treatment birthday 7 
test_data_subj <- test_data %>% 
  filter(Time >=TEST_START, 
         Time <= TEST_END) %>%
  group_by(group, video, subj, type, 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))

face_data_subj <- learn_data %>%
  group_by(group, video, subj, type, trial) %>%
  summarise(
    prop = sum(aoi == "Face", na.rm = T)/
      (sum(!is.na(aoi)))) %>%
  summarise(prop = mean(prop, na.rm = TRUE))

learn_data_subj <- learn_data %>%
  group_by(window_type, group, video, subj, type, trial) %>%
  summarise(
    prop = sum(aoi == "Target", na.rm = T)/
      (sum(aoi == "Target", na.rm = T) + 
         sum(aoi == "Competitor", na.rm = T) + 
         sum(aoi == "Face"))) %>%
  summarise(prop = mean(prop, na.rm = TRUE))

test_data_group <- test_data_subj %>%
  group_by(group, video, type) %>%
  summarize_each(funs(mean(.,na.rm = T), sem(., na.rm = T)), prop)

learn_data_group <- learn_data_subj %>%
  group_by(group, window_type, video, type) %>%
  summarize_each(funs(mean(.,na.rm = T), sem(., na.rm = T)), prop)

face_data_group <- face_data_subj %>%
  group_by(group, video, type) %>%
  summarize_each(funs(mean(.,na.rm = T), sem(., na.rm = T)), prop)

Test plot

#quartz(width = 6, height = 4)
ggplot(test_data_group, 
       aes(x = video, y = mean, colour = group, label = group))+
  facet_wrap(~ type) +
  geom_pointrange(aes(ymin = mean + sem,
                      ymax = mean - sem),
                  size=.7, position = position_dodge(.1))+
  geom_hline(aes(yintercept=.5),lty=2)  +
  geom_line(aes(group=interaction(group,type))) +
  scale_x_discrete(name = "Video") + 
  scale_y_continuous(limits = c(.2,1), breaks=seq(.2,1,.2),
                    name = "Prop. Looks to Target") +
  theme_bw(base_size=18) + 
    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)) +
  geom_dl(method = list("smart.grid", cex=1.25)) +
  scale_color_brewer(palette = "Set1")

Face plot

#quartz(width = 6, height = 4)
ggplot(face_data_group, 
       aes(x = video, y = mean, colour = group, label = group))+
  geom_pointrange(aes(ymin = mean + sem,
                      ymax = mean - sem),
                  size=.7, position = position_dodge(.1))+
  geom_line(aes(group=interaction(group,type))) +
  scale_x_discrete(name = "Video") + 
  scale_y_continuous(limits = c(.0,.4), breaks=seq(.0,.4,.1),
                    name = "Prop. Looks to Face") +
  theme_bw(base_size=18) + 
    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)) +
  geom_dl(method = list("smart.grid", cex=1.25)) +
  scale_color_brewer(palette = "Set1")

Learning plot

plotting_data <- learn_data_group %>%
  rowwise() %>%
  mutate(window_num = which(levels(window_type) == window_type))

#quartz(width=8, height=4, title = "Learning")
ggplot(plotting_data, aes(x = window_num, y = mean, colour = group, 
                               group = group, label = group)) +
  facet_wrap(~ video) +
  geom_pointrange(aes(ymin = mean + sem,
                      ymax = mean - sem),
                  position = position_dodge(.1),
                  size=.5)+
  geom_line(position = position_dodge(.1)) +
  scale_x_continuous(name = "",breaks=seq(.5,6.5),limits=c(.5,6.5),
                     labels=c("Baseline", "Name", "Look", "Name 2", 
                              "Reach", "Contact", "End"))+
  expand_limits(x = 10) +
  scale_y_continuous(limits = c(0,1), breaks = seq(0, 1, .1),
                     name = "Prop. Looks to Target") +
  theme_bw(base_size = 16) + 
  theme(legend.position=c(.1,.6), legend.title = element_blank(),
        panel.grid=element_blank()) +
  scale_color_brewer(palette = "Set1")

Test correlations

get_corr_plot_data <- function(df, dv) {
  
  df %>%
    filter(type == dv) %>%
    spread(video, prop) %>%
    ungroup() %>%
    select(-subj, -group, -type) %>%
    filter(complete.cases(.))

}

ggcorplot(get_corr_plot_data(face_data_subj, "Learning"))

ggcorplot(get_corr_plot_data(test_data_subj, "Familiar"))

ggcorplot(get_corr_plot_data(test_data_subj, "Novel"))