Setup

library(knitr); library(magrittr); library(tidyverse); library(here)
theme_set(theme_minimal() +
            theme(legend.position = "top",
                  axis.text.x = element_text(angle = 0, vjust = 0.5),
                  panel.border = element_rect(fill=NA, size=0.5, color = "grey")))

Read data.

d_path <- "data/02_tidy_data/"

## action priors
d_prior_name <- "goal_actions_prior_tidy.csv"
d_prior <- read_csv(here(d_path, d_prior_name))

## action/beliefs data
d_file_name <- "goal_actions_ver3_tidy_full_sample.csv"
d <- read_csv(here(d_path, d_file_name)) 
d %<>% mutate(hypothesis_type = factor(hypothesis_type) %>% fct_rev(),
              hypothesis = factor(hypothesis) %>% fct_rev())

Table of comments

d %>% 
  select(id, age, condition, about) %>% 
  unique() %>% 
  arrange(condition) %>% 
  group_by(condition) %>% 
  sample_n(size = 5) %>% 
  kable()
id age condition about
128 37 learning operation of a toy and how well a person is paying attention to directions.
164 40 learning assumptions?
29 24 learning testing people
114 24 learning testing a toy and the actions and functions of the toy.
41 30 learning instincts
34 24 nogoal unsure
38 39 nogoal no idea
49 37 nogoal how we problem solve
154 41 nogoal i am not sure, but i enjoyed it a lot.
171 27 nogoal how people make choices
132 28 performance no idea
84 43 performance unsure
158 38 performance to see if people can follow instructions
61 35 performance choosing toys
100 28 performance reasoning
13 25 presentation unsure
123 30 presentation no idea
160 34 presentation i don’t know.
172 40 presentation not sure
161 55 presentation deciding with limited information

Data checks and filtering

How many participants in each condition?

d %>% 
  select(id, condition) %>% 
  unique() %>% 
  count(condition) %>% 
  kable()
condition n
learning 53
nogoal 48
performance 47
presentation 48

How did participants do on the manipulation checks?

d %>% 
  select(id, manip_check_score) %>% 
  unique() %>% 
  pull(manip_check_score) %>% 
  qplot()

How many participants passed the manipulation checks?

d %>% 
  filter(manip_check_score >= 2) %>% 
  distinct(id, condition) %>% 
  count(condition) %>% 
  kable()
condition n
learning 51
nogoal 47
performance 45
presentation 46

Now filter if the participant got fewer than 3 out of 3 manipulation checks correct.

d %<>% filter(manip_check_score >= 2)

Priors over actions

Make table.

d_prior %>% 
  select(id, action_response, why_action) %>% 
  sample_n(size = 15) %>% 
  kable()
id action_response why_action
27 button i pushed the button because i think buttons require so little effort and are so easily pushed compared to the lever that requires a little bit more work to pull, so the button must be the obvious choice to utilize.
45 button it’s the one that stood out most to me
28 button i’d want to see what happened when i pushed the button - and the button was red so it called my attention.
24 button it felt like the most logical choice overall
9 button to be honest, i’m not sure. it was just a kneejerk reaction i think.
35 both curiosity
25 both maybe that action is the right one to operate it
47 both just thinking about what they may do.
5 handle it reminded me of the old slots machines. and it’s more fun than pushing a button.
17 button seems like it might be the best result based on speculation only
37 handle it looked cool.
10 both i selected this option to try to see if i could do both options at once.
41 handle it seemed like the most fun
18 button i felt pressing the button or pulling the lever was most likely to cause the object to do something. i felt that the button was a quick way to test the device.
33 both it seemed to give the highest chance of success

Plot distribution over actions.

d_prior %>% 
  count(action_response) %>% 
  mutate(m = n / sum(n)) %>% 
  ggplot(aes(x = action_response, y = m)) +
  geom_bar(stat = "identity", width = 0.4) +
  geom_hline(yintercept = 0.3, linetype = "dashed") +
  lims(y = c(0,0.7)) +
  ggthemes::scale_fill_ptol() +
  theme(legend.position = "top",
        axis.text.x = element_text(angle = 45, vjust = 0.5),
        panel.border = element_rect(fill=NA, size=0.5, color = "grey"))

Prior and posterior beliefs

Now summarise and plot.

