# Packages
library(scales)
library(knitr)
library(here)
library(janitor)
library(latex2exp)
library(brms)
library(distributional)
library(posterior)
library(rstan)
library(patchwork)
library(tidybayes)
library(ggdist)
library(tidyverse)
# Some settings common to all modules
source(here("modules/_common.R"))Experiment 1 from Metcalfe et al. (2022):
Procedure. Ninety general information questions (see theonline supplemental material) from Nelson and Narens’ (1980) norms, as updated in Bloom et al. (2018), were presented in a random order. The participant typed in an answer and then made a con dence judgment about the correctness of their answer on a sliding scale from 0% (not at all confident) to 100% (completely confident). They were then given yes/no feedback about the correctness of their answer. If incorrect, they rated their curiosity to find out the correct answer on a sliding scale from 0% (do not care) to 100% (care very much).
dat <- read_rds(here("data/metcalfe.rds"))
dat <- dat |>
mutate(
confidence = confidence / 100,
curiosity = curiosity / 100
)
head(dat) |>
kable()| subject | item | confidence | curiosity | accuracy |
|---|---|---|---|---|
| 1 | 90 | 0.03 | NA | Correct |
| 1 | 10 | 0.04 | 0.00 | Error |
| 1 | 42 | 0.00 | NA | Correct |
| 1 | 20 | 0.16 | 0.00 | Error |
| 1 | 9 | 0.51 | 0.74 | Error |
| 1 | 57 | 0.00 | 0.60 | Error |
dat <- dat |>
mutate(
cl_confidence = case_when(
confidence == 0 ~ "left",
confidence == 1 ~ "right",
TRUE ~ "none"
),
cl_curiosity = case_when(
curiosity == 0 ~ "left",
curiosity == 1 ~ "right",
TRUE ~ "none"
)
)
head(dat) |>
kable()| subject | item | confidence | curiosity | accuracy | cl_confidence | cl_curiosity |
|---|---|---|---|---|---|---|
| 1 | 90 | 0.03 | NA | Correct | none | none |
| 1 | 10 | 0.04 | 0.00 | Error | none | left |
| 1 | 42 | 0.00 | NA | Correct | left | none |
| 1 | 20 | 0.16 | 0.00 | Error | none | left |
| 1 | 9 | 0.51 | 0.74 | Error | none | none |
| 1 | 57 | 0.00 | 0.60 | Error | left | none |
pa <- dat |>
ggplot(aes(confidence, fill = accuracy)) +
scale_fill_brewer(
"Accuracy",
palette = "Set1"
) +
geom_histogram(position = "dodge")
pb <- pa %+%
filter(
pa$data,
subject %in% sample(unique(dat$subject), 9)
) +
facet_wrap("subject")
(pa | pb) +
plot_layout(guides = "collect", axis_titles = "collect")
bf_g <- bf(
confidence ~
1 + accuracy +
(1 + accuracy | subject)
) +
gaussian()
fitg <- brm(
bf_g,
data = dat,
control = list(adapt_delta = .95),
file = here("models/censored-0")
)bf_c <- bf(
confidence | cens(cl_confidence) ~
1 + accuracy +
(1 + accuracy | subject)
) +
gaussian()
fitc <- brm(
bf_c,
data = dat,
control = list(adapt_delta = .95),
file = here("models/censored-1")
)summary(fitg)
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: confidence ~ 1 + accuracy + (1 + accuracy | subject)
#> Data: dat (Number of observations: 3873)
#> Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
#> total post-warmup draws = 4000
#>
#> Multilevel Hyperparameters:
#> ~subject (Number of levels: 44)
#> Estimate Est.Error l-95% CI u-95% CI Rhat
#> sd(Intercept) 0.11 0.01 0.09 0.14 1.00
#> sd(accuracyCorrect) 0.08 0.01 0.05 0.11 1.00
#> cor(Intercept,accuracyCorrect) -0.14 0.20 -0.52 0.26 1.00
#> Bulk_ESS Tail_ESS
#> sd(Intercept) 1212 1677
#> sd(accuracyCorrect) 1808 2696
#> cor(Intercept,accuracyCorrect) 2492 2954
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept 0.22 0.02 0.19 0.26 1.01 812 1553
#> accuracyCorrect 0.50 0.01 0.47 0.53 1.00 2807 2650
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.27 0.00 0.26 0.28 1.00 7919 2660
#>
#> Draws were sampled using sample(hmc). 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).
summary(fitc)
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: confidence | cens(cl_confidence) ~ 1 + accuracy + (1 + accuracy | subject)
#> Data: dat (Number of observations: 3873)
#> Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
#> total post-warmup draws = 4000
#>
#> Multilevel Hyperparameters:
#> ~subject (Number of levels: 44)
#> Estimate Est.Error l-95% CI u-95% CI Rhat
#> sd(Intercept) 0.20 0.02 0.16 0.25 1.00
#> sd(accuracyCorrect) 0.18 0.03 0.13 0.24 1.00
#> cor(Intercept,accuracyCorrect) -0.38 0.16 -0.65 -0.04 1.01
#> Bulk_ESS Tail_ESS
#> sd(Intercept) 975 1640
#> sd(accuracyCorrect) 1366 2514
#> cor(Intercept,accuracyCorrect) 1430 2392
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept 0.10 0.03 0.04 0.17 1.01 541 1096
#> accuracyCorrect 0.71 0.03 0.65 0.77 1.00 1445 2633
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.40 0.01 0.39 0.41 1.00 8960 2909
#>
#> Draws were sampled using sample(hmc). 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).# Add LOO criteria to all models
fitg <- add_criterion(fitg, "loo")
fitc <- add_criterion(fitc, "loo")loo_compare(
fitc, fitg
)
#> elpd_diff se_diff
#> fitg 0.0 0.0
#> fitc -1918.1 25.8