AR Color Depth Analysis

Load necessary packages and setup

Read in .csv files, separate by distance

sub_csvs <- list.files("UTD_Output_data", pattern = ".csv", recursive = T, full.names = T)

dist_mats <- list()

for (i in 1:length(sub_csvs)){
    subdat <- read.csv(sub_csvs[i])
    unique_stims <- sort(unique(c(subdat$Left.Color, subdat$Right.Color)))
    dist_mats[[i]] <- distSeparate(subdat)
}

#Data frame rather than list
list.to.convert <- lapply(sub_csvs, read.csv)
subdat.df <- rbindlist(list.to.convert)
head(subdat.df)

    Subj. Trial.   Left.Color Right.Color Left.Luminance..0.bright.1.dark.
1: 114984      1     LightRed DarkMagenta                                0
2: 114984      2  DarkMagenta    DarkBlue                                1
3: 114984      3    DarkGreen  DarkYellow                                1
4: 114984      4      DarkRed  LightGreen                                1
5: 114984      5    LightBlue    DarkCyan                                0
6: 114984      6 LightMagenta    DarkBlue                                0
   Right.Luminance..0.bright.1.dark. Viewing.Distance.1.5.3...8.m.
1:                                 1                           7.0
2:                                 1                           3.0
3:                                 1                           3.0
4:                                 0                           1.5
5:                                 1                           3.0
6:                                 1                           1.5
   User.response.0.left.1.right. ResponseTime..ms.
1:                             0           3732.34
2:                             1           5800.76
3:                             0           3781.45
4:                             1           3867.59
5:                             0           3117.21
6:                             1           2884.56

colnames(subdat.df)

[1] "Subj."                             "Trial."                           
[3] "Left.Color"                        "Right.Color"                      
[5] "Left.Luminance..0.bright.1.dark."  "Right.Luminance..0.bright.1.dark."
[7] "Viewing.Distance.1.5.3...8.m."     "User.response.0.left.1.right."    
[9] "ResponseTime..ms."                

Do some checking

#make sure everybody saw all pairs
#make sure we have the right amount of trials at each distance: DONE
#check RTs?

#Num unique subjects
length(sub_csvs)

[1] 10

length(dist_mats)

[1] 10

all.combos <- combn(unique_stims, 2)

#Check dimensions of dist_mats: Num trials, same color never presented together, and all 12 colors presented L/R
for (i in 1:length(sub_csvs)) {
    
    x <- sapply(dist_mats[[i]], function(x) dim(x)[1])
    if (all(x == 66)){print("Pass: This participant has 66 trials per distance, thus 198 total")}
    
    y <- sapply(dist_mats[[i]], function(x) sum(x$Left.Color !=  x$Right.Color))
    if(all(y == 66)) {print("Pass: The same color never presented together")}
    
    z <- sapply(dist_mats[[i]], function(x) c(length(unique(x$Left.Color)),
                                              length(unique(x$Right.Color))))
    if(all(z == 12)) {print("Pass: All 12 colors presented L/R")}
    
    #check RTs
    subRTs <- dist_mats[[i]] %>%
        reduce(bind_rows) %>%
        select(ResponseTime..ms.)
    hist(subRTs$ResponseTime..ms.)
    print(paste0(sum(subRTs$ResponseTime..ms. < 100), " trials faster than 100ms"))
}

[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"

[1] "1 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "1 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"
[1] "Pass: This participant has 66 trials per distance, thus 198 total"
[1] "Pass: The same color never presented together"
[1] "Pass: All 12 colors presented L/R"

[1] "0 trials faster than 100ms"

Make preference matrices

#probably a better, existing way to do this, but I haven't found it yet

pref_mat_list <- list()

unique_stims <- sort(unique(c(subdat$Left.Color, subdat$Right.Color)))

for (i in 1:length(dist_mats)){
    
    pref_mat_list[[i]] <- list()
    
    for (j in 1:3){
        
        tempdat <- dist_mats[[i]][[j]]
        
        
        
        submat <- matrix(0, ncol = 12, nrow = 12,
                         dimnames = list(unique_stims, unique_stims))
        
        for (k in 1:66){
            
            tempresp <- tempdat$User.response.0.left.1.right.[k]
            
            #if participant responded with 0, then left color
            # if 1, then right color
            
            if (tempresp == 0){
                
                preferred <- tempdat$Left.Color[k]
                non <- tempdat$Right.Color[k]
                
            } else if (tempresp == 1){
                
                non <- tempdat$Left.Color[k]
                preferred <- tempdat$Right.Color[k]
                
            }
            
            submat[rownames(submat) == preferred, colnames(submat) == non] <- 
                submat[rownames(submat) == preferred, colnames(submat) == non] + 1
            
        }
        pref_mat_list[[i]][[j]] <- submat
    }    
}

Aggregate pref matrices for each distance (and plot?)

dist1.5all <- pref_mat_list %>%
    map(1) %>%
    reduce(`+`)

dist3all <- pref_mat_list %>%
    map(2) %>%
    reduce(`+`)

dist7all <- pref_mat_list %>%
    map(3) %>%
    reduce(`+`)

corrplot(dist1.5all, is.corr = F, order = "FPC")

Get aggregate rankings at each distance

cols <- c("DarkBlue" = "#000080", 
          "DarkCyan" = "#003838",
          "DarkGreen" = "#003D00", 
          "DarkMagenta" = "#470047",
          "DarkRed" = "#520000", 
          "DarkYellow" = "#323200",
          "LightBlue" = "#0000FF", 
          "LightCyan" = "#007070",
          "LightGreen" = "#007900", 
          "LightMagenta" = "#8E008E",
          "LightRed" = "#A50000", 
          "LightYellow" = "#656500")

# 1.5 meters
sums1.5 <- rowSums(dist1.5all)
sums3 <- rowSums(dist3all)
sums7 <- rowSums(dist7all)

allsums <- data.frame(colors = c(names(sums1.5), names(sums3), names(sums7)),
                      preferred.count = c(sums1.5, sums3, sums7),
                      distance = rep(c(1.5,3,7), each = 12))

allsums %>%
    mutate(colors_fact = colors,
           colors = reorder_within(colors, preferred.count, distance)) %>%
    ggplot(aes(x=colors, y=preferred.count, fill = colors_fact)) +
    facet_wrap(distance ~ ., scales = "free_x") +
    geom_bar(stat = "identity") +
    theme_classic() +
    theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1),
          legend.position = "none") +
    scale_fill_manual(values = cols)