## ----setup, include = FALSE---------------------------------------------------
library(XSLmodels)

knitr::opts_chunk$set(
  echo = TRUE,
  collapse = TRUE,
  comment = "#>",
  # DEoptim advises a population of at least 10 per parameter; the searches
  # here are smaller to keep the vignette fast, so its warnings are hidden.
  # Single-word, single-object training trials also trigger an R deprecation
  # warning in the shared uncfam() arithmetic.
  warning = FALSE
)

## ----identical----------------------------------------------------------------
d <- xsl_datasets[[1]]
identical(xsl_run(uncfam(X = .2, B = 3, C = .97), d)$fits[[1]]$perf,
          xsl_run(uncfam_general(X = .2, B = 3, C = .97), d)$fits[[1]]$perf)

## ----elimination--------------------------------------------------------------
elim_data <- xslData(train = list(words = list(2, 2, c(1, 2), c(1, 3)),
                                  objects = list(2, 2, c(1, 2), c(1, 3))))
sapply(c(eps_0 = 0, eps_2 = 2, eps_10 = 10), \(e)
  xsl_run(uncfam_general(X = 1, B = 1, C = 1, eps = e), elim_data)$fits[[1]]$perf)

## ----trace--------------------------------------------------------------------
trace_data <- xslData(train = list(words = list(1, 1, 1, 1, 1),
                                   objects = list(1, 1, 2, 2, c(1, 2))))
sapply(c(rho_0 = 0, rho_5 = 5), \(r)
  xsl_run(uncfam_general(X = .5, B = 0, C = 1, rho = r, Cs = .5), trace_data)$fits[[1]]$matrix[1, ])

## ----sampling-----------------------------------------------------------------
set.seed(1)
xsl_run(uncfam_general(X = .2, B = 3, C = .97, K = 1), d, xslControl(n_sim = 50))$sse

## ----nested-------------------------------------------------------------------
labels <- vapply(xsl_datasets, `[[`, "", "label")
ctrl <- xslControl(objective = "binomial", lapse = .02)

fit_nested <- function(data, free, lower, upper, start = NULL) {
  np <- 30
  pop <- NULL
  if (!is.null(start)) {
    set.seed(2)
    pop <- sapply(seq_along(lower), \(j) stats::runif(np, lower[j], upper[j]))
    pop[1, ] <- start
  }
  xsl_fit(uncfam_general(X = .1, B = 1, C = 1), data, lower = lower, upper = upper,
          free = free, control = ctrl, seed = 1,
          deoptim_control = DEoptim::DEoptim.control(NP = np, itermax = 25, trace = FALSE,
                                                     initialpop = pop))[[1]]
}

compare_gamma <- function(label) {
  data <- xsl_datasets[[which(labels == label)]]
  bam <- fit_nested(data, c("X", "B", "C"), c(.001, .1, .5), c(5, 15, 1))
  gam <- fit_nested(data, c("X", "B", "C", "gamma"), c(.001, .1, .5, 0), c(5, 15, 1, 6),
                    start = c(bam$optim$bestmem, gamma = 1))
  lr <- 2 * (gam$loglik - bam$loglik)
  data.frame(condition = label, gamma = gam$optim$bestmem[["gamma"]],
             delta_AIC = gam$aic - bam$aic, LR = lr,
             p = stats::pchisq(lr, df = 1, lower.tail = FALSE))
}
res <- do.call(rbind, lapply(c("212", "301"), compare_gamma))
res