d %>% 
  group_by(hypothesis_type, condition, hypothesis) %>% 
  summarise(m = mean(slider_value_normalized)) %>% 
  ggplot(aes(x = hypothesis, y = m, fill = condition)) +
  geom_bar(stat = "identity", width = 0.4, position = position_dodge()) +
  geom_hline(yintercept = 0.3, linetype = "dashed") +
  lims(y = c(0,0.5)) +
  ggthemes::scale_fill_ptol() +
  theme(legend.position = "top",
        axis.text.x = element_text(angle = 45, vjust = 0.5),
        panel.border = element_rect(fill=NA, size=0.5, color = "grey")) +
  facet_wrap(~hypothesis_type)

Action responses

Plot counts of different action responses for the learning vs. performance goal conditions.

d %>% 
  select(condition, action_response, id) %>% 
  mutate(condition = fct_recode(condition,
                                "No goal" = "nogoal",
                                "Learning" = "learning",
                                "Performance" = "performance",
                                "Presentation" = "presentation")) %>%
  unique() %>% 
  count(action_response, condition) %>% 
  group_by(condition) %>% 
  mutate(prop = n / sum(n)) %>% 
  ggplot(aes(x = action_response, y = prop, fill = condition)) +
  geom_bar(stat = "identity", width = 0.4, position = position_dodge()) +
  lims(y = c(0,1)) +
  ggthemes::scale_fill_ptol() +
  facet_grid(.~condition) +
  theme(panel.border = element_rect(fill=NA, size=0.5, color = "grey")) +
  xlab("Action responses") +
  guides(fill=FALSE)

Make a table of the raw counts.

d %>% 
  select(condition, action_response, id) %>% 
  unique() %>% 
  count(action_response, condition) %>% 
  arrange(condition, action_response) %>% 
  knitr::kable()
action_response condition n
both learning 16
button learning 13
handle learning 22
both nogoal 29
button nogoal 9
handle nogoal 9
both performance 33
button performance 3
handle performance 9
both presentation 40
button presentation 1
handle presentation 5

Experiment time distributions

Plot the distribution of overall time on the experiment across conditions.

d %>% 
  select(id, experiment_time, condition) %>% 
  filter(experiment_time <= 2 * sd(experiment_time)) %>% 
  unique() %>% 
  ggplot(aes(x = condition, y = experiment_time / 60)) +
  geom_boxplot(width = 0.3) +
  lims(y = c(0,8)) +
  labs(y = "Time (min)")

Make the same plot, but for the time spent on the action decision.

d %>% 
  select(id, action_trial_time, condition) %>% 
  filter(action_trial_time <= 1 * sd(action_trial_time)) %>% 
  unique() %>% 
  ggplot(aes(x = condition, y = action_trial_time)) +
  geom_boxplot(width = 0.3) +
  labs(y = c("time (sec)"), x= NULL) +
  theme(panel.border = element_rect(fill=NA, size=0.5, color = "grey"))

Plot belief change

here we plot belief change as a function of condition and the action that participants chose.

d %>% 
  ggplot(aes(x = hypothesis_type, y = slider_value_normalized, 
             color = action_response)) +
  geom_line(aes(group = id), size = 0.5) + 
  geom_jitter(width = 0, size = 2) +
  lims(y = c(0,1)) +
  labs(x = NULL, y = "Belief") + 
  facet_grid(hypothesis~condition) +
  ggthemes::scale_color_ptol() +
  theme(legend.position = "top",
        panel.border = element_rect(fill=NA, size=0.5, color = "grey"))

Get the total belief change for each participant and plot as a function of condition.

d %>% 
  select(id, condition, hypothesis, hypothesis_type, slider_value_normalized, 
         action_response) %>% 
  spread(key = hypothesis_type, slider_value_normalized) %>% 
  mutate(belief_change = (prior - posterior) %>% abs()) %>% 
  mutate(action_belief = ifelse(action_response == hypothesis, TRUE, FALSE)) %>% 
  filter(action_belief == TRUE) %>% 
  group_by(id, condition, action_response) %>% 
  summarise(ss_m = mean(belief_change)) %>% 
  ggplot(aes(x = action_response, y = ss_m, color = condition)) +
  geom_violin(draw_quantiles = 0.5, trim = T, width = 1, size = 1, 
              adjust = 1, fill = NA) +
  geom_jitter(width = 0.07, alpha = 1, shape = 21, color = "darkgrey") +
  ggthemes::scale_color_ptol() +
  facet_wrap(~condition, ncol = 4)