.Rhistory

install.packages("ggpubr")
install.packages("devtools")
devtools::install_github("langcog/langcog")
ch_loc <- hum %>% filter(DropLocation!="outside" & DropLocation!="space") %>%
group_by(DropChoice, DropLocation) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_loc <- hum %>% filter(DropLocation!="outside" & DropLocation!="space") %>%
group_by(DropChoice, DropLocation) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
# 12 trials, 9 objects; random selection would be 9/12 = 75%...
uniq_s <- hum %>% group_by(SID, Age_Group) %>%
summarise(DropObjs = n_distinct(DropChoice), N=n(), prop=DropObjs/N)
knitr::opts_chunk$set(fig.width=3, fig.height=3, fig.crop = F,
fig.pos = "tb", fig.path='figs/',
echo=F, warning=F, cache=F,
message=F, sanitize = T)
library(png)
library(grid)
library(ggplot2)
library(xtable)
require(here)
require(tidyverse)
require(tidyboot)
library(apa) # for generating APA-style text to report statistical tests
library(ggpubr)
tower = read.csv2("../analysis/human-data/curiobaby_drop-data - cool tower.csv", sep=',', header=T, stringsAsFactors=F)
raw = read.csv2("../analysis/human-data/curiobaby_drop-data - drop exp.csv", sep=',', header=T, stringsAsFactors=F)
hum = subset(raw, Exclude!="Y")
hum = hum[-which(hum$StimSet=="bc" & hum$DropChoice=="bowl and dumbbell"),] # chose two - exclude
s_tr <- hum %>% group_by(SID, Age_Group) %>% summarise(max=max(Trial)) %>% arrange(max)
age = table(s_tr$Age_Group)
shapes = c("bowl","cone","dumbbell","octahedron","pentagon","pipe","pyramid","torus","trig prism")
a = c("pyramid", "torus", "trig prism")
b = c("cone", "octahedron", "pipe")
c = c("bowl", "dumbbell", "pentagon")
hum <- hum %>%
mutate(DropSet=ifelse(StimSet %in% c("ba","ca"), "A", ifelse(StimSet %in% c("ab","cb"), "B", "C")),
TargetSet=ifelse(StimSet %in% c("ab","ac"), "A", ifelse(StimSet %in% c("ba","bc"), "B", "C")))
img <- png::readPNG("figs/drop_sets.png")
grid::grid.raster(img)
img <- png::readPNG("figs/DropTaskFigure.png")
grid::grid.raster(img)
hum$TargetSpace = ifelse(hum$DropLocation=="space", hum$WhichSpace, hum$DropLocation)
report_chisq <- function(X) {
# e.g. X^2 (2, N = 88) = 2.1, p = .35
pval = round(X$p.value, 3)
if(pval==0) {
pval = ", p<.001"
} else {
pval = paste0(", p=",pval)
}
return(paste0("($X^2$(", X$parameter, ", N=", sum(X$expected), ") = ", round(X$statistic,2), pval, ")"))
}
# see if children's choices (per subset) are random
drop_ch = table(hum$StimSet, hum$DropChoice)
# chisq.test(rbind(colSums(drop_ch[,a]), rep(sum(drop_ch[,a]/3), 3)) )
Xa_drop = chisq.test( colSums(drop_ch[,a]) ) # p<.001
Xb_drop = chisq.test( colSums(drop_ch[,b]) ) # p=.01
Xc_drop = chisq.test( colSums(drop_ch[,c]) ) # p=.056
target_ch = table(hum$StimSet, hum$DropLocation)
Xa_targ = chisq.test( colSums(target_ch[,a]) ) # n.s.
Xb_targ = chisq.test( colSums(target_ch[,b]) ) # n.s.
Xc_targ = chisq.test( colSums(target_ch[,c]) ) # n.s.
targetloc_ch = table(hum$StimSet, hum$TargetSpace)
Xa_tloc = chisq.test( colSums(targetloc_ch[,a]) ) # n.s.
Xb_tloc = chisq.test( colSums(targetloc_ch[,b]) ) # n.s.
Xc_tloc = chisq.test( colSums(targetloc_ch[,c]) ) # n.s.
# 'misses' by age
space_age = table(subset(hum, DropLocation=="space")$Age_Group)
all_age = table(hum$Age_Group)
#Xmiss_age = chisq.test(space_age, p=all_age / sum(all_age)) # n.s.
prop_space = sum(space_age) / sum(all_age)
age_s <- hum %>%
group_by(SID, Age_Exact) %>%
summarise(miss=sum(DropLocation=="space"), N=n()) %>%
mutate(prop_miss = miss / N)
age_miss = cor.test(age_s$prop_miss, as.numeric(age_s$Age_Exact))
# now check DropChoice x TargetLocation interactions
# maybe we do chisq.test on particular combinations? e.g., for DropSet A and TargetSet B?
dA = subset(hum, DropSet=="A" & TargetSet=="B")
dto = table(dA$DropChoice, dA$DropLocation)[,1:3]
#dto = table(hum$DropChoice, hum$DropLocation)[,c(1:4,6:8,10:11)] # drop 'outside' and 'space'
Xdto = chisq.test(dto)
get_table_string <- function(tableX, set) {
tt = sort(colSums(tableX[,set]))
tstr = paste(paste0(names(tt), " (", tt, "),"), collapse=' ')
tstr = gsub('.{1}$', '', tstr)
return(tstr)
}
dA = get_table_string(drop_ch, a)
dB = get_table_string(drop_ch, b)
dC = get_table_string(drop_ch, c)
tabl <- tribble(~Set, ~`Drop Object (N)`,
"A", dA,
"B", dB,
"C", dC)
t1 <- xtable::xtable(tabl, caption="Children's drop object choices by set.")
#tab1 <- xtable::xtable(summary(out)$coef, digits=c(0, 2, 2, 1, 2),
#                       caption = "This table prints across one column.")
print(t1, type="latex", comment = F, table.placement = "H")
tA = get_table_string(target_ch, a)
tB = get_table_string(target_ch, b)
tC = get_table_string(target_ch, c)
tabl2 <- tribble(~Set, ~`Target Object (N)`,
"A", tA,
"B", tB,
"C", tC)
t2 <- xtable::xtable(tabl2, caption="Children's target object choices by set.")
print(t2, type="latex", comment = F, table.placement = "H")
tA = get_table_string(targetloc_ch, a)
tB = get_table_string(targetloc_ch, b)
tC = get_table_string(targetloc_ch, c)
tabl3 <- tribble(~Set, ~`Target Location (N)`,
"A", tA,
"B", tB,
"C", tC)
t3 <- xtable::xtable(tabl3, caption="Children's target location choices by set.")
print(t3, type="latex", comment = F, table.placement = "H")
ch_cond <- hum %>%
group_by(StimSet, DropChoice) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_cond$StimSet <- factor(ch_cond$StimSet, levels = c("ba","ca","ab","cb","ac","bc"))
fig_drop <- ggplot(ch_cond, aes(x=StimSet, y=freq, shape=DropChoice, color=DropChoice)) + # , size=n
geom_point(alpha=.8) +
scale_shape_manual(values=10:19) +
#geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Stimulus Set") + ylab("Rate of Drop Object Choice") + ylim(0,.66) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.33, lty='dashed') + labs(shape="Object", color="Object")
#print(fig_drop)
hum$Target = hum$DropLocation
ch_cond <- hum %>%
filter(Target!="outside") %>%
group_by(StimSet, Target) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_cond$Target <- factor(ch_cond$Target, levels = c(shapes, "space"))
fig_targ_hit <- ggplot(ch_cond, aes(x=StimSet, y=freq, shape=Target, color=Target)) + # , size=n
geom_point(alpha=.8) +
scale_shape_manual(values=10:20) +
#geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Stimulus Set") + ylab("Rate of Target Object Hit") + ylim(0,.66) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.33, lty='dashed')
#print(fig_targ_hit)
ch_cond <- hum %>%
filter(is.element(TargetSpace, shapes)) %>%
group_by(StimSet, TargetSpace) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_cond$TargetSpace <- factor(ch_cond$TargetSpace, levels = shapes)
fig_targ_space <- ggplot(ch_cond, aes(x=StimSet, y=freq, shape=TargetSpace, color=TargetSpace)) + # , size=n
geom_point(alpha=.8) +
scale_shape_manual(values=10:19) +
#geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Stimulus Set") + ylab("Rate of Targeted Location") + ylim(0,.66) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.33, lty='dashed')
#print(fig_targ_space)
ggarrange(fig_drop, fig_targ_hit, fig_targ_space, nrow=1,
#labels = c("Drop Choice", "Targeted Object Hit", "Targeted Location"),
common.legend=T, legend="bottom")
# 12 trials, 9 objects; random selection would be 9/12 = 75%...
uniq_s <- hum %>% group_by(SID, Age_Group) %>%
summarise(DropObjs = n_distinct(DropChoice), N=n(), prop=DropObjs/N)
uniq <- uniq_s %>% group_by(Age_Group) %>%
tidyboot_mean(prop)
ggplot(uniq, aes(x=Age_Group, y=mean)) + geom_point() +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Age (years)") + ylab("Unique Objects Chosen") + ylim(0,1) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.75, lty='dashed')
ch_loc <- hum %>% filter(DropLocation!="outside" & DropLocation!="space") %>%
group_by(DropChoice, DropLocation) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ggplot(ch_loc, aes(x=DropLocation, y=DropChoice)) + geom_tile(aes(fill=freq)) +
scale_fill_gradient(low = "white", high = "steelblue") +
xlab("Target Location") + ylab("Drop Object") +
ggthemes::theme_few()
# References will be generated automatically by Pandoc and included here.
# The following code is some latex to format the bibliography. Do not remove it.
# cor.test(hum$height_tallest, hum$age_rounded)
ch_height
# cor.test(hum$height_tallest, hum$age_rounded)
hum
# cor.test(hum$height_tallest, hum$age_rounded)
str(hum)
knitr::opts_chunk$set(fig.width=3, fig.height=3, fig.crop = F,
fig.pos = "tb", fig.path='figs/',
echo=F, warning=F, cache=F,
message=F, sanitize = T)
library(png)
library(grid)
library(ggplot2)
library(xtable)
require(here)
require(tidyverse)
require(tidyboot)
library(apa) # for generating APA-style text to report statistical tests
library(ggpubr)
tower = read.csv2("../analysis/human-data/curiobaby_drop-data - cool tower.csv", sep=',', header=T, stringsAsFactors=F)
raw = read.csv2("../analysis/human-data/curiobaby_drop-data - drop exp.csv", sep=',', header=T, stringsAsFactors=F)
hum = subset(raw, Exclude!="Y")
hum = hum[-which(hum$StimSet=="bc" & hum$DropChoice=="bowl and dumbbell"),] # chose two - exclude
s_tr <- hum %>% group_by(SID, Age_Group) %>% summarise(max=max(Trial)) %>% arrange(max)
age = table(s_tr$Age_Group)
shapes = c("bowl","cone","dumbbell","octahedron","pentagon","pipe","pyramid","torus","trig prism")
a = c("pyramid", "torus", "trig prism")
b = c("cone", "octahedron", "pipe")
c = c("bowl", "dumbbell", "pentagon")
hum <- hum %>%
mutate(DropSet=ifelse(StimSet %in% c("ba","ca"), "A", ifelse(StimSet %in% c("ab","cb"), "B", "C")),
TargetSet=ifelse(StimSet %in% c("ab","ac"), "A", ifelse(StimSet %in% c("ba","bc"), "B", "C")))
img <- png::readPNG("figs/drop_sets.png")
grid::grid.raster(img)
img <- png::readPNG("figs/DropTaskFigure.png")
grid::grid.raster(img)
hum$TargetSpace = ifelse(hum$DropLocation=="space", hum$WhichSpace, hum$DropLocation)
report_chisq <- function(X) {
# e.g. X^2 (2, N = 88) = 2.1, p = .35
pval = round(X$p.value, 3)
if(pval==0) {
pval = ", p<.001"
} else {
pval = paste0(", p=",pval)
}
return(paste0("($X^2$(", X$parameter, ", N=", sum(X$expected), ") = ", round(X$statistic,2), pval, ")"))
}
# see if children's choices (per subset) are random
drop_ch = table(hum$StimSet, hum$DropChoice)
# chisq.test(rbind(colSums(drop_ch[,a]), rep(sum(drop_ch[,a]/3), 3)) )
Xa_drop = chisq.test( colSums(drop_ch[,a]) ) # p<.001
Xb_drop = chisq.test( colSums(drop_ch[,b]) ) # p=.01
Xc_drop = chisq.test( colSums(drop_ch[,c]) ) # p=.056
target_ch = table(hum$StimSet, hum$DropLocation)
Xa_targ = chisq.test( colSums(target_ch[,a]) ) # n.s.
Xb_targ = chisq.test( colSums(target_ch[,b]) ) # n.s.
Xc_targ = chisq.test( colSums(target_ch[,c]) ) # n.s.
targetloc_ch = table(hum$StimSet, hum$TargetSpace)
Xa_tloc = chisq.test( colSums(targetloc_ch[,a]) ) # n.s.
Xb_tloc = chisq.test( colSums(targetloc_ch[,b]) ) # n.s.
Xc_tloc = chisq.test( colSums(targetloc_ch[,c]) ) # n.s.
# 'misses' by age
space_age = table(subset(hum, DropLocation=="space")$Age_Group)
all_age = table(hum$Age_Group)
#Xmiss_age = chisq.test(space_age, p=all_age / sum(all_age)) # n.s.
prop_space = sum(space_age) / sum(all_age)
age_s <- hum %>%
group_by(SID, Age_Exact) %>%
summarise(miss=sum(DropLocation=="space"), N=n()) %>%
mutate(prop_miss = miss / N)
age_miss = cor.test(age_s$prop_miss, as.numeric(age_s$Age_Exact))
# now check DropChoice x TargetLocation interactions
# maybe we do chisq.test on particular combinations? e.g., for DropSet A and TargetSet B?
dA = subset(hum, DropSet=="A" & TargetSet=="B")
dto = table(dA$DropChoice, dA$DropLocation)[,1:3]
#dto = table(hum$DropChoice, hum$DropLocation)[,c(1:4,6:8,10:11)] # drop 'outside' and 'space'
Xdto = chisq.test(dto)
get_table_string <- function(tableX, set) {
tt = sort(colSums(tableX[,set]))
tstr = paste(paste0(names(tt), " (", tt, "),"), collapse=' ')
tstr = gsub('.{1}$', '', tstr)
return(tstr)
}
dA = get_table_string(drop_ch, a)
dB = get_table_string(drop_ch, b)
dC = get_table_string(drop_ch, c)
tabl <- tribble(~Set, ~`Drop Object (N)`,
"A", dA,
"B", dB,
"C", dC)
t1 <- xtable::xtable(tabl, caption="Children's drop object choices by set.")
#tab1 <- xtable::xtable(summary(out)$coef, digits=c(0, 2, 2, 1, 2),
#                       caption = "This table prints across one column.")
print(t1, type="latex", comment = F, table.placement = "H")
tA = get_table_string(target_ch, a)
tB = get_table_string(target_ch, b)
tC = get_table_string(target_ch, c)
tabl2 <- tribble(~Set, ~`Target Object (N)`,
"A", tA,
"B", tB,
"C", tC)
t2 <- xtable::xtable(tabl2, caption="Children's target object choices by set.")
print(t2, type="latex", comment = F, table.placement = "H")
tA = get_table_string(targetloc_ch, a)
tB = get_table_string(targetloc_ch, b)
tC = get_table_string(targetloc_ch, c)
tabl3 <- tribble(~Set, ~`Target Location (N)`,
"A", tA,
"B", tB,
"C", tC)
t3 <- xtable::xtable(tabl3, caption="Children's target location choices by set.")
print(t3, type="latex", comment = F, table.placement = "H")
ch_cond <- hum %>%
group_by(StimSet, DropChoice) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_cond$StimSet <- factor(ch_cond$StimSet, levels = c("ba","ca","ab","cb","ac","bc"))
fig_drop <- ggplot(ch_cond, aes(x=StimSet, y=freq, shape=DropChoice, color=DropChoice)) + # , size=n
geom_point(alpha=.8) +
scale_shape_manual(values=10:19) +
#geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Stimulus Set") + ylab("Rate of Drop Object Choice") + ylim(0,.66) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.33, lty='dashed') + labs(shape="Object", color="Object")
#print(fig_drop)
hum$Target = hum$DropLocation
ch_cond <- hum %>%
filter(Target!="outside") %>%
group_by(StimSet, Target) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_cond$Target <- factor(ch_cond$Target, levels = c(shapes, "space"))
fig_targ_hit <- ggplot(ch_cond, aes(x=StimSet, y=freq, shape=Target, color=Target)) + # , size=n
geom_point(alpha=.8) +
scale_shape_manual(values=10:20) +
#geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Stimulus Set") + ylab("Rate of Target Object Hit") + ylim(0,.66) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.33, lty='dashed')
#print(fig_targ_hit)
ch_cond <- hum %>%
filter(is.element(TargetSpace, shapes)) %>%
group_by(StimSet, TargetSpace) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ch_cond$TargetSpace <- factor(ch_cond$TargetSpace, levels = shapes)
fig_targ_space <- ggplot(ch_cond, aes(x=StimSet, y=freq, shape=TargetSpace, color=TargetSpace)) + # , size=n
geom_point(alpha=.8) +
scale_shape_manual(values=10:19) +
#geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Stimulus Set") + ylab("Rate of Targeted Location") + ylim(0,.66) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.33, lty='dashed')
#print(fig_targ_space)
ggarrange(fig_drop, fig_targ_hit, fig_targ_space, nrow=1,
#labels = c("Drop Choice", "Targeted Object Hit", "Targeted Location"),
common.legend=T, legend="bottom")
# 12 trials, 9 objects; random selection would be 9/12 = 75%...
uniq_s <- hum %>% group_by(SID, Age_Group) %>%
summarise(DropObjs = n_distinct(DropChoice), N=n(), prop=DropObjs/N)
uniq <- uniq_s %>% group_by(Age_Group) %>%
tidyboot_mean(prop)
ggplot(uniq, aes(x=Age_Group, y=mean)) + geom_point() +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
xlab("Age (years)") + ylab("Unique Objects Chosen") + ylim(0,1) +
langcog::scale_fill_solarized() + ggthemes::theme_few() +
geom_hline(yintercept=.75, lty='dashed')
ch_loc <- hum %>% filter(DropLocation!="outside" & DropLocation!="space") %>%
group_by(DropChoice, DropLocation) %>%
summarise(n = n()) %>%
mutate(freq = n / sum(n))
ggplot(ch_loc, aes(x=DropLocation, y=DropChoice)) + geom_tile(aes(fill=freq)) +
scale_fill_gradient(low = "white", high = "steelblue") +
xlab("Target Location") + ylab("Drop Object") +
ggthemes::theme_few()
# cor.test(hum$height_tallest, hum$age_rounded)
# ch_height <- hum %>% group_by(Age_Group, height_tallest) %>%
#   summarise(n = n()) %>%
#   mutate(freq = n / sum(n))
#
# ggplot(ch_height, aes(x=age_group, y=height_tallest)) +
#   geom_smooth(method="lm", level=0.90) + geom_point(alpha=.8, aes(size=n)) +
#   scale_shape_manual(values=10:19) +
#   xlab("Age") + ylab("Height_Tallest") + ylim(0,10) +
#   langcog::scale_fill_solarized() + ggthemes::theme_few()
# References will be generated automatically by Pandoc and included here.
# The following code is some latex to format the bibliography. Do not remove it.