Fitting different IRT models to a small subset of the Who Knows Data
And extracting the ability parameter (1|user_id) to compare
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(rstan)## Loading required package: StanHeaders##
## rstan version 2.36.0.9000 (Stan version 2.36.0)## For execution on a local, multicore CPU with excess RAM we recommend calling
## options(mc.cores = parallel::detectCores()).
## To avoid recompilation of unchanged Stan programs, we recommend calling
## rstan_options(auto_write = TRUE)
## For within-chain threading using `reduce_sum()` or `map_rect()` Stan functions,
## change `threads_per_chain` option:
## rstan_options(threads_per_chain = 1)library(brms)## Loading required package: Rcpp## Loading 'brms' package (version 2.22.0). Useful instructions
## can be found by typing help('brms'). A more detailed introduction
## to the package is available through vignette('brms_overview').##
## Attaching package: 'brms'## The following object is masked from 'package:rstan':
##
## loo## The following object is masked from 'package:stats':
##
## arlibrary(cmdstanr)## This is cmdstanr version 0.8.1## - CmdStanR documentation and vignettes: mc-stan.org/cmdstanr## - CmdStan path: /home/sc.uni-leipzig.de/xl76asob/.cmdstan/cmdstan-2.36.0## - CmdStan version: 2.36.0library(ggplot2)
app_data <- read.csv("../data/responses_2025-02-09.csv") %>% as_tibble()
app_data <- app_data %>%
mutate(item_type = case_when(
response_option_8 == 8 ~ "rating",
response_option_2 == "Nein" ~ "yes_no",
response_option_1 == "weiß es" ~ "knowledge",
TRUE ~ "pick_free_response"),
guess_prob = case_when(
response_option_8 == 8 ~ if_else(response == 1 | response == 10, 0.2, 0.3),
response_option_2 == "Nein" ~ 0.5,
response_option_1 == "weiß es" ~ 0.5,
TRUE ~ 0.25)) %>%
group_by(user_id) %>%
mutate(played_games = n() / 5) %>%
ungroup()
table(app_data$item_type)##
## knowledge pick_free_response rating yes_no
## 131707 224838 119670 305578table(app_data$guess_prob)##
## 0.2 0.25 0.3 0.5
## 10999 224838 108671 437285xtabs(~ guess_prob + response, app_data)## response
## guess_prob 1 2 3 4 5 6 7 8 9
## 0.2 6448 0 0 0 0 0 0 0 0
## 0.25 55811 57023 55210 56794 0 0 0 0 0
## 0.3 0 12463 19531 10345 8185 9103 20846 20172 8026
## 0.5 264883 172402 0 0 0 0 0 0 0
## response
## guess_prob 10
## 0.2 4551
## 0.25 0
## 0.3 0
## 0.5 0app_data %>% group_by(item_type) %>%
summarise(mean(response_is_correct), mean(guess_prob))## # A tibble: 4 × 3
## item_type `mean(response_is_correct)` `mean(guess_prob)`
## <chr> <dbl> <dbl>
## 1 knowledge 0.654 0.5
## 2 pick_free_response 0.374 0.25
## 3 rating 0.385 0.291
## 4 yes_no 0.586 0.5users <- read.csv("../data/users_2025-02-09.csv") %>% as_tibble()
app_data$item_user_id <- paste(app_data$item_id, app_data$user_id, sep = "_")
app_data$user_target_id <- paste(app_data$user_id, app_data$target_id, sep = "_")
app_data$item_target_id <- paste(app_data$item_id, app_data$target_id, sep = "_")
app_data_X <- app_data %>% sample_n(1000)
red_app_data <- app_data %>%
filter(played_games > 9) %>%
group_by(user_id) %>%
filter(n_distinct(target_id) > 10)
red_yes_no <- red_app_data %>%
filter(item_type == "yes_no")
red_yes_no <- red_yes_no %>% left_join(users, by = "user_id")
options(brms.backend = "cmdstanr", mc.cores = 4, brms.file_refit = "on_change")
push <- function(model) {
msg <- paste(capture.output(summary(model)),collapse = "\n")
msg <- stringr::str_sub(msg, 360, 360 + 1023)
pushoverr::pushover(msg, deparse(substitute(model)), app = "a7qjzcymviuyhn7ofq6poh3da3tr5h")
}
red_app_data$response2 = red_app_data$response_is_correct
red_app_data2 = red_app_data %>% ungroup() %>% filter(row_number() <= 10000)
items = as.numeric(names(sort(table(red_app_data$item_id))))
targets = as.numeric(names(sort(table(red_app_data$target_id))))
# no learning
red_app_data <-
red_app_data %>% group_by(target_id, user_id, item_id) %>%
filter(row_number() == 1)
red_app_data2 = red_app_data %>%
ungroup() %>%
group_by(target_id, item_id) %>%
filter(n_distinct(user_id) >= 100) %>%
filter(item_id %in% tail(items, 100)) %>%
filter(target_id %in% tail(targets, 100)) %>%
group_by(user_id) %>%
arrange(desc(n())) %>%
group_by() %>%
filter(user_id %in% head(unique(user_id), 100))
n_distinct(red_app_data2$user_id)## [1] 100n_distinct(red_app_data2$target_id)## [1] 74n_distinct(red_app_data2$item_id)## [1] 100table(red_app_data2$item_type)##
## knowledge pick_free_response rating yes_no
## 29 1025 630 1626formula_1pl <- bf(
response_is_correct ~ item_type +
(1 | user_id) +
(1 | item_id) +
(1 | target_id) +
(1 | item_id:user_id) +
(1 | target_id:user_id) +
(1 | item_id:target_id),
family = brmsfamily("bernoulli", link = "logit")
)
default_prior(formula_1pl, data = red_app_data2)## prior class coef group
## (flat) b
## (flat) b item_typepick_free_response
## (flat) b item_typerating
## (flat) b item_typeyes_no
## student_t(3, 0, 2.5) Intercept
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id
## student_t(3, 0, 2.5) sd Intercept item_id
## student_t(3, 0, 2.5) sd item_id:target_id
## student_t(3, 0, 2.5) sd Intercept item_id:target_id
## student_t(3, 0, 2.5) sd item_id:user_id
## student_t(3, 0, 2.5) sd Intercept item_id:user_id
## student_t(3, 0, 2.5) sd target_id
## student_t(3, 0, 2.5) sd Intercept target_id
## student_t(3, 0, 2.5) sd target_id:user_id
## student_t(3, 0, 2.5) sd Intercept target_id:user_id
## student_t(3, 0, 2.5) sd user_id
## student_t(3, 0, 2.5) sd Intercept user_id
## resp dpar nlpar lb ub source
## default
## (vectorized)
## (vectorized)
## (vectorized)
## default
## 0 default
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)priors_1pl <- c(
# Regularized priors for intercepts (if present)
prior(normal(0, 1), class = "b"),
prior(normal(0, 1), class = "sd")
)
m_1pl <- brm(
formula = formula_1pl,
data = red_app_data2,
prior = priors_1pl,
iter = 5000,
warmup = 2000,
# threads = threading(2)
file = "m_1pl"
)
m_1pl## Family: bernoulli
## Links: mu = logit
## Formula: response_is_correct ~ item_type + (1 | user_id) + (1 | item_id) + (1 | target_id) + (1 | item_id:user_id) + (1 | target_id:user_id) + (1 | item_id:target_id)
## Data: red_app_data2 (Number of observations: 3310)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Multilevel Hyperparameters:
## ~item_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.34 0.14 0.04 0.60 1.00 1436 2120
##
## ~item_id:target_id (Number of levels: 791)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 1.10 0.12 0.88 1.37 1.00 1369 2956
##
## ~item_id:user_id (Number of levels: 2600)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.54 0.26 0.04 1.02 1.01 580 1471
##
## ~target_id (Number of levels: 74)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.32 0.12 0.06 0.56 1.00 2107 2578
##
## ~target_id:user_id (Number of levels: 2097)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.49 0.22 0.05 0.88 1.00 578 1180
##
## ~user_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.14 0.09 0.01 0.32 1.00 2622 4670
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.30 0.51 -0.68 1.31 1.00 7476
## item_typepick_free_response -0.89 0.51 -1.91 0.11 1.00 8020
## item_typerating -1.00 0.52 -2.04 0.01 1.00 7812
## item_typeyes_no 0.43 0.52 -0.58 1.44 1.00 6333
## Tail_ESS
## Intercept 8508
## item_typepick_free_response 8530
## item_typerating 8373
## item_typeyes_no 7661
##
## 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).formula_1pl <- bf(
response_is_correct ~ inv_logit(theta - beta),
# Person ability
theta ~ 0 + (1 | user_id) +
(1 | item_id:user_id) +
(1 | target_id:user_id),
# Item difficulty
beta ~ 1 + item_type +
(1 | item_id) +
(1 | target_id) +
(1 | item_id:target_id),
nl = TRUE,
family = brmsfamily("bernoulli", link = "identity")
)
default_prior(formula_1pl, data = red_app_data2)## prior class coef group resp
## (flat) b
## (flat) b Intercept
## (flat) b item_typepick_free_response
## (flat) b item_typerating
## (flat) b item_typeyes_no
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id
## student_t(3, 0, 2.5) sd Intercept item_id
## student_t(3, 0, 2.5) sd item_id:target_id
## student_t(3, 0, 2.5) sd Intercept item_id:target_id
## student_t(3, 0, 2.5) sd target_id
## student_t(3, 0, 2.5) sd Intercept target_id
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id:user_id
## student_t(3, 0, 2.5) sd Intercept item_id:user_id
## student_t(3, 0, 2.5) sd target_id:user_id
## student_t(3, 0, 2.5) sd Intercept target_id:user_id
## student_t(3, 0, 2.5) sd user_id
## student_t(3, 0, 2.5) sd Intercept user_id
## dpar nlpar lb ub source
## beta default
## beta (vectorized)
## beta (vectorized)
## beta (vectorized)
## beta (vectorized)
## beta 0 default
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## theta 0 default
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)priors_1pl <- c(
# Regularized priors for intercepts (if present)
prior(normal(0, 1), class = "b", nlpar = "beta"),
prior(normal(0, 1), class = "sd", nlpar = "theta"),
prior(normal(0, 1), class = "sd", nlpar = "beta")
)
m_1pl_nl <- brm(
formula = formula_1pl,
data = red_app_data2,
prior = priors_1pl,
iter = 5000,
warmup = 2000,
# threads = threading(2)
file = "m_1pl_nl"
)
push(m_1pl_nl)
m_1pl_nl## Family: bernoulli
## Links: mu = identity
## Formula: response_is_correct ~ inv_logit(theta - beta)
## theta ~ 0 + (1 | user_id) + (1 | item_id:user_id) + (1 | target_id:user_id)
## beta ~ 1 + item_type + (1 | item_id) + (1 | target_id) + (1 | item_id:target_id)
## Data: red_app_data2 (Number of observations: 3310)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Multilevel Hyperparameters:
## ~item_id:user_id (Number of levels: 2600)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.53 0.26 0.04 1.02 1.01 440 913
##
## ~target_id:user_id (Number of levels: 2097)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.49 0.22 0.05 0.88 1.00 600 1112
##
## ~user_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.14 0.09 0.01 0.32 1.00 2656 4338
##
## ~item_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 0.34 0.14 0.04 0.60 1.00 1319 1876
##
## ~item_id:target_id (Number of levels: 791)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 1.10 0.12 0.88 1.37 1.00 1156 2025
##
## ~target_id (Number of levels: 74)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 0.32 0.13 0.05 0.56 1.00 1622 1990
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat
## beta_Intercept -0.25 0.45 -1.13 0.64 1.00
## beta_item_typepick_free_response 0.84 0.46 -0.07 1.75 1.00
## beta_item_typerating 0.95 0.47 0.04 1.89 1.00
## beta_item_typeyes_no -0.49 0.46 -1.39 0.42 1.00
## Bulk_ESS Tail_ESS
## beta_Intercept 5316 7709
## beta_item_typepick_free_response 5522 7601
## beta_item_typerating 5610 7492
## beta_item_typeyes_no 4985 7150
##
## 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).formula_1pl_known_guess <- bf(
response_is_correct ~ guess_prob + (1 - guess_prob) * inv_logit(theta - beta),
# Person ability
theta ~ 0 + (1 | user_id) +
(1 | item_id:user_id) +
(1 | target_id:user_id),
# Item difficulty
beta ~ 1 + item_type +
(1 | item_id) +
(1 | target_id) +
(1 | item_id:target_id),
nl = TRUE,
family = brmsfamily("bernoulli", link = "identity")
)
default_prior(formula_1pl_known_guess, data = red_app_data2)## prior class coef group resp
## (flat) b
## (flat) b Intercept
## (flat) b item_typepick_free_response
## (flat) b item_typerating
## (flat) b item_typeyes_no
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id
## student_t(3, 0, 2.5) sd Intercept item_id
## student_t(3, 0, 2.5) sd item_id:target_id
## student_t(3, 0, 2.5) sd Intercept item_id:target_id
## student_t(3, 0, 2.5) sd target_id
## student_t(3, 0, 2.5) sd Intercept target_id
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id:user_id
## student_t(3, 0, 2.5) sd Intercept item_id:user_id
## student_t(3, 0, 2.5) sd target_id:user_id
## student_t(3, 0, 2.5) sd Intercept target_id:user_id
## student_t(3, 0, 2.5) sd user_id
## student_t(3, 0, 2.5) sd Intercept user_id
## dpar nlpar lb ub source
## beta default
## beta (vectorized)
## beta (vectorized)
## beta (vectorized)
## beta (vectorized)
## beta 0 default
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## theta 0 default
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)priors_1pl_known_guess <- c(
# Regularized priors for intercepts (if present)
prior(normal(0, 1), class = "b", nlpar = "beta"),
prior(normal(0, 1), class = "sd", nlpar = "theta"),
prior(normal(0, 1), class = "sd", nlpar = "beta")
)
m_1pl_known_guess <- brm(
formula = formula_1pl_known_guess,
data = red_app_data2,
prior = priors_1pl_known_guess,
iter = 5000,
warmup = 2000,
# threads = threading(2)
file = "m_1pl_known_guess"
)
push(m_1pl_known_guess)## Warning: There were 8 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmupm_1pl_known_guess## Warning: There were 8 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup## Family: bernoulli
## Links: mu = identity
## Formula: response_is_correct ~ guess_prob + (1 - guess_prob) * inv_logit(theta - beta)
## theta ~ 0 + (1 | user_id) + (1 | item_id:user_id) + (1 | target_id:user_id)
## beta ~ 1 + item_type + (1 | item_id) + (1 | target_id) + (1 | item_id:target_id)
## Data: red_app_data2 (Number of observations: 3310)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Multilevel Hyperparameters:
## ~item_id:user_id (Number of levels: 2600)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.55 0.39 0.02 1.46 1.00 1277 2074
##
## ~target_id:user_id (Number of levels: 2097)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.65 0.42 0.03 1.57 1.00 1083 2386
##
## ~user_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.42 0.24 0.03 0.93 1.00 2630 4732
##
## ~item_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 1.23 0.41 0.34 2.01 1.00 1842 1618
##
## ~item_id:target_id (Number of levels: 791)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 2.64 0.38 1.96 3.45 1.00 3816 6933
##
## ~target_id (Number of levels: 74)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 0.96 0.39 0.17 1.71 1.00 2192 2508
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat
## beta_Intercept 2.06 0.58 0.94 3.22 1.00
## beta_item_typepick_free_response 0.96 0.59 -0.19 2.14 1.00
## beta_item_typerating 1.52 0.67 0.23 2.83 1.00
## beta_item_typeyes_no -0.00 0.58 -1.13 1.13 1.00
## Bulk_ESS Tail_ESS
## beta_Intercept 9361 8793
## beta_item_typepick_free_response 9747 9292
## beta_item_typerating 11506 9768
## beta_item_typeyes_no 11013 9249
##
## 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).cf_1pl = coef(m_1pl, summary = T)
cf_1pl_wg = coef(m_1pl_known_guess, summary = T)
comp_cfs = cf_1pl$user_id[,,"Intercept"] %>% as.data.frame() %>% tibble::rownames_to_column("user_id") %>%
full_join(cf_1pl_wg$user_id[,,"theta_Intercept"] %>% as.data.frame() %>% tibble::rownames_to_column("user_id"),
by = c("user_id"), suffix = c("_1pl", "_1pl_known_guess"))
cor.test(comp_cfs$Estimate_1pl, comp_cfs$Estimate_1pl_known_guess)##
## Pearson's product-moment correlation
##
## data: comp_cfs$Estimate_1pl and comp_cfs$Estimate_1pl_known_guess
## t = 15.11, df = 98, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.7658780 0.8871302
## sample estimates:
## cor
## 0.8364648ggplot(comp_cfs, aes(Estimate_1pl, Estimate_1pl_known_guess)) +
geom_point()formula_2pl_known_guess <- bf(
response_is_correct ~ guess_prob + (1 - guess_prob) *
inv_logit(beta + exp(logalpha) * theta),
# Person ability
theta ~ 0 + (1 | user_id) + (1 | user_id:target_id) + (1 | user_id:item_id),
# Item difficulty
beta ~ 1 + item_type +
(1 | i | item_id) +
(1 | t | target_id) +
(1 | it | item_id:target_id),
# Item discrimination
logalpha ~ 1 + item_type +
(1 | i | item_id) +
(1 | t | target_id) +
(1 | it | item_id:target_id),
nl = TRUE,
family = brmsfamily("bernoulli", link = "identity")
)
# Priors for all parameters
priors_2pl_known_guess <- c(
# Regularized priors for intercepts (if present)
prior(normal(0, 1), class = "b", nlpar = "beta"),
prior(normal(0, 1), class = "sd", nlpar = "theta"),
prior(normal(0, 1), class = "sd", nlpar = "beta"),
prior(normal(0, 1), class = "b", nlpar = "logalpha"),
prior(normal(0, 1), class = "sd", nlpar = "logalpha")
)
# Final model fitting call
m_2pl_known_guess <- brm(
formula = formula_2pl_known_guess,
data = red_app_data2,
prior = priors_2pl_known_guess,
iter = 5000,
warmup = 2000,
file = "m_2pl_known_guess" # Saves compiled model to disk
)
push(m_2pl_known_guess)## Warning: There were 848 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmupm_2pl_known_guess## Warning: There were 848 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup## Family: bernoulli
## Links: mu = identity
## Formula: response_is_correct ~ guess_prob + (1 - guess_prob) * inv_logit(beta + exp(logalpha) * theta)
## theta ~ 0 + (1 | user_id) + (1 | user_id:target_id) + (1 | user_id:item_id)
## beta ~ 1 + item_type + (1 | i | item_id) + (1 | t | target_id) + (1 | it | item_id:target_id)
## logalpha ~ 1 + item_type + (1 | i | item_id) + (1 | t | target_id) + (1 | it | item_id:target_id)
## Data: red_app_data2 (Number of observations: 3310)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Multilevel Hyperparameters:
## ~user_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.51 0.38 0.03 1.44 1.00 1052 1793
##
## ~user_id:item_id (Number of levels: 2600)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.71 0.55 0.02 2.00 1.01 335 807
##
## ~user_id:target_id (Number of levels: 2097)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.82 0.58 0.04 2.15 1.01 382 1179
##
## ~item_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI
## sd(beta_Intercept) 1.25 0.47 0.22 2.15
## sd(logalpha_Intercept) 0.71 0.49 0.03 1.83
## cor(beta_Intercept,logalpha_Intercept) 0.09 0.56 -0.94 0.96
## Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 1.00 685 706
## sd(logalpha_Intercept) 1.01 720 1380
## cor(beta_Intercept,logalpha_Intercept) 1.00 1029 1324
##
## ~item_id:target_id (Number of levels: 791)
## Estimate Est.Error l-95% CI u-95% CI
## sd(beta_Intercept) 2.70 0.42 1.96 3.61
## sd(logalpha_Intercept) 1.05 0.63 0.06 2.44
## cor(beta_Intercept,logalpha_Intercept) 0.49 0.44 -0.67 0.98
## Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 1.00 713 1503
## sd(logalpha_Intercept) 1.02 310 384
## cor(beta_Intercept,logalpha_Intercept) 1.00 731 2079
##
## ~target_id (Number of levels: 74)
## Estimate Est.Error l-95% CI u-95% CI
## sd(beta_Intercept) 0.98 0.44 0.12 1.85
## sd(logalpha_Intercept) 0.69 0.50 0.03 1.83
## cor(beta_Intercept,logalpha_Intercept) 0.20 0.56 -0.91 0.97
## Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 1.00 1042 1699
## sd(logalpha_Intercept) 1.01 649 960
## cor(beta_Intercept,logalpha_Intercept) 1.00 998 2225
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat
## beta_Intercept -2.18 0.61 -3.42 -1.00 1.00
## beta_item_typepick_free_response -1.18 0.67 -2.53 0.10 1.00
## beta_item_typerating -1.55 0.72 -2.95 -0.14 1.00
## beta_item_typeyes_no 0.18 0.61 -1.00 1.39 1.00
## logalpha_Intercept -0.78 0.74 -2.24 0.67 1.00
## logalpha_item_typepick_free_response 0.37 0.78 -1.28 1.85 1.00
## logalpha_item_typerating -0.20 0.84 -1.90 1.34 1.00
## logalpha_item_typeyes_no -0.98 0.78 -2.56 0.53 1.00
## Bulk_ESS Tail_ESS
## beta_Intercept 2054 1945
## beta_item_typepick_free_response 1543 1798
## beta_item_typerating 1943 1122
## beta_item_typeyes_no 2412 2401
## logalpha_Intercept 1645 2698
## logalpha_item_typepick_free_response 1150 2329
## logalpha_item_typerating 1217 2317
## logalpha_item_typeyes_no 1338 2742
##
## 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).cf_2pl_wg = coef(m_2pl_known_guess, summary = T)
cf_1pl_nl = coef(m_1pl_nl, summary = T)
comp_cfs =
bind_rows(
m1pl = cf_1pl$user_id[,,"Intercept"] %>% as.data.frame() %>% tibble::rownames_to_column("user_id"),
m1pl_nl = cf_1pl_nl$user_id[,,"theta_Intercept"] %>% as.data.frame() %>% tibble::rownames_to_column("user_id"),
m1pl_kg = cf_1pl_wg$user_id[,,"theta_Intercept"] %>% as.data.frame() %>% tibble::rownames_to_column("user_id"),
m2pl_kg = cf_2pl_wg$user_id[,,"theta_Intercept"] %>% as.data.frame() %>% tibble::rownames_to_column("user_id"),
.id = "model")
comp_cfs_w <- comp_cfs %>% select(user_id, model, Estimate) %>% tidyr::pivot_wider(names_from = model, values_from = Estimate)
cor(comp_cfs_w %>% select(-user_id)) %>% round(2)## m1pl m1pl_nl m1pl_kg m2pl_kg
## m1pl 1.00 1.00 0.84 0.70
## m1pl_nl 1.00 1.00 0.84 0.70
## m1pl_kg 0.84 0.84 1.00 0.94
## m2pl_kg 0.70 0.70 0.94 1.00ggplot(comp_cfs_w, aes(m1pl, m2pl_kg)) +
geom_point()ggplot(comp_cfs_w, aes(m1pl_kg, m2pl_kg)) +
geom_point()formula_1pl <- bf(
response_is_correct ~ item_type +
(0 + item_type | user_id) +
(1 | item_id) +
(1 | target_id) +
(1 | item_id:user_id) +
(1 | target_id:user_id) +
(1 | item_id:target_id),
family = brmsfamily("bernoulli", link = "logit")
)
default_prior(formula_1pl, data = red_app_data2)## prior class coef group
## (flat) b
## (flat) b item_typepick_free_response
## (flat) b item_typerating
## (flat) b item_typeyes_no
## lkj(1) cor
## lkj(1) cor user_id
## student_t(3, 0, 2.5) Intercept
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id
## student_t(3, 0, 2.5) sd Intercept item_id
## student_t(3, 0, 2.5) sd item_id:target_id
## student_t(3, 0, 2.5) sd Intercept item_id:target_id
## student_t(3, 0, 2.5) sd item_id:user_id
## student_t(3, 0, 2.5) sd Intercept item_id:user_id
## student_t(3, 0, 2.5) sd target_id
## student_t(3, 0, 2.5) sd Intercept target_id
## student_t(3, 0, 2.5) sd target_id:user_id
## student_t(3, 0, 2.5) sd Intercept target_id:user_id
## student_t(3, 0, 2.5) sd user_id
## student_t(3, 0, 2.5) sd item_typeknowledge user_id
## student_t(3, 0, 2.5) sd item_typepick_free_response user_id
## student_t(3, 0, 2.5) sd item_typerating user_id
## student_t(3, 0, 2.5) sd item_typeyes_no user_id
## resp dpar nlpar lb ub source
## default
## (vectorized)
## (vectorized)
## (vectorized)
## default
## (vectorized)
## default
## 0 default
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)
## 0 (vectorized)priors_1pl <- c(
# Regularized priors for intercepts (if present)
prior(normal(0, 1), class = "b"),
prior(normal(0, 1), class = "sd")
)
m_1pl <- brm(
formula = formula_1pl,
data = red_app_data2,
prior = priors_1pl,
iter = 5000,
warmup = 2000,
# threads = threading(2)
file = "m_1pl_types"
)
m_1pl## Warning: There were 111 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup## Family: bernoulli
## Links: mu = logit
## Formula: response_is_correct ~ item_type + (0 + item_type | user_id) + (1 | item_id) + (1 | target_id) + (1 | item_id:user_id) + (1 | target_id:user_id) + (1 | item_id:target_id)
## Data: red_app_data2 (Number of observations: 3310)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Multilevel Hyperparameters:
## ~item_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.35 0.14 0.05 0.61 1.00 1261 2134
##
## ~item_id:target_id (Number of levels: 791)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 1.12 0.13 0.90 1.39 1.00 1220 2273
##
## ~item_id:user_id (Number of levels: 2600)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.55 0.26 0.04 1.04 1.01 395 1063
##
## ~target_id (Number of levels: 74)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.31 0.13 0.03 0.56 1.00 1323 1607
##
## ~target_id:user_id (Number of levels: 2097)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.51 0.21 0.05 0.90 1.01 579 936
##
## ~user_id (Number of levels: 100)
## Estimate Est.Error l-95% CI
## sd(item_typeknowledge) 0.71 0.53 0.03
## sd(item_typepick_free_response) 0.18 0.12 0.01
## sd(item_typerating) 0.36 0.21 0.02
## sd(item_typeyes_no) 0.21 0.12 0.01
## cor(item_typeknowledge,item_typepick_free_response) 0.01 0.45 -0.80
## cor(item_typeknowledge,item_typerating) -0.12 0.44 -0.85
## cor(item_typepick_free_response,item_typerating) -0.03 0.43 -0.82
## cor(item_typeknowledge,item_typeyes_no) -0.05 0.44 -0.83
## cor(item_typepick_free_response,item_typeyes_no) -0.03 0.44 -0.82
## cor(item_typerating,item_typeyes_no) 0.19 0.43 -0.70
## u-95% CI Rhat Bulk_ESS
## sd(item_typeknowledge) 1.99 1.00 5318
## sd(item_typepick_free_response) 0.45 1.00 3679
## sd(item_typerating) 0.77 1.00 2203
## sd(item_typeyes_no) 0.46 1.00 2375
## cor(item_typeknowledge,item_typepick_free_response) 0.82 1.00 7916
## cor(item_typeknowledge,item_typerating) 0.75 1.00 3835
## cor(item_typepick_free_response,item_typerating) 0.79 1.00 4759
## cor(item_typeknowledge,item_typeyes_no) 0.78 1.00 4147
## cor(item_typepick_free_response,item_typeyes_no) 0.79 1.00 4659
## cor(item_typerating,item_typeyes_no) 0.87 1.00 4569
## Tail_ESS
## sd(item_typeknowledge) 5221
## sd(item_typepick_free_response) 5074
## sd(item_typerating) 4021
## sd(item_typeyes_no) 4299
## cor(item_typeknowledge,item_typepick_free_response) 7972
## cor(item_typeknowledge,item_typerating) 6821
## cor(item_typepick_free_response,item_typerating) 7919
## cor(item_typeknowledge,item_typeyes_no) 6749
## cor(item_typepick_free_response,item_typeyes_no) 7019
## cor(item_typerating,item_typeyes_no) 7610
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.31 0.51 -0.70 1.30 1.00 5919
## item_typepick_free_response -0.91 0.52 -1.92 0.09 1.00 6226
## item_typerating -1.04 0.53 -2.07 -0.01 1.00 6272
## item_typeyes_no 0.44 0.52 -0.56 1.46 1.00 5156
## Tail_ESS
## Intercept 7495
## item_typepick_free_response 7467
## item_typerating 7729
## item_typeyes_no 7246
##
## 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).formula_1pl_known_guess <- bf(
response_is_correct ~ guess_prob + (1 - guess_prob) * inv_logit(theta - beta),
# Person ability
theta ~ 0 + item_type +
(0 + item_type | user_id) +
(1 | item_id:user_id) +
(1 | target_id:user_id),
# Item difficulty
beta ~ 1 +
(1 | item_id) +
(1 | target_id) +
(1 | item_id:target_id),
nl = TRUE,
family = brmsfamily("bernoulli", link = "identity")
)
default_prior(formula_1pl_known_guess, data = red_app_data2)## prior class coef group resp
## lkj(1) cor
## lkj(1) cor user_id
## (flat) b
## (flat) b Intercept
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id
## student_t(3, 0, 2.5) sd Intercept item_id
## student_t(3, 0, 2.5) sd item_id:target_id
## student_t(3, 0, 2.5) sd Intercept item_id:target_id
## student_t(3, 0, 2.5) sd target_id
## student_t(3, 0, 2.5) sd Intercept target_id
## (flat) b
## (flat) b item_typeknowledge
## (flat) b item_typepick_free_response
## (flat) b item_typerating
## (flat) b item_typeyes_no
## student_t(3, 0, 2.5) sd
## student_t(3, 0, 2.5) sd item_id:user_id
## student_t(3, 0, 2.5) sd Intercept item_id:user_id
## student_t(3, 0, 2.5) sd target_id:user_id
## student_t(3, 0, 2.5) sd Intercept target_id:user_id
## student_t(3, 0, 2.5) sd user_id
## student_t(3, 0, 2.5) sd item_typeknowledge user_id
## student_t(3, 0, 2.5) sd item_typepick_free_response user_id
## student_t(3, 0, 2.5) sd item_typerating user_id
## student_t(3, 0, 2.5) sd item_typeyes_no user_id
## dpar nlpar lb ub source
## default
## (vectorized)
## beta default
## beta (vectorized)
## beta 0 default
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## beta 0 (vectorized)
## theta default
## theta (vectorized)
## theta (vectorized)
## theta (vectorized)
## theta (vectorized)
## theta 0 default
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)
## theta 0 (vectorized)priors_1pl_known_guess <- c(
# Regularized priors for intercepts (if present)
prior(normal(0, 1), class = "b", nlpar = "theta"),
prior(normal(0, 1), class = "b", nlpar = "beta"),
prior(normal(0, 1), class = "sd", nlpar = "theta"),
prior(normal(0, 1), class = "sd", nlpar = "beta")
)
m_1pl_known_guess <- brm(
formula = formula_1pl_known_guess,
data = red_app_data2,
prior = priors_1pl_known_guess,
iter = 5000,
warmup = 2000,
# threads = threading(2)
file = "m_1pl_known_guess_types"
)
m_1pl_known_guess## Warning: There were 4 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup## Family: bernoulli
## Links: mu = identity
## Formula: response_is_correct ~ guess_prob + (1 - guess_prob) * inv_logit(theta - beta)
## theta ~ 0 + item_type + (0 + item_type | user_id) + (1 | item_id:user_id) + (1 | target_id:user_id)
## beta ~ 1 + (1 | item_id) + (1 | target_id) + (1 | item_id:target_id)
## Data: red_app_data2 (Number of observations: 3310)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Multilevel Hyperparameters:
## ~item_id:user_id (Number of levels: 2600)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.55 0.38 0.02 1.42 1.00 1279 3081
##
## ~target_id:user_id (Number of levels: 2097)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(theta_Intercept) 0.62 0.41 0.03 1.52 1.00 1187 2828
##
## ~user_id (Number of levels: 100)
## Estimate
## sd(theta_item_typeknowledge) 0.83
## sd(theta_item_typepick_free_response) 0.70
## sd(theta_item_typerating) 0.67
## sd(theta_item_typeyes_no) 0.38
## cor(theta_item_typeknowledge,theta_item_typepick_free_response) -0.02
## cor(theta_item_typeknowledge,theta_item_typerating) -0.04
## cor(theta_item_typepick_free_response,theta_item_typerating) 0.02
## cor(theta_item_typeknowledge,theta_item_typeyes_no) -0.01
## cor(theta_item_typepick_free_response,theta_item_typeyes_no) 0.04
## cor(theta_item_typerating,theta_item_typeyes_no) 0.08
## Est.Error
## sd(theta_item_typeknowledge) 0.62
## sd(theta_item_typepick_free_response) 0.41
## sd(theta_item_typerating) 0.47
## sd(theta_item_typeyes_no) 0.28
## cor(theta_item_typeknowledge,theta_item_typepick_free_response) 0.44
## cor(theta_item_typeknowledge,theta_item_typerating) 0.44
## cor(theta_item_typepick_free_response,theta_item_typerating) 0.44
## cor(theta_item_typeknowledge,theta_item_typeyes_no) 0.44
## cor(theta_item_typepick_free_response,theta_item_typeyes_no) 0.44
## cor(theta_item_typerating,theta_item_typeyes_no) 0.45
## l-95% CI
## sd(theta_item_typeknowledge) 0.03
## sd(theta_item_typepick_free_response) 0.04
## sd(theta_item_typerating) 0.03
## sd(theta_item_typeyes_no) 0.01
## cor(theta_item_typeknowledge,theta_item_typepick_free_response) -0.82
## cor(theta_item_typeknowledge,theta_item_typerating) -0.82
## cor(theta_item_typepick_free_response,theta_item_typerating) -0.79
## cor(theta_item_typeknowledge,theta_item_typeyes_no) -0.81
## cor(theta_item_typepick_free_response,theta_item_typeyes_no) -0.79
## cor(theta_item_typerating,theta_item_typeyes_no) -0.78
## u-95% CI Rhat
## sd(theta_item_typeknowledge) 2.27 1.00
## sd(theta_item_typepick_free_response) 1.57 1.00
## sd(theta_item_typerating) 1.76 1.00
## sd(theta_item_typeyes_no) 1.03 1.00
## cor(theta_item_typeknowledge,theta_item_typepick_free_response) 0.79 1.00
## cor(theta_item_typeknowledge,theta_item_typerating) 0.78 1.00
## cor(theta_item_typepick_free_response,theta_item_typerating) 0.82 1.00
## cor(theta_item_typeknowledge,theta_item_typeyes_no) 0.80 1.00
## cor(theta_item_typepick_free_response,theta_item_typeyes_no) 0.82 1.00
## cor(theta_item_typerating,theta_item_typeyes_no) 0.84 1.00
## Bulk_ESS
## sd(theta_item_typeknowledge) 9027
## sd(theta_item_typepick_free_response) 2826
## sd(theta_item_typerating) 3944
## sd(theta_item_typeyes_no) 3691
## cor(theta_item_typeknowledge,theta_item_typepick_free_response) 5257
## cor(theta_item_typeknowledge,theta_item_typerating) 8083
## cor(theta_item_typepick_free_response,theta_item_typerating) 9133
## cor(theta_item_typeknowledge,theta_item_typeyes_no) 9693
## cor(theta_item_typepick_free_response,theta_item_typeyes_no) 9406
## cor(theta_item_typerating,theta_item_typeyes_no) 7722
## Tail_ESS
## sd(theta_item_typeknowledge) 6937
## sd(theta_item_typepick_free_response) 5011
## sd(theta_item_typerating) 6599
## sd(theta_item_typeyes_no) 5861
## cor(theta_item_typeknowledge,theta_item_typepick_free_response) 7376
## cor(theta_item_typeknowledge,theta_item_typerating) 8778
## cor(theta_item_typepick_free_response,theta_item_typerating) 9711
## cor(theta_item_typeknowledge,theta_item_typeyes_no) 9239
## cor(theta_item_typepick_free_response,theta_item_typeyes_no) 8764
## cor(theta_item_typerating,theta_item_typeyes_no) 9375
##
## ~item_id (Number of levels: 100)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 1.24 0.43 0.25 2.05 1.00 1442 960
##
## ~item_id:target_id (Number of levels: 791)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 2.68 0.38 1.97 3.48 1.00 3582 7222
##
## ~target_id (Number of levels: 74)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(beta_Intercept) 0.94 0.40 0.12 1.72 1.00 1944 3035
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat
## theta_item_typeknowledge 0.35 0.94 -1.50 2.20 1.00
## theta_item_typepick_free_response -0.99 0.62 -2.24 0.20 1.00
## theta_item_typerating -1.52 0.68 -2.86 -0.20 1.00
## theta_item_typeyes_no 0.06 0.59 -1.11 1.21 1.00
## beta_Intercept 2.11 0.58 0.99 3.27 1.00
## Bulk_ESS Tail_ESS
## theta_item_typeknowledge 24661 8898
## theta_item_typepick_free_response 10680 9976
## theta_item_typerating 11045 9809
## theta_item_typeyes_no 10665 9559
## beta_Intercept 9740 9221
##
## 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).