## Loading required package: here
## here() starts at /Users/gkacherg/Documents/GitHub/curiobaby_drop
## Loading required package: tidyverse
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.2     ✓ purrr   0.3.4
## ✓ tibble  3.0.4     ✓ dplyr   1.0.2
## ✓ tidyr   1.1.2     ✓ stringr 1.4.0
## ✓ readr   1.4.0     ✓ forcats 0.5.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## Loading required package: tidyboot
## Loading required package: gridExtra
## 
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
## 
##     combine

Load Model Data

This is preliminary, not final model data.

Load Adult Data

## 
## ── Column specification ────────────────────────────────────────────────────────
## cols(
##   .default = col_character(),
##   X37 = col_logical()
## )
## ℹ Use `spec()` for the full column specifications.
## `summarise()` regrouping output by 'drop' (override with `.groups` argument)

At a trial level, are the adults’ and model’s choices correlated?

Load Child Data

## 
## ── Column specification ────────────────────────────────────────────────────────
## cols(
##   .default = col_character(),
##   ID = col_double(),
##   Age = col_double()
## )
## ℹ Use `spec()` for the full column specifications.
## `summarise()` regrouping output by 'relation', 'drop' (override with `.groups` argument)
## 
##  Pearson's product-moment correlation
## 
## data:  child_trial_agg$chose_target and adult_trial_agg$chose_target
## t = 0.71563, df = 18, p-value = 0.4834
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.2981375  0.5671070
## sample estimates:
##       cor 
## 0.1663271
relation drop target child_target_choice adult_target_choice model_target_choice
contain pipe cone 0.58 0.91 0.67
contain bowl pyramid 0.72 0.89 0.73
contain dumbbell pipe 0.65 0.89 0.20
contain cone torus 0.73 0.86 0.68
contain sphere bowl 0.79 0.77 0.18
contain torus cone 0.68 0.71 0.57
contain trig prism bowl 0.63 0.69 0.50
contain pyramid torus 0.73 0.57 0.58
contain octahedron pipe 0.59 0.53 0.70
contain pentagon bowl 0.67 0.49 0.35
support bowl torus 0.71 0.94 0.45
support pentagon pipe 0.59 0.94 0.50
support dumbbell pentagon 0.40 0.91 0.46
support pipe torus 0.57 0.89 0.50
support sphere pipe 0.56 0.82 0.45
support torus bowl 0.69 0.80 0.55
support octahedron pentagon 0.44 0.68 0.53
support trig prism pentagon 0.65 0.63 0.50
support cone trig prism 0.48 0.46 0.43
support pyramid trig prism 0.50 0.43 0.59 
## Adding missing grouping variables: `relation`, `drop`
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'

Can we estimate a single item “interestingness” from the 2AFC data?

##             
##              bowl cone dumbbell dumbell octahedron pentagon pipe pyramid
##   bowl          0    0        0       0          0        0    0      44
##   cone          0    0        0       0         17        0    0       0
##   dumbbell      0    0        0       0         37       25   40      21
##   octahedron    0    0        0       0          0       27   36      34
##   pentagon     41    0        0       0          0        0   36      25
##   pipe          0   36       25       1         26        0    0       0
##   pyramid       0    0       17       0          0        0    0       0
##   sphere       49   27        0       0          0       13   35       0
##   torus        43   42       20       0         19        0    0       0
##   trig prism   39   22       23       0          0       40    0       0
##             
##              pyramid? sphere torus trig prism
##   bowl              0      0    44         35
##   cone              0     32    45         29
##   dumbbell          1      0     0          0
##   octahedron        0     25     0          0
##   pentagon          0     20     0          0
##   pipe              0      0    35          0
##   pyramid           0     31    45         31
##   sphere            0      0     0          0
##   torus             0      0     0          0
##   trig prism        0      0     0          0

Compare Children’s and Adult’s Choices Per Trial

## `geom_smooth()` using formula 'y ~ x'

Compare Children’s and Adults’ Relational Choices

## `summarise()` regrouping output by 'ID', 'AgeGroup' (override with `.groups` argument)
## `summarise()` regrouping output by 'ID', 'AgeGroup' (override with `.groups` argument)

Reliability

Check reliability of responses within- and across-conditions (support and containment).

# library(psych) # has a (Cronbach's) alpha function that takes a covariance matrix

# split subjects in half, check cor between halves
split_half_subj_cor <- function(dat, nsim=100) {
  subjs = unique(dat$ID)
  cors = rep(NA, nsim)
  for(i in 1:nsim) {
    idx1 = sample(subjs, size=length(subjs)/2)
    idx2 = setdiff(subjs, idx1) # nonsampled items
    h1 <- dat %>% filter(is.element(ID, idx1)) %>% 
      group_by(AgeGroup, Trial) %>%
      summarise(mean = mean(chose_target, na.rm=T), .groups="keep")
    h2 <- dat %>% filter(is.element(ID, idx2)) %>% 
      group_by(AgeGroup, Trial) %>%
      summarise(mean = mean(chose_target, na.rm=T), .groups="keep")
    cors[i] = cor(h1$mean, h2$mean)
  }
  return(cors)
}

# overall
sh_subj = split_half_subj_cor(combo_dat)

sh_subj_adult = split_half_subj_cor(subset(combo_dat, AgeGroup=="adult"))

sh_subj_child = split_half_subj_cor(subset(combo_dat, AgeGroup=="child"))

sh_subj_contain = split_half_subj_cor(subset(combo_dat, relation=="contain"))

sh_subj_support = split_half_subj_cor(subset(combo_dat, relation=="support"))

# split items in half, check cor between halves...GK: I don't think we care about this

Split-half reliability for all subjects: 0.73. Split-half reliability for adults: 0.79. Split-half reliability for children: 0.56.

Split-half reliability for contain relations: 0.65. Split-half reliability for support relations: 0.61.