1 Libraries

library("knitr")
library("DBI")
library("RSQLite")
library("jsonlite")
library("Metrics")
library("ggh4x")
library("ggnewscale")
library("scales")
library("broom")
library("brms")
library("tidyverse")

# Set theme to classic
theme_set(theme_classic())

custom_colors = c(
  rgb(17, 119, 51, maxColorValue = 255), # green
  rgb(136, 204, 238, maxColorValue = 255), # light blue
  rgb(170, 68, 153, maxColorValue = 255) # magenta
)

2 Prediction

2.1 Demographics

2.1.1 Load DF

data_path = "../../data/human_data/prediction/experiment_2.db"

con = dbConnect(RSQLite::SQLite(), data_path)

tables = dbListTables(con)

df = dbGetQuery(con, "SELECT * FROM plinko")

dbDisconnect(con)

df_pred_demo = df %>% 
  filter(mode == "live",
         status >= 3,
         codeversion == "experiment_2") %>% 
  mutate(part_num = seq(1, nrow(.)),
         data_json = map(.x = datastring,
                         .f = fromJSON),
         question_data = map(.x = data_json,
                             .f = ~ .$questiondata),
         gender = as.character(map(.x = question_data,
                                   .f = ~ .$sex)),
         age = as.numeric(map(.x = question_data,
                              .f = ~ .$age))) %>% 
  select(part_num, gender, age)

2.1.2 Age

df_pred_demo %>% summarise(mean_age = round(mean(age)),
                           sd_age = round(sd(age)))

##   mean_age sd_age
## 1       37     11

2.1.3 Gender

# Count the number of times male and female appear in the gender column of df_pred_demo
df_pred_demo %>% count(gender)

##   gender  n
## 1 female 21
## 2   male 24

2.2 Noisy Simulator Performance

df_human_means = read.csv("../python/prediction/human_mean_ci.csv") %>% 
  rename(human_mean = mean_response)
df_sim_means = read.csv("../python/prediction/saved_model_pred/noisy_sim_mean.csv") %>% 
  rename(sim_mean = mean)

df_model_data = df_human_means %>% 
  left_join(df_sim_means,
            by = c("world", "hole")) %>% 
  mutate(hole = as.factor(hole))

df_sum_stat = df_model_data %>% 
  summarise(r = round(cor(sim_mean, human_mean), 2),
            rmse = round(sqrt(mean((sim_mean - human_mean)^2)), 2))

df_emph_trial = df_model_data %>% 
  filter(world == 70)

