rm(list=ls())
library(readr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
library(langcog)
## 
## Attaching package: 'langcog'
## The following object is masked from 'package:base':
## 
##     scale
library(ggplot2)
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
## 
##     date
library(zoo) # for moving averages
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
d <- read_csv("../data/consolidated_data_passing.csv")
d$posture <- factor(d$posture)
d$orientation <- factor(d$orientation)

demo <- read_csv("../data/demographics/demographics.csv")

Analysis of detections

basic detections

mss <- d %>%
  group_by(age.grp, subid) %>%
  summarise(face = mean(face)) %>%
  group_by(age.grp)

ms <- mss %>%
  multi_boot_standard(col = "face")
## Joining, by = "age.grp"
ggplot(mss, aes(x = age.grp, y = face)) + 
  geom_jitter(width = .25) + 
  geom_pointrange(data = ms, 
                 aes(x = age.grp, 
                     y = mean, 
                     ymin = ci_lower, 
                     ymax = ci_upper), col = "red") +
  geom_line(data = ms, 
             aes(x = age.grp, 
                     y = mean), col = "red") + 
  scale_x_continuous(breaks=c(8,12,16)) +
  ylab("Proportion Face Detections") + 
  xlab("Age (months)") + 
  theme_bw()

And with continuous age. This is probably the simplest option.

mss <- d %>%
  filter(!is.na(age.at.test)) %>%
  group_by(subid, age.at.test) %>%
  summarise(face = mean(face)) %>%
  left_join(demo) %>%
  mutate(len = as.numeric(as.duration(ms(len))))
## Joining, by = c("subid", "age.at.test")
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
## estimate only: convert periods to intervals for accuracy
ggplot(mss, aes(x = age.at.test, y = face)) + 
  geom_jitter(width = .25, aes(size = len)) + 
  geom_smooth() + 
  scale_x_continuous(breaks=c(8,12,16)) +
  scale_size_continuous(name = "Length (s)") + 
  ylab("Proportion Face Detections") + 
  xlab("Age (months)") + 
  theme_bw()

Boxplot, though it’s not as good.

ggplot(mss, aes(x = factor(age.grp), y = face)) + 
  geom_boxplot() + 
  ylab("Proportion Face Detections") + 
  xlab("Age (months)") + 
  theme_bw()

Stats. Standard ANOVA (violates distributional assumptions).

mod <- lm(face ~ factor(age.grp), data = mss)
summary(mod)
## 
## Call:
## lm(formula = face ~ factor(age.grp), data = mss)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.06557 -0.03640 -0.01747  0.01736  0.24241 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)   
## (Intercept)        0.065573   0.019520   3.359  0.00227 **
## factor(age.grp)12 -0.037457   0.029817  -1.256  0.21940   
## factor(age.grp)16 -0.002401   0.028952  -0.083  0.93449   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.06762 on 28 degrees of freedom
## Multiple R-squared:  0.06211,    Adjusted R-squared:  -0.00488 
## F-statistic: 0.9272 on 2 and 28 DF,  p-value: 0.4075
anova(mod)
## Analysis of Variance Table
## 
## Response: face
##                 Df   Sum Sq   Mean Sq F value Pr(>F)
## factor(age.grp)  2 0.008478 0.0042391  0.9272 0.4075
## Residuals       28 0.128020 0.0045721

Now a non-parametric test.

kruskal.test(face ~ factor(age.grp), data = mss)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  face by factor(age.grp)
## Kruskal-Wallis chi-squared = 1.3202, df = 2, p-value = 0.5168

detections timecourse

Do a 10s moving window average.

d <- d %>%
  group_by(subid) %>%
  mutate(face_avg = rollapply(data = face, 
                              width = 30*10, # 10s window
                              FUN = mean, 
                              align = "right", 
                              fill = NA, 
                              na.rm = TRUE))
ggplot(d, aes(x = frame, y = face_avg)) + 
  geom_line() + 
  facet_wrap(~subid) + 
  theme_bw()
## Warning: Removed 308 rows containing missing values (geom_path).

Analysis of detections by posture and orientation

Posture

mss <- d %>%
  filter(!is.na(posture)) %>%
  group_by(age.grp, posture, subid) %>%
  summarise(face = mean(face)) %>%
  group_by(age.grp)

# ms <- mss %>%
#   multi_boot_standard(col = "face")
  
ggplot(mss, aes(x = factor(age.grp), y = face, col = posture)) + 
  geom_boxplot() + 
  ylab("Proportion Face Detections") + 
  xlab("Age (months)") + 
  theme_bw()

Orientation

mss <- d %>%
  filter(!is.na(orientation)) %>%
  group_by(age.grp, orientation, subid) %>%
  summarise(face = mean(face)) %>%
  group_by(age.grp)

# ms <- mss %>%
#   multi_boot_standard(col = "face")
  
ggplot(mss, aes(x = factor(age.grp), y = face, col = orientation)) + 
  geom_boxplot() + 
  ylab("Proportion Face Detections") + 
  xlab("Age (months)") + 
  theme_bw()

Both

Not really enough data to say much when binned this finely.

mss <- d %>%
  filter(!is.na(posture) & !is.na(orientation)) %>%
  group_by(age.grp, posture, orientation, subid) %>%
  summarise(face = mean(face)) %>%
  group_by(age.grp)

# ms <- mss %>%
#   multi_boot_standard(col = "face")
  
ggplot(mss, aes(x = factor(age.grp), y = face, col = posture)) + 
  geom_boxplot() + 
  ylab("Proportion Face Detections") + 
  xlab("Age (months)") + 
  facet_grid(~orientation) + 
  ylim(c(0,.2)) + 
  theme_bw() 
## Warning: Removed 6 rows containing non-finite values (stat_boxplot).