R/model-fazly.R

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

# reimplemented following Fazly et al.'s code + paper
# George Kachergis June 11, 2015

fazly_model <- function(params, data, control) {
  lambda <- params[["lambda"]] # small smoothing factor (1e-5)
  beta <- params[["beta"]] # upper bound on number of symbol types to expect (8500)
  #for alignment prob calculation Fazly et al use two extra fixed parameters for smoothing:
  # (lines 174-5 learn.py)
  alpha <- params[["alpha"]] # fixed parameter
  epsilon <- params[["epsilon"]]
  theta <- params[["theta"]] # threshold for knowledge (they used .7)
  # best-fitting pars with threshold: c(0.077884, 5.553602, 0.188449) group SSE=.72

  reps <- control[["reps"]]
  #start_matrix <- control[["start_matrix"]]
  #test_noise <- control[["test_noise"]]

  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()
  perf <- matrix(0, reps, voc_sz) # a row for each block
  align <- matrix(0, voc_sz, ref_sz) # calc from probs of stim on trial
  assoc <- matrix(0, voc_sz, ref_sz) # sum of alignments over time
  probs <- matrix(0, voc_sz, ref_sz) # normalized assocs
  colnames(align) <- ref
  rownames(align) <- voc
  colnames(assoc) <- ref
  rownames(assoc) <- voc
  colnames(probs) <- ref
  rownames(probs) <- voc

  # for fazlyt only
  lexicon <- matrix(0, voc_sz, ref_sz) # for any probs that reach threshold

  t_unseen <- rep(1 / beta, voc_sz)
  names(t_unseen) <- voc

  #assm <- matrix(0, voc_sz+1, ref_sz) # track assoc scores SEPARATELY
  # 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)]
      tr_o <- tr_o[tr_o != ""]

      align <- matrix(0, voc_sz, ref_sz) # calc from probs of stim on trial
      tr_probs <- probs
      colnames(align) <- ref
      rownames(align) <- voc
      colnames(tr_probs) <- ref
      rownames(tr_probs) <- voc
      for (f in tr_o) {
        for (w in tr_w) {
          if (tr_probs[w, f] == 0) {
            tr_probs[w, f] <- t_unseen[w]
          }
        }
        sum_t <- sum(tr_probs[tr_w, f]) + alpha * epsilon
        for (w in tr_w) {
          align[w, f] <- (tr_probs[w, f] + epsilon) / sum_t
        }
      }
      assoc[tr_w, tr_o] <- assoc[tr_w, tr_o] + align[tr_w, tr_o]
      #probs[tr,] = assoc[tr,] / (rowSums(assoc[tr,])+beta*lambda)
      for (w in tr_w) {
        sum_a <- sum(assoc[w, ])
        denom <- sum_a + beta * lambda
        probs[w, ] <- (assoc[w, ] + lambda) / denom
        t_unseen[w] <- lambda / denom
      }
      #index = (rep-1)*nrow(data$trials$words) + t # index for learning trajectory
      index <- t
      if (keep_traj) traj[[index]] <- probs
      if (!is.null(theta)) lexicon[which(probs > theta)] <- 1 # add to lexicon
    }
    if (!is.null(theta)) {
      perf[rep, ] <- diag(lexicon) / rowSums(lexicon + 1e-12)
    } else {
      perf[rep, ] <- get_perf(probs)
    }
  }
  xslFit(perf = perf, matrix = probs, traj = traj)
}

#' Fazly et al. 2010 probablistic associative model
#'
#' @param lambda Small smoothing factor (e.g. 1e-5)
#' @param beta Upper bound on number of symbol types to expect (e.g. 8500)
#' @param alpha Fixed smoothing parameter (e.g. 10)
#' @param epsilon Fixed smoothing parameter (e.g. 0.001)
#' @param theta Threshold to determine when associations enter the lexicon
#'   (defaults to NULL, i.e. model variant without thresholding).
#'
#' @return An object of class xslMod
#' @export
#'
#' @examples
#' mod <- fazly(lambda = 1e-5, beta = 8500)
#' xsl_run(mod, get_example_ambiguous_condition())
#'
#' mod_t <- fazly(lambda = 1e-5, beta = 8500, theta = 0.7)
#' xsl_run(mod_t, get_example_ambiguous_condition())
fazly <- function(lambda, beta, alpha = 10, epsilon = 0.001, theta = NULL) {
  xslMod(
    name = "fazly",
    description = "Fazly et al. 2010 probablistic associative model",
    model = fazly_model,
    params = list(lambda = lambda, beta = beta, alpha = alpha,
                  epsilon = epsilon, theta = theta),
    stochastic = FALSE
  )
}