ggplot(data=df_model_data,
       mapping = aes(x = sim_mean,
                     y = human_mean)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
  geom_linerange(mapping = aes(ymin = ci_lower,
                               ymax = ci_upper)) +
  geom_point(mapping=aes(fill=hole),
             shape=21,
             color="black",
             size=1) +
  geom_point(data = df_emph_trial,
             mapping = aes(fill=hole),
             shape=23,
             color="black",
             size=3) +
  geom_text(data = df_sum_stat,
            mapping = aes(x = 0, y = 580, label = paste("r = ", r)),
            hjust=0,
            size = 4) +
  geom_text(data = df_sum_stat,
            mapping = aes(x = 0, y = 540, label = paste("RMSE = ", rmse)),
            hjust=0,
            size = 4) +
  scale_fill_manual(values = custom_colors) +
  scale_x_continuous(breaks = c(0, 200, 400, 600),
                     labels = function(x) paste0(x, "px"),
                     limits = c(0,600)) + 
  scale_y_continuous(breaks = c(0, 200, 400, 600),
                     labels = function(x) paste0(x, "px"),
                     limits=c(0,600)) +
  labs(x = "Simulator Mean Prediction",
       y = "Human Mean Prediction") +
  theme(legend.position = "none",
        axis.text = element_text(size = 10),
        axis.title = element_text(size = 12))

ggsave("figures/prediction_noisy_sim_scatter.pdf",
       width = 3,
       height = 3.5)

3 Inference

3.1 Judgment

3.1.1 Load Data and Models

df_human_judgment_vision = read.csv("../../data/human_data/inference/vision_judge_summary_rt_cleaned.csv")
df_human_judgment_audio = read.csv("../../data/human_data/inference/audio_judge_summary_rt_cleaned.csv")
df_human_judgment_occluded = read.csv("../../data/human_data/inference/occluded_judge_summary_rt_cleaned.csv")

df_sequential_judgment_vision = read.csv("../python/inference/model_performance/top_models/sequential_top_vision_judgment.csv")
df_sequential_judgment_audio = read.csv("../python/inference/model_performance/top_models/sequential_top_audio_judgment.csv")
df_sequential_judgment_occluded = read.csv("../python/inference/model_performance/top_models/sequential_top_occluded_judgment.csv")

df_uniform_judgment_vision = read.csv("../python/inference/model_performance/top_models/uniform_top_vision_judgment.csv")
df_uniform_judgment_audio = read.csv("../python/inference/model_performance/top_models/uniform_top_audio_judgment.csv")
df_uniform_judgment_occluded = read.csv("../python/inference/model_performance/top_models/uniform_top_occluded_judgment.csv")

df_comp_sequential_judgment_vision = df_human_judgment_vision %>%
  left_join(df_sequential_judgment_vision,
            by = c("trial", "hole")) %>% 
  mutate("condition" = "vision")

df_comp_sequential_judgment_audio = df_human_judgment_audio %>%
  left_join(df_sequential_judgment_audio,
            by = c("trial", "hole")) %>% 
  mutate("condition" = "audio")

df_comp_sequential_judgment_occluded = df_human_judgment_occluded %>%
  left_join(df_sequential_judgment_occluded,
            by = c("trial", "hole")) %>% 
  mutate("condition" = "occluded")

df_comp_sequential_judgment = bind_rows(df_comp_sequential_judgment_vision,
                                    df_comp_sequential_judgment_audio,
                                    df_comp_sequential_judgment_occluded) %>%
  mutate(hole = as.factor(hole),
         condition = factor(condition,
                            levels=c("vision", "audio", "occluded"),
                            labels=c("No Sound + Ball Visible", "Sound + Ball Visible", "Sound + Ball Occluded")),
         Model = "Sequential Sampler")

df_comp_uniform_judgment_vision = df_human_judgment_vision %>%
  left_join(df_uniform_judgment_vision,
            by = c("trial", "hole")) %>%
  mutate("condition" = "vision")

df_comp_uniform_judgment_audio = df_human_judgment_audio %>%
  left_join(df_uniform_judgment_audio,
            by = c("trial", "hole")) %>%
  mutate("condition" = "audio")

df_comp_uniform_judgment_occluded = df_human_judgment_occluded %>%
  left_join(df_uniform_judgment_occluded,
            by = c("trial", "hole")) %>%
  mutate("condition" = "occluded")

df_comp_uniform_judgment = bind_rows(df_comp_uniform_judgment_vision,
                                     df_comp_uniform_judgment_audio,
                                     df_comp_uniform_judgment_occluded) %>%
  mutate(hole = as.factor(hole),
         condition = factor(condition,
                            levels=c("vision", "audio", "occluded"),
                            labels=c("No Sound + Ball Visible", "Sound + Ball Visible", "Sound + Ball Occluded")),
         Model = "Uniform Sampler")

3.1.2 Visualize Judgment Comparison

df_to_show = rbind(
  df_comp_sequential_judgment,
  df_comp_uniform_judgment
)

df_metrics = df_to_show %>% 
  mutate(model_y = model_y*100,
         data_y = data_y*100) %>% 
  group_by(condition, Model) %>% 
  summarise(r = round(cor(model_y, data_y), 2),
            rmse = round(rmse(data_y, model_y), 2))

## `summarise()` has grouped output by 'condition'. You can override using the
## `.groups` argument.

condition_colors = c("tomato2", "darkorange2", "gold2")

ggplot(data=df_to_show,
       mapping = aes(x = model_y,
                     y = data_y)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
  geom_linerange(mapping = aes(ymin = lower,
                               ymax = upper),
                 color = "black",
                 alpha=0.2) +
  geom_point(mapping = aes(fill=hole),
             shape=21,
             color="black") +
  geom_text(data = df_metrics,
            mapping = aes(x = 0, y = 1, label = paste("r = ", r)),
            hjust=0,
            size = 6) +
  geom_text(data = df_metrics,
            mapping = aes(x = 0, y = 0.92, label = paste("RMSE = ", rmse)),
            hjust=0,
            size = 6) +
  facet_grid2(Model ~ condition,
              strip = strip_themed(
                background_x = list(
                  element_rect(fill = condition_colors[1]),
                  element_rect(fill = condition_colors[2]),
                  element_rect(fill = condition_colors[3])
                ))) +
  scale_fill_manual(values = custom_colors) +
  scale_x_continuous(labels = percent_format(accuracy = 1)) +
  scale_y_continuous(labels = percent_format(accuracy = 1)) + 
  labs(x = "Precentage Predicted",
       y = "Percentage Selected") +
  theme(legend.position = "none",
        axis.text = element_text(size = 22),
        axis.title = element_text(size = 26),
        strip.text = element_text(size = 26),
        panel.spacing.x=unit(2, "cm"),
        panel.spacing.y=unit(1, "cm"))

ggsave("figures/judgment_combined.pdf",
       width = 20,
       height = 9)

3.1.3 Sample Trials

df_human_judgment = rbind(
  df_human_judgment_vision %>% 
    mutate(condition = "vision"),
  df_human_judgment_audio %>%
    mutate(condition = "audio"),
  df_human_judgment_occluded %>%
    mutate(condition = "occluded")
)

df_human_judgment %>% 
  filter(trial == 1) %>% 
  mutate(percent = round(data_y*100))

##   trial hole     data_y     lower     upper condition percent
## 1     1    0 0.00000000 0.0000000 0.0000000    vision       0
## 2     1    1 0.96666667 0.9000000 1.0000000    vision      97
## 3     1    2 0.03333333 0.0000000 0.1000000    vision       3
## 4     1    0 0.23333333 0.1000000 0.4000000     audio      23
## 5     1    1 0.06666667 0.0000000 0.1666667     audio       7
## 6     1    2 0.70000000 0.5333333 0.8333333     audio      70
## 7     1    0 0.40000000 0.2333333 0.6000000  occluded      40
## 8     1    1 0.00000000 0.0000000 0.0000000  occluded       0
## 9     1    2 0.60000000 0.4000000 0.7666667  occluded      60

plot_trial_bar = function(df_human_judgment, trial_id, cond) {
  
  color_map = c("vision" = "tomato2",
                 "audio" = "darkorange2",
                 "occluded" = "gold2")
  
  df_to_show = df_human_judgment %>% 
    filter(trial == trial_id,
           condition == cond) %>% 
    mutate(hole = factor(hole,
                         levels = c(0,1,2),
                         labels = c(1,2,3)))
  
  ggplot(data = df_to_show,
         mapping = aes(x = hole,
                       y = data_y)) +
    geom_bar(stat = "identity",
             fill = color_map[cond],
             color = "black",
             alpha = 0.7) +
    geom_linerange(mapping = aes(ymin = lower,
                                 ymax = upper),
                   color = "black") +
    xlab("Hole") +
    scale_x_discrete(labels=c("1", "2", "3")) +
    ylab(NULL) +
    scale_y_continuous(labels = percent_format(),
                       limits = c(0,1)) +
    theme(axis.text = element_text(size = 22),
          axis.title = element_text(size = 26))
}

plot_trial_bar(df_human_judgment, 78, "vision")

plot_trial_bar(df_human_judgment, 78, "audio")

plot_trial_bar(df_human_judgment, 78, "occluded")

3.2 EMD

3.2.1 Load Data and Models

df_emd_sequential_vision =
  read.csv("../python/inference/model_performance/top_models/sequential_top_vision_emd.csv") %>%
  mutate(model = "sequential",
         condition = "vision")
df_emd_sequential_audio = 
  read.csv("../python/inference/model_performance/top_models/sequential_top_audio_emd.csv") %>%
  mutate(model = "sequential",
         condition = "audio")
df_emd_sequential_occluded = 
  read.csv("../python/inference/model_performance/top_models/sequential_top_occluded_emd.csv") %>%
  mutate(model = "sequential",
         condition = "occluded")

df_emd_uniform_vision = read.csv("../python/inference/model_performance/top_models/uniform_top_vision_emd.csv") %>%
  mutate(model = "uniform",
          condition = "vision")
df_emd_uniform_audio = read.csv("../python/inference/model_performance/top_models/uniform_top_audio_emd.csv") %>%
  mutate(model = "uniform",
          condition = "audio")
df_emd_uniform_occluded = read.csv("../python/inference/model_performance/top_models/uniform_top_occluded_emd.csv") %>%
  mutate(model = "uniform",
          condition = "occluded")

df_emd_visual_features_vision = read.csv("../python/inference/model_performance/emd/visual_features_vision_emd.csv") %>% 
  mutate(model = "visual_features",
         condition = "vision")
df_emd_visual_features_audio = read.csv("../python/inference/model_performance/emd/visual_features_audio_emd.csv") %>% 
  mutate(model = "visual_features",
         condition = "audio")
df_emd_visual_features_occluded = read.csv("../python/inference/model_performance/emd/visual_features_occluded_emd.csv") %>% 
  mutate(model = "visual_features",
         condition = "occluded")

df_emd_baseline_vision = read.csv("../python/inference/model_performance/emd/baseline_uniform_vision_emd.csv") %>% 
  mutate(model = "baseline",
         condition = "vision")
df_emd_baseline_audio = read.csv("../python/inference/model_performance/emd/baseline_uniform_audio_emd.csv") %>%
  mutate(model = "baseline",
         condition = "audio")
df_emd_baseline_occluded = read.csv("../python/inference/model_performance/emd/baseline_uniform_occluded_emd.csv") %>%
  mutate(model = "baseline",
         condition = "occluded")

df_emd_baseline = bind_rows(df_emd_baseline_vision,
                                 df_emd_baseline_audio,
                                 df_emd_baseline_occluded) %>%
  group_by(condition) %>% 
  summarise(mean_dist = mean(distance)) %>% 
  mutate(condition = factor(condition,
                            levels = c("vision", "audio", "occluded"),
                            labels = c("No Sound + Ball Visible", "Sound + Ball Visible", "Sound + Ball Occluded"))) %>% 
  arrange(condition)

set.seed(5)

df_emd = bind_rows(
  df_emd_sequential_vision,
  df_emd_sequential_audio,
  df_emd_sequential_occluded,
  df_emd_uniform_vision,
  df_emd_uniform_audio,
  df_emd_uniform_occluded,
  df_emd_visual_features_vision,
  df_emd_visual_features_audio,
  df_emd_visual_features_occluded) %>%
  mutate(x_pos = case_when(
    model == "sequential" ~ 0,
    model == "uniform" ~ 1,
    model == "visual_features" ~ 2
  ),
  x_pos = x_pos + rnorm(nrow(.), sd = 0.1),
         condition = factor(condition,
                            levels=c("vision", "audio", "occluded"),
                            labels=c("No Sound + Ball Visible", "Sound + Ball Visible", "Sound + Ball Occluded")),
         highlight = trial == 20,
         x_pos = ifelse(model == "sequential" & highlight, 0, x_pos),
         x_pos = ifelse(model == "uniform" & highlight, 1, x_pos),
         x_pos = ifelse(model == "visual_features" & highlight, 2, x_pos),
         model = factor(model,
                        levels=c("sequential", "uniform", "visual_features"),
                        labels=c(0,1,2)),
         model = as.numeric(as.character(model)))

df_highlight = df_emd %>% 
  filter(highlight)

df_label = data.frame(
  x = -0.35,
  y = 115,
  label = "Baseline",
  condition = "No Sound + Ball Visible"
) %>% 
  mutate(condition = factor(condition))

3.2.2 Visualize EMD

ggplot(data=df_emd,
       mapping = aes(x=model,
                     y=distance)) +
  geom_hline(data = df_emd_baseline,
             mapping = aes(yintercept = mean_dist),
             linetype = "dashed",
             alpha=0.5) + 
  stat_summary(fun = "mean",
               geom = "bar",
               fill = "wheat1",
               color = "black",
               width=0.8) +
  stat_summary(fun.data = "mean_cl_boot",
               geom = "linerange",
               color = "black") +
  geom_point(mapping = aes(x=x_pos),
             alpha=0.1) +
  geom_point(data = df_highlight,
             mapping = aes(x = x_pos),
             size = 2) +
  geom_text(data = df_label,
            mapping = aes(x = x,
                          y = y,
                          label = label),
            inherit.aes = FALSE,
            hjust = 0,
            vjust = 0,
            size = 6) +
  facet_wrap2(~condition,
              ncol=3,
              strip = strip_themed(
                background_x = list(
                  element_rect(fill = condition_colors[1]),
                  element_rect(fill = condition_colors[2]),
                  element_rect(fill = condition_colors[3])
                ))) +
  scale_x_continuous(breaks = c(0,1,2),
                     labels = c("Sequential\nSampler", "Uniform\nSampler", "Visual\nFeatures")) +
  scale_y_continuous(breaks = c(50, 100, 150)) + 
  labs(x = "Model",
       y = "Earth Mover's Distance") +
  theme(axis.text.x = element_text(size = 22),
        axis.text.y = element_text(size = 22),
        axis.title.x = element_text(size = 26,
                                    margin = margin(t=15)),
        axis.title.y = element_text(size = 26),
        strip.text = element_text(size = 26),
        panel.spacing = unit(2, "cm"))

ggsave("figures/emd.pdf",
       width=20,
       height=8)

df_emd %>% 
  group_by(model, condition) %>% 
  summarize(mean_distance = round(mean(distance), 2))

## `summarise()` has grouped output by 'model'. You can override using the
## `.groups` argument.

## # A tibble: 9 × 3
## # Groups:   model [3]
##   model condition               mean_distance
##   <dbl> <fct>                           <dbl>
## 1     0 No Sound + Ball Visible          53.1
## 2     0 Sound + Ball Visible             54.4
## 3     0 Sound + Ball Occluded            44.4
## 4     1 No Sound + Ball Visible          72.5
## 5     1 Sound + Ball Visible             70.4
## 6     1 Sound + Ball Occluded            44.9
## 7     2 No Sound + Ball Visible          79.3
## 8     2 Sound + Ball Visible             79.2
## 9     2 Sound + Ball Occluded            57.3

3.3 Accuracy Analysis

df_gt = read.csv("../../data/stimuli/inference/drop_gt.csv") %>% 
  mutate(gt_hole = hole + 1) %>% 
  select(trial, gt_hole)

df_human_select_vision = read.csv("../../data/human_data/inference/vision_judgment_rt_cleaned.csv") %>% 
  select(-X) %>% 
  left_join(df_gt,
            by = "trial") %>% 
  mutate(correct = (response == gt_hole)*1)

df_human_select_audio = read.csv("../../data/human_data/inference/audio_judgment_rt_cleaned.csv") %>% 
  select(-X) %>%
  left_join(df_gt,
            by = "trial") %>%
  mutate(correct = (response == gt_hole)*1,
         experiment = "audio")

df_human_select_occluded = read.csv("../../data/human_data/inference/occluded_judgment_rt_cleaned.csv") %>% 
  select(-X) %>% 
  left_join(df_gt,
            by = "trial") %>%
  mutate(correct = (response == gt_hole)*1)

boot_prop_ci <- function(df_select, R = 1000, conf = 0.95) {
  correct = df_select$correct
  stopifnot(all(correct %in% c(0,1)))
  p_hat <- mean(correct)

  boots <- replicate(R, {
    mean(sample(correct, size = length(correct), replace = TRUE))
  })

  alpha <- (1 - conf) / 2
  ci <- as.numeric(quantile(boots, probs = c(alpha, 1 - alpha), names = FALSE))
  list(
    estimate = round(p_hat, 2),
    lower = round(ci[1], 2),
    upper = round(ci[2], 2),
    conf = conf
  )
}

3.3.1 Accuracy with 95% CI

set.seed(1)

3.3.1.1 Vision

boot_prop_ci(df_human_select_vision)

## $estimate
## [1] 0.72
## 
## $lower
## [1] 0.71
## 
## $upper
## [1] 0.73
## 
## $conf
## [1] 0.95

3.3.1.2 Audio

boot_prop_ci(df_human_select_audio)

## $estimate
## [1] 0.78
## 
## $lower
## [1] 0.77
## 
## $upper
## [1] 0.79
## 
## $conf
## [1] 0.95

3.3.1.3 Occluded

boot_prop_ci(df_human_select_occluded)

## $estimate
## [1] 0.63
## 
## $lower
## [1] 0.62
## 
## $upper
## [1] 0.65
## 
## $conf
## [1] 0.95

3.3.2 Hypothesis Testing

3.3.2.1 Occluded performance

occ_fit = brm(correct ~ 1 + (1|participant) + (1|trial),
              data = df_human_select_occluded,
              family = bernoulli(),
              cores = 4,
              seed = 1,
              file = "fits/occ_fit.rds")

summary(occ_fit)

##  Family: bernoulli 
##   Links: mu = logit 
## Formula: correct ~ 1 + (1 | participant) + (1 | trial) 
##    Data: df_human_select_occluded (Number of observations: 4481) 
##   Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
##          total post-warmup draws = 4000
## 
## Multilevel Hyperparameters:
## ~participant (Number of levels: 30) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.61      0.10     0.45     0.82 1.00      959     1682
## 
## ~trial (Number of levels: 150) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     1.92      0.13     1.69     2.20 1.00      704     1139
## 
## Regression Coefficients:
##           Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept     0.93      0.20     0.52     1.32 1.01      452      769
## 
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

# Convert samples to probability scale
post = as_draws_df(occ_fit)
prob = plogis(post$b_Intercept)
round(quantile(prob, c(0.025, 0.5, 0.975)), 2)

##  2.5%   50% 97.5% 
##  0.63  0.72  0.79

# Credible interval lower bound
round(quantile(prob, 0.05), 2)

##   5% 
## 0.64

# Probability that accuracy is above chance (1/3)
mean(prob > 1/3)

## [1] 1

3.3.2.2 Condition Differences

df_human_select_comb = rbind(
  df_human_select_vision,
  df_human_select_audio,
  df_human_select_occluded
) %>% 
  rename(condition = experiment)

cond_fit = brm(correct ~ condition + (1|participant) + (1|trial),
               data = df_human_select_comb,
               family = bernoulli(),
               cores = 4,
               seed = 1,
               file = "fits/cond_fit.rds")

summary(cond_fit)

##  Family: bernoulli 
##   Links: mu = logit 
## Formula: correct ~ condition + (1 | participant) + (1 | trial) 
##    Data: df_human_select_comb (Number of observations: 13321) 
##   Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
##          total post-warmup draws = 4000
## 
## Multilevel Hyperparameters:
## ~participant (Number of levels: 31) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.35      0.06     0.26     0.48 1.00     1131     1965
## 
## ~trial (Number of levels: 150) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     1.12      0.07     0.98     1.27 1.00      862     1633
## 
## Regression Coefficients:
##                   Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept             1.58      0.12     1.34     1.81 1.01      492      939
## conditionoccluded    -0.86      0.05    -0.97    -0.76 1.00     4782     3136
## conditionvision      -0.38      0.05    -0.48    -0.27 1.00     4465     3050
## 
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

hyps = c(
  hyp1 = "0 - conditionvision > 0",
  hyp2 = "conditionvision - conditionoccluded > 0",
  hyp3 = "0 - conditionoccluded > 0"
)

hypothesis(cond_fit, hyps, alpha = 0.025)

## Hypothesis Tests for class b:
##   Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio Post.Prob Star
## 1       hyp1     0.38      0.05     0.27     0.48        Inf         1    *
## 2       hyp2     0.48      0.05     0.39     0.58        Inf         1    *
## 3       hyp3     0.86      0.05     0.76     0.97        Inf         1    *
## ---
## 'CI': 95%-CI for one-sided and 97.5%-CI for two-sided hypotheses.
## '*': For one-sided hypotheses, the posterior probability exceeds 97.5%;
## for two-sided hypotheses, the value tested against lies outside the 97.5%-CI.
## Posterior probabilities of point hypotheses assume equal prior probabilities.

sessionInfo()

## R version 4.5.0 (2025-04-11)
## Platform: aarch64-apple-darwin20
## Running under: macOS Sequoia 15.6.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/Los_Angeles
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] lubridate_1.9.4  forcats_1.0.0    stringr_1.5.1    dplyr_1.1.4     
##  [5] purrr_1.1.0      readr_2.1.5      tidyr_1.3.1      tibble_3.2.1    
##  [9] tidyverse_2.0.0  brms_2.22.0      Rcpp_1.0.14      broom_1.0.8     
## [13] scales_1.4.0     ggnewscale_0.5.2 ggh4x_0.3.1      ggplot2_4.0.0   
## [17] Metrics_0.1.4    jsonlite_2.0.0   RSQLite_2.4.3    DBI_1.2.3       
## [21] knitr_1.50      
## 
## loaded via a namespace (and not attached):
##  [1] gridExtra_2.3        inline_0.3.21        rlang_1.1.6         
##  [4] magrittr_2.0.3       matrixStats_1.5.0    compiler_4.5.0      
##  [7] loo_2.8.0            reshape2_1.4.4       systemfonts_1.2.3   
## [10] vctrs_0.6.5          pkgconfig_2.0.3      fastmap_1.2.0       
## [13] backports_1.5.0      labeling_0.4.3       utf8_1.2.5          
## [16] rmarkdown_2.29       tzdb_0.5.0           ragg_1.4.0          
## [19] bit_4.6.0            xfun_0.52            cachem_1.1.0        
## [22] blob_1.2.4           parallel_4.5.0       cluster_2.1.8.1     
## [25] R6_2.6.1             bslib_0.9.0          stringi_1.8.7       
## [28] RColorBrewer_1.1-3   StanHeaders_2.32.10  rpart_4.1.24        
## [31] jquerylib_0.1.4      estimability_1.5.1   bookdown_0.43       
## [34] rstan_2.32.7         base64enc_0.1-3      bayesplot_1.12.0    
## [37] Matrix_1.7-3         nnet_7.3-20          timechange_0.3.0    
## [40] tidyselect_1.2.1     rstudioapi_0.17.1    abind_1.4-8         
## [43] yaml_2.3.10          codetools_0.2-20     pkgbuild_1.4.8      
## [46] plyr_1.8.9           lattice_0.22-6       withr_3.0.2         
## [49] bridgesampling_1.1-2 S7_0.2.0             posterior_1.6.1     
## [52] coda_0.19-4.1        evaluate_1.0.3       foreign_0.8-90      
## [55] RcppParallel_5.1.10  pillar_1.10.2        tensorA_0.36.2.1    
## [58] checkmate_2.3.2      stats4_4.5.0         distributional_0.5.0
## [61] generics_0.1.4       hms_1.1.3            rstantools_2.4.0    
## [64] xtable_1.8-4         glue_1.8.0           emmeans_1.11.1      
## [67] Hmisc_5.2-3          tools_4.5.0          data.table_1.17.4   
## [70] mvtnorm_1.3-3        grid_4.5.0           QuickJSR_1.7.0      
## [73] colorspace_2.1-1     nlme_3.1-168         htmlTable_2.4.3     
## [76] Formula_1.2-5        cli_3.6.5            textshaping_1.0.1   
## [79] Brobdingnag_1.2-9    gtable_0.3.6         sass_0.4.10         
## [82] digest_0.6.37        htmlwidgets_1.6.4    farver_2.1.2        
## [85] memoise_2.0.1        htmltools_0.5.8.1    lifecycle_1.0.4     
## [88] bit64_4.6.0-1

Figure Plotting

Ari Beller

2025-08-21

1 Libraries

2 Prediction

2.1 Demographics

2.1.1 Load DF

2.1.2 Age

2.1.3 Gender

2.2 Noisy Simulator Performance

3 Inference

3.1 Judgment

3.1.1 Load Data and Models

3.1.2 Visualize Judgment Comparison

3.1.3 Sample Trials

3.2 EMD

3.2.1 Load Data and Models

3.2.2 Visualize EMD

3.3 Accuracy Analysis

3.3.1 Accuracy with 95% CI

3.3.1.1 Vision

3.3.1.2 Audio

3.3.1.3 Occluded

3.3.2 Hypothesis Testing

3.3.2.1 Occluded performance

3.3.2.2 Condition Differences