This is the same as Norming Study 2 except for three changes:
#Munge
d = read.csv("KE3_A.csv")
d.long = d %>%
gather(variable, value, contains("_")) %>%
mutate(trial_num = unlist(lapply(strsplit(as.character(variable),
"_"),function(x) x[2])),
variable = unlist(lapply(strsplit(as.character(variable),
"_"),function(x) x[1]))) %>%
spread(variable, value) %>%
mutate(trial_num = as.numeric(trial_num),
rating = as.numeric(rating),
obj = as.factor(obj))
d.long %>%
group_by(subids) %>%
slice(1) %>%
ungroup () %>%
count(condition) %>%
kable()
condition | n |
---|---|
building_time | 79 |
visual_complexity | 81 |
d.long %>%
mutate(subids = as.factor(subids)) %>%
ggplot(aes(y = rating, x=subids, fill = condition)) +
facet_wrap(~condition, nrow = 2, drop = TRUE, scales = "free") +
geom_boxplot() +
theme_bw() +
theme(axis.text.x = element_text(angle = 90,
vjust = .3, hjust = 1),
legend.position = "none")
d_long_c <- filter(d.long, subids != 155 & subids != 68 & subids != 138)
Three subjs (155, 68, 138) show little to no variability. Drop them.
#Distribution across all responses
ggplot(d_long_c, aes(x = rating, fill = condition)) +
geom_histogram() +
facet_wrap(~condition) +
theme_bw() +
theme(legend.position = "none")
ggplot(d_long_c, aes(y = rating, x = condition, fill = condition)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
condition.ratings = d_long_c %>%
group_by(condition, obj) %>%
multi_boot_standard(col = "rating") %>%
mutate(obj_lab = unlist(lapply(strsplit(as.character(obj),
"_b.jpg"),function(x) x[1]))) %>%
ungroup()
condition.ratings %>%
filter(condition == "building_time") %>%
arrange(mean) %>%
mutate(obj_lab = fct_reorder(obj_lab, mean),
obj = paste0("thumbnail/", obj),
pic_height = rep_len(c(1 ,.95, .9),length.out = n())) %>%
ggplot(aes(x = obj_lab, y = mean)) +
geom_bar(stat = "identity", fill = "#F8766D" ) +
geom_image(aes(image=obj, y = pic_height), size = .04, by = "width") +
geom_linerange(aes(ymax=ci_upper, ymin=ci_lower)) +
theme_bw() +
xlab("Structure") +
ylab("Mean Rating") +
ggtitle("Building Difficulty") +
ylim(0,1) +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = .3, hjust = 1))
condition.ratings %>%
filter(condition == "visual_complexity") %>%
arrange(mean) %>%
mutate(obj_lab = fct_reorder(obj_lab, mean),
obj = paste0("thumbnail/", obj),
pic_height = rep_len(c(1 ,.95, .9),length.out = n())) %>%
ggplot(aes(x = obj_lab, y = mean)) +
geom_bar(stat = "identity", fill = "#F8766D" ) +
geom_image(aes(image=obj, y = pic_height), size = .04, by = "width") +
geom_linerange(aes(ymax=ci_upper, ymin=ci_lower)) +
theme_bw() +
xlab("Structure") +
ylab("Mean Rating") +
ggtitle("Visual Complexity") +
ylim(0,1) +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = .3, hjust = 1))
corrs = condition.ratings %>%
select(-ci_lower, -ci_upper) %>%
spread(condition, mean)
cor.test(corrs$building_time, corrs$visual_complexity) %>%
tidy() %>%
kable()
estimate | statistic | p.value | parameter | conf.low | conf.high | method | alternative |
---|---|---|---|---|---|---|---|
0.7599812 | 10.84365 | 0 | 86 | 0.6547583 | 0.8363067 | Pearson’s product-moment correlation | two.sided |
Somewhat less correlated than previous version (.81 vs. .76).
condition.ratings %>%
select(-ci_lower, -ci_upper) %>%
spread(condition, mean) %>%
mutate(obj = paste0("thumbnail/", obj)) %>%
ggplot(aes(y = visual_complexity, x = building_time)) +
geom_smooth(method=lm) +
geom_image(aes(image=obj), size = .04, by = "width") +
ylab("visual complexity") +
xlab("building time") +
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = .3, hjust = 1))
condition.ratings %>%
select(-ci_lower, -ci_upper) %>%
spread(condition, mean) %>%
mutate(obj_lab = unlist(lapply(strsplit(as.character(obj),
"_b.jpg"),function(x) x[1]))) %>%
ggplot(aes(y = visual_complexity, x = building_time)) +
geom_smooth(method=lm) +
geom_label(aes(label = obj_lab), size = 3)+
ylab("visual complexity") +
xlab("building time") +
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = .3, hjust = 1))
condition.ratings %>%
gather(variable, value, -c(condition, obj)) %>%
unite(temp, condition, variable) %>%
spread(temp, value) %>%
mutate_if(is.character, as.numeric) %>%
ggplot(aes(y = as.numeric(visual_complexity_mean), x = as.numeric(building_time_mean))) +
geom_smooth(method=lm) +
geom_pointrange(aes(ymin = visual_complexity_ci_lower,
ymax = visual_complexity_ci_upper), size = .5) +
geom_errorbarh(aes(xmax = building_time_ci_lower,
xmin = building_time_ci_upper, height = 0)) +
xlim(0,.95) +
ylim(0,.9) +
ylab("visual complexity") +
xlab("building time") +
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = .3, hjust = 1))
Triangle shape indicates difference is significantly different from zero.
The ratings from both conditions are scaled before calculating item means and differences scores.
scale_this <- function(x){
(x - mean(x, na.rm=TRUE)) / sd(x, na.rm=TRUE)
}
diff.scaled.df = d_long_c %>%
group_by(obj) %>%
mutate( rating.scale = scale_this(rating)) %>%
do(te = tidy(t.test(rating.scale ~ condition, data = .))) %>%
mutate(diff = te$estimate,
ci_lower = te$conf.low,
ci_upper = te$conf.high,
p = te$p.value,
obj_lab = unlist(lapply(strsplit(as.character(obj),
"_b.jpg"),function(x) x[1]))) %>%
select(-te) %>%
arrange(diff) %>%
mutate(sig = ifelse(p < .05, "sig", ""))
diff.scaled.df %>%
mutate(obj_lab = fct_reorder(obj_lab, diff),
obj = paste0("thumbnail/", obj),
pic_height = rep_len(c(1.5 ,1.7, 1.9),n())) %>%
ggplot(aes(x =reorder(obj_lab,diff), y = diff)) +
geom_image(aes(image=obj, y = pic_height), size = .04, by = "width") +
geom_hline(yintercept = 0,color = "red") +
geom_pointrange(aes(ymin = ci_lower,
ymax = ci_upper, shape = sig), size = .6) +
xlab("object name") +
ylab("rating difference (BT-VC) \n higher -> more complex in terms of BT than VC" ) +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, vjust = .3, hjust = 1))