R/model-decay.R

In XSLmodels: Run and Optimize Cross-Situational Word Learning Models

decay_model <- function(params, data, control) {
  C <- params[["C"]] # decay
  reps <- control[["reps"]]

  voc <- sort(unique(unlist(data$words)))
  ref <- sort(unique(unlist(data$objects[!is.na(data$objects)])))

  voc_sz <- length(voc) # vocabulary size
  ref_sz <- length(ref) # number of objects
  keep_traj <- isTRUE(control[["keep_traj"]])
  traj <- list()
  m <- if (is.null(control[["start_matrix"]])) matrix(0, voc_sz, ref_sz) else control[["start_matrix"]] # association matrix
  colnames(m) <- ref
  rownames(m) <- voc
  perf <- matrix(0, reps, voc_sz) # a row for each block
  # training
  for (rep in 1:reps) { # for trajectory experiments, train multiple times
    for (t in seq_along(data$words)) {
      tr_w <- unlist(data$words[t])
      tr_w <- tr_w[!is.na(tr_w)]
      tr_w <- tr_w[tr_w != ""]
      tr_o <- unlist(data$objects[t])
      tr_o <- tr_o[!is.na(tr_o)]

      m <- m * C # bestvalit: 0.618814 bestmemit:    0.990905
      m[tr_w, tr_o] <- m[tr_w, tr_o] + 1

      index <- (rep - 1) * length(data$words) + t # index for learning trajectory
      if (keep_traj) traj[[index]] <- m
    }
    perf[rep, ] <- get_perf(m)
  }
  xslFit(perf = perf, matrix = m, traj = traj)
}

#' Decay model
#'
#' @param C decay
#'
#' @return An object of class xslMod
#' @export
#'
#' @examples
#' mod <- decay(C = 0.5)
#' xsl_run(mod, get_example_ambiguous_condition())
decay <- function(C) {
  xslMod(
    name = "decay",
    description = "Simple cooccurrence-counting baseline model",
    model = decay_model,
    params = list(C = C),
    stochastic = FALSE,
    supports_start_matrix = TRUE
  )
}

# TODO: C = alpha